[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] Mandelbrot
From: |
Mike Thomas |
Subject: |
[Gcl-devel] Mandelbrot |
Date: |
Wed, 4 Aug 2004 13:02:51 +1000 |
Hi all.
Inspired by the recent discussion on the Mandelbrot set, for those of you
using the prebuilt Windows GCL 2.6.3 (which has a JAPI GUI library binding
built in), here is a monochrome graphical Mandelbrot program which allows
you to save a small Windows BMP named "mandel.bmp" on your desktop).
To compile and run:
(load (compile-file "c:/japi_mandel.lsp"))
Cheers
Mike Thomas.
=======================================================
(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 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)))))
(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) )))))))))))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Gcl-devel] Mandelbrot,
Mike Thomas <=