gcl-devel
[Top][All Lists]
Advanced

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







reply via email to

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