oh-no-graphic

Guiserver, GTK-server, OpenGL, PostScript,
HTML 5, MIDI, IDE
Locked
didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

oh-no-graphic

Post by didi »

PART1 :
my old rgb-mixer enhanced with one line for ppm-graphic-format :

Code: Select all

; 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 )))

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Part2 :

Code: Select all

; 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 "P6\n" (string width) " " (string height) "\n255\n" ))
; convert bitmap to string and append to ppm-file
( append-file "first.ppm" (join (array-list bmparray )))

( println ( length bmpstr ) ) 

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Crazy ! ?

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" :-)

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

Look also into 'mat', 'multiply' etc. matrix operations, which might help you to speed up your code.

Not crazy at all! People have done low-level byte crunching with newLISP before and often with acceptable speed.

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Thanks Lutz for your help .
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 all

; 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 .

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

This is a clever idea! Can't get it working yet, though...

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...???

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Here you can download the generated file, as it is generated on my pc:
http://www.dmemos.de/onographic/first.ppm

Here is a 400% zoomed screendump how it is shown in photoimpact:

Image


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.

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

I put all the code into the same file. I think it's correct. I'm still of the opinion that the Unicode is a problem, since my bmparray is filling up like this:

("\195\191\195\191\000" "\195\191\195\191\000" "\195\191\195\191\000" "\195\191\195\191\000" ...

I may look at 'pack' tomorrow to see if that provides a solution. But now, bed... :)

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

I think you are right. The bitmap-array should look like this :

.... "\255\255\000" "\255\255\000" "\255\255\000" "\255\000\000")

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Image

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:

http://www.dmemos.de/onographic/onograp ... raph11.lsp

http://www.dmemos.de/onographic/onograp ... lines2.lsp

http://www.dmemos.de/onographic/onograp ... gb-ppm.lsp

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 ?

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

After quickly looking through the code, I see only the newLISP function 'char' which is working differently on UTF-8 enabled versions. In file: http://www.dmemos.de/onographic/onograp ... gb-ppm.lsp change:

Code: Select all

(define (ppm mrgb) (join (map char mrgb)))
to:

Code: Select all

(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'.

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Thanks Lutz , this works if i call it direct with a list, but not with a variable representing a list, here a short copy from my newLISP-GS monitor :

Code: Select all

> yellow 
(255 255 0)
> ( ppm yellow )
"\000\000\000"
> ( ppm '( 255 255 0 ) )
"\255\255\000"
> ( list? yellow )
true
> 
Maybe i didn't understand the pack-command .

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

that sounds impossible, it works for me:

Code: Select all

> (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)
"\255\255\000"
> 
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 minimal but complete program to demonstrate that?

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

Works well here (Mac).

I thought that PPM was not immediately useful as a format. But I found that, on my Mac at least, there's a convert command which I believe is part of ImageMagick. So:

Code: Select all

$ convert first.ppm first.png
convert these PPM files to PNG. Cool, eh?!

I'm hoping to play a bit more with this soon...

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Code: Select all

; 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))
"\000\000\000"

PS: Cormullion good! - the same must exist for windows, but i have it not yet.

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

because of the 'add' in:

Code: Select all

( 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 all

( 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.
Last edited by Lutz on Wed Jun 03, 2009 1:00 pm, edited 1 time in total.

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

OK - thanks Lutz.

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

http://www.dmemos.de/onographic/

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 ) "

Image

cormullion
Posts: 2038
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:

Post by cormullion »

Nice work, didi! I like your minimalist approach, which is something I aspire to but rarely achieve... :)
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 ) "
You could try:

Code: Select all

(apply line (0 4 plist))
instead of

Code: Select all

(line ( plist 0 ) ( plist 1 ) ( plist 2 ) ( plist 3 ))
using implicit slices rather than implicit indexes. There's loads of ways, I think.

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

THX Cormullion :) - Now with pretty fast circles :

Code: Select all

; 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 ))
)
Image

http://www.dmemos.de/onographic/

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

arcs

Post by didi »

Code: Select all

; 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)))

didi
Posts: 166
Joined: Fri May 04, 2007 8:24 pm
Location: Germany

Post by didi »

Image

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 : http://www.dmemos.de/onographic

Locked