gcl-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Gcl-devel] Re: [Axiom-developer] axiom graphics and porting


From: Camm Maguire
Subject: [Gcl-devel] Re: [Axiom-developer] axiom graphics and porting
Date: 27 Apr 2005 11:57:48 -0400
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2

Greetings!

"Mike Thomas" <address@hidden> writes:

> Hi Tim and Bill.
> 
> Several things:
> 
> | GCL does not seem to handle run-process correctly
> 
> Could you please give us more details?
> 
> Without wishing to tell Bill or yourself what to do with your own project
> regarding X and/or Cygwin, I think it would be a major mistake to follow
> that route for the reasons outlined here:
> 
>   http://www.math.utexas.edu/pipermail/maxima/2004/006716.html
> 
> I really can't emphasize my personal lack of interest in such a course of
> action enough without actually walking off the GCL Windows job (although I
> have no such intention thereof at present).
> 

Thankfully!!  How hard is it to recode the exisiting C graphics in
Windows?

> Be aware also that for a couple of years a GCL binding to the Java GUI
> library (JAPI) has existed in our CVS and although only ever tested by me on
> Windows, should be fine on Unix as JAPI is cross-platform itself.  I've
> inserted below an example program from the GCL source tree to give you a
> feel for the way it works - it does various graphics and text things
> including a simple mandelbrot display and the (extremely) bare bones of a
> text editor.  This program is the only Lisp binding documentation in
> existence for the library.  The JAPI binding is included in every Windows
> GCL binary release.
> 
> Having said that, Camm has always been very enthusiastic about GCL/Tk and it
> seems to me that it is a good way to go for that reason alone.  Another
> (negative) argument in its favour is that JAPI seems to be moribund whereas
> TCL/Tk is, of course, very active.
> 

Not to mention that java is far from open source.

Take care,

> Cheers
> 
> Mike Thomas.
> 
> 
> 
> ===== japitest.lsp ==========
> 
> ;;;
> ;;; Japi is a cross-platform, easy to use (rough and ready) Java based GUI
> library
> ;;; Download a library and headers for your platform, and get the C examples
> ;;; and documentation from:
> ;;;
> ;;;     http://www.japi.de/
> ;;;
> ;;; This file shows how to use some of the available functions.  You may
> assume
> ;;; that the only functions tested so far in the binding are those which
> appear
> ;;; below, as this file doubles as the test program.  The binding is so
> simple
> ;;; however that so far no binding (APART FROM J_PRINT) has gone wrong of
> those
> ;;; tested so far!
> ;;;
> ;;;
> ;;; HOW TO USE THIS FILE
> ;;;
> ;;; (compile-file "c:/cvs/gcl/japitest.lsp") (load "c:/cvs/gcl/japitest.o")
> ;;;
> ;;; Requires either "java" or "jre" in the path to work.
> ;;;
> 
> (in-package :japi-primitives)
> 
> ;; Start up the Japi server (needs to find either "java" or "jre" in your
> path
> (defmacro with-server ((app-name debug-level) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(if (= 0 (jpr::j_start))
>                           (format t (format nil "~S can't connect to the Japi 
> GUI server."
> ,app-name))
>                         (progn
>                           (j_setdebug ,debug-level)
>                           ,@ds
>                           (unwind-protect
>                               (progn ,@b)
>                             (j_quit))))))
> 
> ;; Use a frame and clean up afterwards even if trouble ensues
> (defmacro with-frame ((frame-var-name title) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,frame-var-name (j_frame ,title)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,frame-var-name)))))
> 
> ;; Use a canvas and clean up afterwards even if trouble ensues
> (defmacro with-canvas ((canvas-var-name frame-obj x-size y-size) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,canvas-var-name (j_canvas ,frame-obj ,x-size 
> ,y-size)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,canvas-var-name)))))
> 
> ;; Use a text area and clean up afterwards even if trouble ensues
> (defmacro with-text-area ((text-area-var-name panel-obj x-size y-size) .
> body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,text-area-var-name (j_textarea ,panel-obj 
> ,x-size
> ,y-size)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,text-area-var-name)))))
> 
> ;; Use a pulldown menu bar and clean up afterwards even if trouble ensues
> (defmacro with-menu-bar ((bar-var-name frame-obj) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,bar-var-name (j_menubar ,frame-obj)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,bar-var-name)))))
> 
> ;; Add a pulldown menu and clean up afterwards even if trouble ensues
> (defmacro with-menu ((menu-var-name bar-obj title) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,menu-var-name (j_menu ,bar-obj ,title)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,menu-var-name)))))
> 
> ;; Add a pulldown menu item and clean up afterwards even if trouble ensues
> (defmacro with-menu-item ((item-var-name menu-obj title) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,item-var-name (j_menuitem ,menu-obj ,title)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,item-var-name)))))
> 
> ;; Add a mouse listener and clean up afterwards even if trouble ensues
> (defmacro with-mouse-listener ((var-name obj type) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,var-name (j_mouselistener ,obj ,type)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,var-name)))))
> 
> ;; Use a panel and clean up afterwards even if trouble ensues
> (defmacro with-panel ((panel-var-name frame-obj) . body)
>   (multiple-value-bind (ds b)
>                      (si::find-declarations body)
>                      `(let ((,panel-var-name (j_panel ,frame-obj)))
>                         ,@ds
>                         (unwind-protect
>                             (progn ,@b)
>                           (j_dispose ,panel-var-name)))))
> 
> ;; Get a pointer to an array of ints
> (defCfun "static void* inta_ptr(object s)" 0
>   " return(s->fixa.fixa_self);")
> (defentry inta-ptr (object) (int "inta_ptr"))
> 
> ;; Draw function
> (defun drawgraphics (drawable xmin ymin xmax ymax)
>   (let* ((fntsize 10)
>        (tmpstrx (format nil "XMax = ~D" xmax))
>        (tmpstry (format nil "YMax = ~D" ymax))
>        (tmpstrwidx (j_getstringwidth drawable tmpstrx)))
>     (j_setfontsize drawable fntsize)
>     (j_setnamedcolor drawable J_RED)
> 
>     (j_drawline drawable xmin ymin        (- xmax 1)      (- ymax 1))
>     (j_drawline drawable xmin (- ymax 1)  (- xmax 1)      ymin)
>     (j_drawrect drawable xmin ymin        (- xmax xmin 1) (- ymax xmin 1))
> 
>     (j_setnamedcolor drawable J_BLACK)
>     (j_drawline drawable xmin (- ymax 30) (- xmax 1)      (- ymax 30))
>     (j_drawstring drawable (- (/ xmax 2) (/ tmpstrwidx 2)) (- ymax 40)
> tmpstrx)
> 
>     (j_drawline drawable (+ xmin 30) ymin (+ xmin 30) (- ymax 1))
>     (j_drawstring drawable (+ xmin 50) 40 tmpstry)
> 
>     (j_setnamedcolor drawable J_MAGENTA)
>     (loop for i from 1 to 10
>         do (j_drawoval drawable
>                        (+ xmin (/ (- xmax xmin) 2))
>                        (+ ymin (/ (- ymax ymin) 2))
>                        (* (/ (- xmax xmin) 20) i)
>                        (* (/ (- ymax ymin) 20) i)))
> 
>     (j_setnamedcolor drawable J_BLUE)
>     (let ((y ymin)
>         (teststr "JAPI Test Text"))
>       (loop for i from 5 to 21 do
>           (j_setfontsize drawable i)
>           (let ((x (- xmax (j_getstringwidth drawable teststr))))
>             (setf y (+ y (j_getfontheight drawable)))
>             (j_drawstring drawable x y teststr))))))
> 
> 
> 
> ;; Run a five second frame in a Japi server
> (with-server ("GCL Japi library test GUI 1" 0)
>            (with-frame (frame "Five Second Blank Test Frame")
>                        (j_show frame)
>                        (j_sleep 5000)))
> 
> 
> ;; Run some more extensive tests
> (with-server
>  ("GCL Japi library test GUI 2" 0)
>  (with-frame
>   (frame "Draw")
>   (j_show frame)
>   (let ((alert (j_messagebox frame "Two second alert box" "label")))
>     (j_sleep 2000)
>     (j_dispose alert))
>   (let ((result1 (j_alertbox frame "label1" "label2" "OK"))
>       (result2 (j_choicebox2 frame "label1" "label2" "Yes" "No"))
>       (result3 (j_choicebox3 frame "label1" "label2" "Yes" "No" "Cancel")))
>     (format t "Requestor results were: ~D, ~D, ~D~%" result1 result2
> result3))
>   (j_setborderlayout frame)
>   (with-menu-bar
>    (menubar frame)
>    (with-menu
>     (file menubar "File")
>     (with-menu-item
>      (print file "Print")
>      (with-menu-item
>       (save file "Save BMP")
>       (with-menu-item
>        (quit file "Quit")
>        (with-canvas
>       (canvas frame 400 600)
>       (j_pack frame)
>       (drawgraphics canvas 0 0 (j_getwidth canvas) (j_getheight canvas))
>       (j_show frame)
>       (do ((obj (j_nextaction) (j_nextaction)))
>           ((or (= obj frame) (= obj quit)) t)
>           (when (= obj canvas)
>             (j_setnamedcolorbg canvas J_WHITE)
>             (drawgraphics canvas 10 10
>                           (- (j_getwidth canvas) 10)
>                           (- (j_getheight canvas) 10)))
>           (when (= obj print)
>             (let ((printer (j_printer frame)))
>               (when (> 0 printer)
>                 (drawgraphics printer 40 40
>                               (- (j_getwidth printer) 80)
>                               (- (j_getheight printer) 80))
>                 (j_print printer))))
>           (when (= obj save)
>             (let ((image (j_image 600 800)))
>               (drawgraphics image 0 0 600 800)
>               (when (= 0 (j_saveimage image "test.bmp" J_BMP))
>                 (j_alertbox frame "Problems" "Can't save the image" 
> "OK")))))))))))))
> 
> ;; Try some mouse handling
> (with-server
>  ("GCL Japi library test GUI 3" 0)
>  (with-frame
>   (frame "Move and drag the mouse")
>   (j_setsize frame 430 240)
>   (j_setnamedcolorbg frame J_LIGHT_GRAY)
>   (with-canvas
>    (canvas1 frame 200 200)
>    (with-canvas
>     (canvas2 frame 200 200)
>     (j_setpos canvas1 10 30)
>     (j_setpos canvas2 220 30)
>     (with-mouse-listener
>      (pressed canvas1 J_PRESSED)
>      (with-mouse-listener
>       (dragged canvas1 J_DRAGGED)
>       (with-mouse-listener
>        (released canvas1 J_RELEASED)
>        (with-mouse-listener
>       (entered canvas2 J_ENTERERD)
>       (with-mouse-listener
>        (moved canvas2 J_MOVED)
>        (with-mouse-listener
>         (exited canvas2 J_EXITED)
>         (j_show frame)
>           ;; Allocate immovable storage for passing data back from C land.
>         ;; Uses the GCL only make-array keyword :static
>         (let* ((xa (make-array 1 :initial-element 0 :element-type 'fixnum 
> :static
> t))
>                (ya (make-array 1 :initial-element 0 :element-type 'fixnum 
> :static t))
>                (pxa (inta-ptr xa))
>                (pya (inta-ptr ya))
>                (x 0)
>                (y 0)
>                (get-mouse-xy (lambda (obj)
>                                (progn (j_getmousepos obj pxa pya)
>                                       (setf x (aref xa 0))
>                                       (setf y (aref ya 0)))))
>                (startx 0)
>                (starty 0))
>           (do ((obj (j_nextaction) (j_nextaction)))
>               ((= obj frame) t)
>               (when (= obj pressed)
>                 (funcall get-mouse-xy pressed)
>                 (setf startx x)
>                 (setf starty y))
>               (when (= obj dragged)
>                 (funcall get-mouse-xy dragged)
>                 (j_drawrect canvas1 startx starty (- x startx) (- y starty)))
>               (when (= obj released)
>                 (funcall get-mouse-xy released)
>                 (j_drawrect canvas1 startx starty (- x startx) (- y starty)))
>               (when (= obj entered)
>                 (funcall get-mouse-xy entered)
>                 (setf startx x)
>                 (setf starty y))
>               (when (= obj moved)
>                 (funcall get-mouse-xy moved)
>                 (j_drawline canvas2 startx starty x y))
>               (setf startx x)
>               (setf starty y)
>               (when (= obj exited)
>                 (funcall get-mouse-xy exited)
>                 (j_drawline canvas2 startx starty x y))))))))))))))
> 
> ;; Text editor demo
> (with-server
>  ("GCL Japi library test text editor" 0)
>  (with-frame
>   (frame "A simple editor")
>   (j_setgridlayout frame 1 1)
>   (with-panel
>    (panel frame)
>    (j_setgridlayout panel 1 1)
>    (with-menu-bar
>     (menubar frame)
>     (with-menu
>      (file-mi menubar "File")
>      (with-menu-item
>       (new-mi file-mi "New")
>       (with-menu-item
>        (save-mi file-mi "Save")
>        (j_seperator file-mi)
>        (with-menu-item
>       (quit-mi file-mi "Quit")
> 
>       (with-menu
>        (edit-mi menubar "Edit")
>        (with-menu-item
>         (select-all-mi edit-mi "Select All")
>         (j_seperator edit-mi)
>         (with-menu-item
>          (cut-mi edit-mi "Cut")
>          (with-menu-item
>           (copy-mi edit-mi "Copy")
>           (with-menu-item
>            (paste-mi edit-mi "Paste")
> 
>            (with-text-area
>             (text panel 15 4)
>             (j_setfont text J_DIALOGIN J_BOLD 18)
>             (let ((new-text (format nil "JAPI (Java Application~%Programming
> Interface)~%a platform and language~%independent API")))
>               (j_settext text new-text)
>               (j_show frame)
>               (j_pack frame)
>               (j_setrows text 4)
>               (j_setcolumns text 15)
>               (j_pack frame)
>               ;; Allocate immovable storage for passing data back from C land.
>               ;; Uses the GCL only make-array keyword :static
>               (let* ((xa (make-array 1 :initial-element 0 :element-type 
> 'fixnum :static
> t))
>                      (ya (make-array 1 :initial-element 0 :element-type 
> 'fixnum :static
> t))
>                      (pxa (inta-ptr xa))
>                      (pya (inta-ptr ya))
>                      (x 0)
>                      (y 0)
>                      (get-mouse-xy (lambda (obj)
>                                      (progn (j_getmousepos obj pxa pya)
>                                             (setf x (aref xa 0))
>                                             (setf y (aref ya 0)))))
>                      (startx 0)
>                      (starty 0)
>                      (selstart 0)
>                      (selend 0)
>                      (text-buffer (make-array 64000 :initial-element 0 
> :element-type
> 'character :static t))
>                                       ;             (text-buffer (make-string 
> 64000 :initial-element #\0))
>                      (p-text-buffer (inta-ptr text-buffer)))
>                 (do ((obj (j_nextaction) (j_nextaction)))
>                     ((or (= obj frame) (= obj quit-mi))t)
>                     (when (= obj panel)
>                       (format t "Size changed to ~D rows ~D columns~%" 
> (j_getrows text)
> (j_getcolumns text))
>                       (format t "Size changed to ~D x ~D pixels~%" 
> (j_getwidth text)
> (j_getheight text)))
>                     (when (= obj text) (format t "Text changed (len=~D)~%" 
> (j_getlength
> text) ))
>                     (when (= obj new-mi) (j_settext new-text))
>                     (when (= obj save-mi) (j_gettext text text-buffer))
>                     (when (= obj select-all-mi) (j_selectall text))
>                     (when (or (= obj cut-mi)
>                               (= obj copy-mi)
>                               (= obj paste-mi))
>                       (setf selstart (1- (j_getselstart text)))
>                       (setf selend (1- (j_getselend text))))
>                     (when (= obj cut-mi)
>                       (j_getseltext text p-text-buffer)
>                       (j_delete text (1- (j_getselstart text)) (1- 
> (j_getselend text)))
>                       (setf selend selstart))
>                     (when (= obj copy-mi)
>                       (j_getseltext text p-text-buffer))
>                     (when (= obj paste-mi)
>                       (if (= selstart selend)
>                           (j_inserttext text p-text-buffer (1- (j_getcurpos 
> text)))
>                         (j_replacetext text p-text-buffer (1- (j_getselstart 
> text)) (1-
> (j_getselend text))))
>                       ))))))))))))))))))
> 
> (defun mandel (drawable min_x max_x min_y max_y step_x step_y)
>   (let* ((scale_x (/ 1 step_x))
>        (scale_y (/ 1 step_y)))
>     (loop for y from min_y to max_y by step_y do
>         (loop for x from min_x to max_x by step_x do
>               (let* ((c 255)
>                      (z (complex x y))
>                      (a z))
>                 (loop while (and (< (abs
>                                      (setq z (+ (* z z) a)))
>                                     2)
>                                  (>= (decf c) 0)))
>                 (j_setcolor drawable c c c)
>                 (j_drawpixel drawable (* scale_x (+ (abs min_x) x)) (* 
> scale_y (+ (abs
> min_y) y)) ))))))
> 
> ;;; Monochrome Mandelbrot
> (with-server
>  ("GCL Japi library test GUI 4" 0)
>  (let* ((min_x -2)
>       (max_x  1)
>       (min_y -1)
>       (max_y  1.1)
>       (step_x 0.01)
>       (step_y 0.01)
>       (size_x (+ 1 (/ (- max_x min_x) step_x)))
>       (size_y (+ 1 (/ (- max_y min_y) step_y))))
>    (with-frame
>     (frame "Mandelbrot")
>     (j_setsize frame size_x size_y)
>     (j_setborderlayout frame)
>     (with-menu-bar
>      (menubar frame)
>      (with-menu
>       (file menubar "File")
>       (with-menu-item
>        (save file "Save BMP")
>        (with-menu-item
>       (quit file "Quit")
>       (with-canvas
>        (canvas1 frame size_x size_y)
>        (j_pack frame)
>        (j_show frame)
>        (j_show canvas1)
>        (mandel canvas1  min_x max_x min_y max_y step_x step_y)
>        (do ((obj (j_nextaction) (j_nextaction)))
>            ((or (= obj frame) (= obj quit)) t)
>            (when (= obj save)
>              (let ((image (j_getimage canvas1)))
>                (when (= 0 (j_saveimage image "mandel.bmp" J_BMP))
>                  (j_alertbox frame "Problems" "Can't save the image" "OK"))
>                (j_dispose image) )))))))))))
> 
> 
> 
> 
> _______________________________________________
> Axiom-developer mailing list
> address@hidden
> http://lists.nongnu.org/mailman/listinfo/axiom-developer
> 
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah




reply via email to

[Prev in Thread] Current Thread [Next in Thread]