Title: oh-no-graphic
Post by: didi on May 25, 2009, 09:19:29 AM
Post by: didi on May 25, 2009, 09:19:29 AM
my old rgb-mixer enhanced with one line for ppm-graphic-format :
Code Select ; rgb_mixer_ppm.lsp 25may2009 dmemos
( set 'cmax 255 )
( set 'cmin 0 )
( set 'cdelta ( / ( sub cmax cmin) 10 )) ; "/" only for int else "div"
( set 'drgb ( dup cdelta 3 ))
( set 'white ( dup cmax 3 ))
( set 'black ( dup cmin 3 ))
( set 'red ( list cmax cmin cmin ))
( set 'green ( list cmin cmax cmin ))
( set 'blue ( list cmin cmin cmax ))
( define ( limit rgbx)
( if ( > rgbx cmax) cmax
( if ( < rgbx cmin) cmin rgbx )))
( define ( rgb-add rgb1 rgb2 )
( map limit ( map add rgb1 rgb2)))
( define ( rgb-sub rgb1 rgb2 )
( map limit ( map sub rgb1 rgb2)))
( define ( rgb-complement rgb1 )
( rgb-sub white rgb1 ))
( set 'yellow ( rgb-add red green ))
( set 'cyan ( rgb-add green blue ))
( set 'magenta ( rgb-add red blue ))
( define ( rgb-lighter rgb1 i )
( if ( = nil i ) (set 'i 1 ))
( rgb-add rgb1 ( map mul drgb ( list i i i ))))
( define ( rgb-darker rgb1 i )
( if ( = nil i ) (set 'i 1 ))
( rgb-sub rgb1 ( map * drgb ( list i i i ))))
( set 'darkgrey ( rgb-lighter black 3 ))
( set 'lightgrey ( rgb-darker white ))
; translate rgb list to a string for ppm-format eg. ( 75 75 75 ) -> "KKK"
( define ( ppm mrgb ) ( join ( map char mrgb )))
Title:
Post by: didi on May 25, 2009, 09:20:42 AM
Post by: didi on May 25, 2009, 09:20:42 AM
Code Select ; onograph7.lsp oh-no-graphic dmemos 25.5.2009
( change-dir "C:\arb" )
( load "rgb_mixer_ppm.lsp" )
( set 'width 50 'height 50 )
( set 'bkcolor ( ppm yellow ))
( set 'mcolor ( ppm red ))
( silent ; silent only for testphase with nl-gui
( set 'bmparray ( array ( * width height) (list bkcolor)))
)
; set point
( setf (bmparray 1 ) ( ppm blue ) )
; diagonal-line
( for ( i 0 49 )
( setf ( bmparray ( + i (* i 50 ))) mcolor ))
; output as ppm-file , colormax-value is "255"
( write-file "first.ppm"
( append "P6n" (string width) " " (string height) "n255n" ))
; convert bitmap to string and append to ppm-file
( append-file "first.ppm" (join (array-list bmparray )))
( println ( length bmpstr ) )
Title:
Post by: didi on May 25, 2009, 09:26:21 AM
Post by: didi on May 25, 2009, 09:26:21 AM
This are some lines of code to generate simple ppm-graphics in newLISP . You can view the resulting ppm file with the most graphic viewer .
Why ??
It's so much fun to program in newLISP itself . Only some lines are needed for a first result - without any complicated graphic-lib . And its fast enough.
Next ?
Make some basic drawing routines lines, shapes, fonts .
And an ppm to png converter .
Vision :
Generating simple x-y-plots or gif-graphics with newLISP and your browser.
PS: Everyone will probably say "Oh no ! " to this solution , thats the reason for this project-name "onographic" :-)
Title:
Post by: Lutz on May 25, 2009, 09:46:11 AM
Post by: Lutz on May 25, 2009, 09:46:11 AM
Not crazy at all! People have done low-level byte crunching with newLISP before and often with acceptable speed.
Title:
Post by: didi on May 27, 2009, 10:04:18 PM
Post by: didi on May 27, 2009, 10:04:18 PM
I don't want to bother someone here, but i makes really fun to program this from scratch in newLISP . There is only one thing ... there will always be one way to make it smarter within newLISP. I have to live with this ;)
Code Select ; line-test3 28may2009 dmemos
( set 'plist '())
( define ( point x y )
( push ( list (int x) (int y) ) plist ))
( define ( vertical_line x y1 y2 )
( for ( y y1 y2 ) ( point x y )))
( define ( horizontal_line x1 x2 y )
( for ( x x1 x2 ) ( point x y )))
( define (normal_line x1 x2 y1 y2 )
( set 'dm (div ( sub y2 y1 ) ( sub x2 x1 )))
( set 'y y1 )
( for ( x x1 x2 )
( point x y )
( set 'y ( add y dm ))))
( define ( line x1 y1 x2 y2 )
( if ( = x1 x2 )
( if ( = y1 y2 )
( point x1 y1 )
( vertical_line x1 y1 y2 ))
( if ( = y1 y2 )
( horizontal_line x1 x2 y1 )
( normal_line x1 y1 x2 y2 ))))
; test
( line 30 40 100 110 )
( unique plist ) ; delete double entries
( println plist )
Hope comming back with a ready to use version .
Title:
Post by: cormullion on May 28, 2009, 10:03:02 AM
Post by: cormullion on May 28, 2009, 10:03:02 AM
I'm not seeing anything other than a black square when I run your code and open the graphic in GraphicConverter (a multi-purpose MacOS file converter). The file first.ppm doesn't seem to have any content other than the header. Is there something tricky about UTF-8, or append-file, or newLISP-on-Mac that's not working...???
Title:
Post by: didi on May 28, 2009, 10:55:08 AM
Post by: didi on May 28, 2009, 10:55:08 AM
Here is a 400% zoomed screendump how it is shown in photoimpact:
Cormullion, do you have the "rgb_mixer_ppm.lsp" in the same directory ?
PS: I have copied the code from here back to my newLISP-GS and it is still working.
Title:
Post by: cormullion on May 28, 2009, 02:44:57 PM
Post by: cormullion on May 28, 2009, 02:44:57 PM
("195191195191 00" "195191195191 00" "195191195191 00" "195191195191 00" ...
I may look at 'pack' tomorrow to see if that provides a solution. But now, bed... :)
Title:
Post by: didi on May 28, 2009, 10:08:17 PM
Post by: didi on May 28, 2009, 10:08:17 PM
.... "255255 00" "255255 00" "255255 00" "255 00 00")
Title:
Post by: didi on June 01, 2009, 10:44:07 AM
Post by: didi on June 01, 2009, 10:44:07 AM
This 200x200 pixels needed 0.156s, if i increase the canvas to 400x400 pixels the time needed was 0.312 s on my pc.
For those who are interested in the code so far:
I think i adapt the newLISP-gs style , so the next funtions will be draw-line, draw-path and so on .
PS:
I've found no solution for Cormullions issue, how can i generate a non-utf-char on a utf-system ?
Title:
Post by: Lutz on June 01, 2009, 11:10:25 AM
Post by: Lutz on June 01, 2009, 11:10:25 AM
Code Select (define (ppm mrgb) (join (map char mrgb)))to:
Code Select (define (ppm mrgb) (pack (dup "b" (length mrgb)) mrgb))this will make the function work the same on both the UTF-8 and non-UTF-8 versions of newLISP.
On my Mac OS X system the new function is also more than double as fast than the old function using 'char'.
Title:
Post by: didi on June 02, 2009, 10:45:06 AM
Post by: didi on June 02, 2009, 10:45:06 AM
Code Select
> yellow
(255 255 0)
> ( ppm yellow )
" 00 00 00"
> ( ppm '( 255 255 0 ) )
"255255 00"
> ( list? yellow )
true
>
Maybe i didn't understand the pack-command .
Title:
Post by: Lutz on June 02, 2009, 10:56:43 AM
Post by: Lutz on June 02, 2009, 10:56:43 AM
Code Select > (define (ppm mrgb) (pack (dup "b" (length mrgb)) mrgb))
(lambda (mrgb) (pack (dup "b" (length mrgb)) mrgb))
> (set 'yellow '(255 255 0))
(255 255 0)
> (ppm yellow)
"255255 00"
>
tested on the Mac OS X with the UTF-8 version and Win XP using the non-UTF-8 version in newLISP-GS
can you post a
Title:
Post by: cormullion on June 02, 2009, 11:10:32 AM
Post by: cormullion on June 02, 2009, 11:10:32 AM
I thought that PPM was not immediately useful as a format. But I found that, on my Mac at least, there's a
Code Select $ convert first.ppm first.pngconvert these PPM files to PNG. Cool, eh?!
I'm hoping to play a bit more with this soon...
Title:
Post by: didi on June 02, 2009, 11:26:20 AM
Post by: didi on June 02, 2009, 11:26:20 AM
Code Select ; part of ono-rgb-ppm2.lsp (rgb-mixer)
( set 'cmax 255 )
( set 'cmin 0 )
( set 'red ( list cmax cmin cmin ))
( set 'green ( list cmin cmax cmin ))
( define ( limit rgbx)
( if ( > rgbx cmax) cmax
( if ( < rgbx cmin) cmin rgbx )))
( define ( rgb-add rgb1 rgb2 )
( map limit ( map add rgb1 rgb2)))
( set 'yellow ( rgb-add red green ))
; translate rgb list to a string for ppm-format eg. ( 75 75 75 ) -> "KKK"
(define (ppm mrgb) (pack (dup "b" (length mrgb)) mrgb))
( println ( ppm yellow ) )leads to :
....
(255 255 0)
(lambda (mrgb) (pack (dup "b" (length mrgb)) mrgb))
" 00 00 00"
PS: Cormullion good! - the same must exist for windows, but i have it not yet.
Title:
Post by: Lutz on June 02, 2009, 11:36:31 AM
Post by: Lutz on June 02, 2009, 11:36:31 AM
Code Select ( map limit ( map add rgb1 rgb2)))'yellow' contains floating point numbers but the "b" format in 'pack' wants integers. You can change this to:
Code Select ( map limit ( map + rgb1 rgb2)))and it works.
ps: 'pack' will automatically convert from float to int in the next version, currently it only converts in the other direction.
Title:
Post by: didi on June 02, 2009, 11:55:09 AM
Post by: didi on June 02, 2009, 11:55:09 AM
Title:
Post by: didi on June 07, 2009, 11:28:32 AM
Post by: didi on June 07, 2009, 11:28:32 AM
I made a special site for this project on my mainpage. Don't want to overload this thread
and your nerves ;)
drawline, drawpath and drawpolygon are new.
PS:
Is there a simpler way to get eg. four elements out of a list ( the values not a sublist ) than this ?
" ( mlist 0 ) ( mlist 1) ( mlist 2 ) ( mlist 3 ) "
Title:
Post by: cormullion on June 07, 2009, 11:59:35 AM
Post by: cormullion on June 07, 2009, 11:59:35 AM
is there a simpler way to get eg. four elements out of a list ( the values not a sublist ) than this ?Quote
" ( mlist 0 ) ( mlist 1) ( mlist 2 ) ( mlist 3 ) "
You could try:
Code Select (apply line (0 4 plist))instead of
Code Select (line ( plist 0 ) ( plist 1 ) ( plist 2 ) ( plist 3 ))using implicit slices rather than implicit indexes. There's loads of ways, I think.
Title:
Post by: didi on June 11, 2009, 10:27:30 AM
Post by: didi on June 11, 2009, 10:27:30 AM
Code Select ; ono-circle.lsp 11june2009 dmemos
( define ( circle xm ym r )
( set 'cy r )
( set 'cx 0 )
( set 'pd ( div (sub 5 (mul r 4)) 4))
( cpoint xm ym cx cy )
( while ( < cx cy )
( inc cx )
( if ( < pd 0 )
( set 'pd ( + pd (* 2 cx ) 1 ))
( begin
( dec cy )
( set 'pd (+ pd (* 2 ( - cx cy )) 1 ))))
( cpoint xm ym cx cy )
))
( define ( cpoint xm ym cx cy )
( point (+ xm cx) (+ ym cy ))
( point (- xm cx) (+ ym cy ))
( point (+ xm cx) (- ym cy ))
( point (- xm cx) (- ym cy ))
( point (+ xm cy) (+ ym cx ))
( point (- xm cy) (+ ym cx ))
( point (+ xm cy) (- ym cx ))
( point (- xm cy) (- ym cx ))
)
Title: arcs
Post by: didi on July 04, 2009, 10:55:16 AM
Post by: didi on July 04, 2009, 10:55:16 AM
Code Select ; ono-arc.lsp 4july2009 dmemos
; get the possible centers of a circle, 2 points and a radius given
( define ( getcenter x1 y1 x2 y2 radius )
( set 'DX ( sub x2 x1 ) 'DY ( sub y2 y1 ) )
( set 'dist-x1-x2 ( sqrt ( add (pow DX 2) (pow DY 2))))
( set 'min-radius (div dist-x1-x2 2 ))
( if ( < radius min-radius )
nil ; return nil, no solution radius too small
( begin ; else radius ok )
; a == length of middle-perpendicular to p1 and p2
(set 'a (sqrt (sub (pow radius 2) (pow min-radius 2 ))))
( set 'xm12 ( add x1 (div DX 2 ))) ; middle btw. p1 p2
( set 'ym12 ( add y1 (div DY 2 )))
( if ( = DY 0 )
; p1 p2 on horizontal line - return points list
( list xm12 (sub ym12 a) xm12 ( add ym12 a ))
( if ( = DX 0 )
; else p1 p2 on vertical line - return points list
( list (sub xm12 a) ym12 (add xm12 a) ym12 )
( begin ; else normal line
( set 'alpha ( atan ( sub (div DX DY))))
( set 'dy ( mul a ( sin alpha )))
( set 'dx ( mul a ( cos alpha )))
( list (sub xm12 dx) (sub ym12 dy) (add xm12 dx) (add ym12 dy))
))))))
; get the angle of a point on a circle
( define ( getangle xm ym x y r , dx dy alpha )
( set 'dx ( sub x xm ))
( set 'dy ( sub y ym ))
( if ( not r )
( set 'r (sqrt (add (pow dx 2) (pow dy 2 )))))
( set 'alpha (asin (div dy r )))
( if ( <dx>= x minval ) (<= x maxval )) true nil ))
; basic arc, if all is given , as part of a circle
; use: ( arc1 xm ym radius alpha beta )
( define ( arc1 xm ym radius malpha mbeta, dalpha mang )
( set 'dalpha ( asin ( div 1 radius )))
( for ( mang malpha mbeta dalpha )
( set 'x ( add 0.5 xm (mul radius (cos mang))))
( set 'y ( add 0.5 ym (mul radius (sin mang))))
( point (int x) (int y))))
; draws the short arc from point1 to point2 on a circle
; use: (arc2 xm ym x1 y1 x2 y2 )
( define ( arc2 xm ym x1 y1 x2 y2 , alpha1 beta1 df )
( set 'alpha1 ( getangle xm ym x1 y1 radius ))
( set 'beta1 ( getangle xm ym x2 y2 radius ))
( set 'df ( sub beta1 alpha1 ))
( if ( inrange? 0 PI df )
( arc1 xm ym radius alpha1 beta1 ) ; ok - simple arc
( if ( inrange? (mul 2 (sub PI)) (sub PI) df )
( begin ; from P1 to 0 , from 0 to P2
( arc1 xm ym radius alpha1 ( mul 2 PI ))
( arc1 xm ym radius 0 beta1 ))
nil ))); else no solution
; finds the right circle and draws the short arc from p1 to p2
; use: (arc ym x1 y1 x2 y2 radius )
( define (arc x1 y1 x2 y2 radius )
( set 'centers ( getcenter x1 y1 x2 y2 radius ))
( set 'xm (centers 0) 'ym (centers 1))
( set 'mok ( arc2 xm ym x1 y1 x2 y2 ))
( if ( not mok )
( begin
( set 'xm (centers 2) 'ym (centers 3))
( arc2 xm ym x1 y1 x2 y2 ) )))
; draw a path of arcs from p1-p2 , p2-p3, p3-p4 ...
(define ( drawarc radius closed plist)
( for ( i 0 (- ( length plist ) 4) 2 )
( arc (plist (+ i 0)) (plist (+ i 1))
(plist (+ i 2)) (plist (+ i 3)) radius inv ))
( if ( = 1 closed )
( arc ( plist -2) (plist -1 )
( plist 0) (plist 1) radius inv)))
Title:
Post by: didi on July 04, 2009, 10:58:57 AM
Post by: didi on July 04, 2009, 10:58:57 AM
new is a special arc-function , you give two points and a radius ...
OK - i know a manual would be not bad, and a special context , and some
optimization .. but until now it makes fun without it ;)
the rest is here :