having so much fun.
yes certainly , thanks John ...
While tk/tcl may (at this moment) have a kind of aura of obsoleteness (because - i read - very popular in the '90s on UNIX systems) - i find it very usable. On top you get another scripting language that completely can be mixed with other scripts. I did try it together with the gigantesque Common Lisp compilers -- but I do not like it this way . As you mentioned the speed difference between compiled and interpreted lisp is not that huge IMHO , a script with JIT compiling and/or DLL/so 's combined with OpenGL scripts is the optimum ...
As I found the tk canvas related functions are rather slow , i wrote some functions myself for pixel graphics , based (if wished) on buffered graphics (both choices are possible - buffered and unbuffered ). these are about 10x faster than tk/tcl (system memory is used , no hardware)
the newLISP code itself runs on Win / Linux / Wine without any change -- the code detects the OStype.. (only under Linux the *.so file has to be copied -- but probably it must be possible with a script to use it from the location of the executable ?)
All calculations are done in the script -- given the fact that this is about 21.000 complex prime numbers, i don't think it is slow..
;-------------------------------code
(silent
(if (= ostype "Linux") (setq DLL "libscreen.so") (setq DLL "libscreen.dll"))
(if (= ostype "Linux") (setq PATH "/usr/bin/wish") (setq PATH "c:/Tcl/bin/wish.exe"))
(dolist (i (list "SETSCREEN" "PIXEL" "ENDSCREEN" "SCRLOCK" "SCRUNLOCK" "SCRCLR")) (import DLL i))
(define XY (array 400 400 '(0)))
(map set '(myin tcout) (pipe))
(map set '(tcin myout) (pipe))
(process PATH tcin tcout)
(define (tk)
(write-line myout (append "if { [catch { puts ["
(apply string (args)) "] }] } { "
[text] tk_messageBox -message $errorInfo; exit }
[/text]))
(let (str "")
(while (starts-with (setq str (read-line myin)) "newLISP:")
(eval-string ((length "newLISP: ") -1 str)))
str))
(global 'tk)
;; this is for compatibility with newlisp-tk
;; for new programs just use 'puts' without the 'Newlisp' wrapper
(tk "proc Newlisp { command } { puts $command }")
;; exit when main window is closed
(tk "bind . <Destroy> {puts {(exit)}}")
(define (prime? x)
(= 1 (length (factor x))))
(define (sq x) (* x x))
(define (gaussprime? x y)
(prime? (+ (sq x) (sq y))))
(define (zeven? x y)
(even? (+ (sq x) (sq y))))
(define (zodd? x y)
(not (zeven? x y)))
(define (setup-XY) ;; preprocessor
(setq nr 0)
(dotimes (i 400)
(dotimes (j 400)
(let ((p (+ (sq (- i 200)) (sq (- j 200)))))
(when (prime? p) (setf (XY i j) 1) (++ nr) )))))
(define (zodd-zeven)
(SCRLOCK)
(for (i -200 200)
(for (j -200 200)
(if (zeven? i j)
(PIXEL (+ 200 i) (+ 200 j) 0 200 0)
(PIXEL (+ 200 i) (+ 200 j) 200 0 0) )))
(SCRUNLOCK))
(define (info s)
(tk (append ".lb config -text " s )))
(define (main)
(SCRLOCK)
(dotimes (i 400)
(dotimes (j 400)
(when (> (XY i j) 0) (PIXEL i j 0 222 0))))
(info (append "#primes=" (string nr)) )
(SCRUNLOCK)
)
(define (stars)
(let ((pixel (lambda(x y) (PIXEL x y 200 200 0))))
(for (i 1 398)
(for (j 1 398)
(when (zero? (XY i j))
(when (> (XY (+ i 1) j) 0)
(when (> (XY (- i 1) j) 0)
(when (> (XY i (+ j 1)) 0)
(when (> (XY i (- j 1)) 0)
(pixel i (+ j 1)) (pixel i (- j 1)) (pixel (+ i 1) j) (pixel (- i 1) j) )))))))
))
(define (twins)
(let ((pixel (lambda(x y) (PIXEL x y 255 0 0))))
(SCRLOCK)
(for (i 1 398)
(for (j 1 398)
(when (zero? (XY i j))
(when (> (XY (+ i 1) j) 0)
(when (> (XY (- i 1) j) 0)
(pixel (+ i 1) j) (pixel (- i 1) j)) )
(when (> (XY i (+ j 1)) 0)
(when (> (XY i (- j 1)) 0)
(pixel i (+ j 1)) (pixel i (- j 1))))))))
(SCRUNLOCK) )
(define (dens)
(SCRLOCK)
(let ( (acc (lambda (x y d) (+ (XY (- x d) y) (XY (+ x d) y) (XY x (+ y d)) (XY x (- y d))
(XY (- x d) (+ y d)) (XY (+ x d) (+ y d))
(XY (- x d) (- y d)) (XY (+ x d) (- y d)) ))))
(for (i 2 396)
(for (j 2 396)
(PIXEL i j 80 0 (* 120 (acc i j 1)) ))))
(SCRUNLOCK)
)
(define (run )
(tk "frame .fr -relief sunken ")
(tk "wm title . Gaussprimes")
(tk "wm geometry . 200x220+30+30")
(tk "label .lb -text {info} -width 20 -pady 5 -bg {gray80} ")
(tk "button .b -text {Gaussprimes*} -command {Newlisp {(main)}} -width 15")
(tk "button .b2 -text {CLR Scr} -command {Newlisp {(SCRCLR)}} -width 15 -bg {gray60} -relief sunken")
(tk "button .b3 -text {zodd & zeven} -command {Newlisp {(zodd-zeven)}} -width 15")
(tk "button .b4 -text {StarS} -command {Newlisp {(stars)}} -width 15")
(tk "button .b5 -text {TwinS} -command {Newlisp {(twins)}} -width 15")
(tk "button .b6 -text {Density} -command {Newlisp {(dens)}} -width 15")
(tk "pack .b4 -in .fr -side bottom")
(tk "pack .b -in .fr -side bottom ")
(tk "pack .b6 -in .fr -side bottom ")
(tk "pack .b5 -in .fr -side bottom")
(tk "pack .b3 -in .fr -side bottom")
(tk "pack .b2 -in .fr -side bottom")
(tk "pack .lb -in .fr -side bottom ")
(tk "pack .fr")
(setup-XY)
(SETSCREEN 400 400 350 30)
)
(run)
(while (read-line myin)
(eval-string (current-line)))
)
best , Rob (attached, both the Linux and Win executables)
of course OpenGL , can be used for this .. but for some quick and fast progs this is very easy and usable -- one graphic screen of any size can be set up
.
