# picoLisp + gtk-server example
# 26feb2009 Tomas Hlavaty
# $ ~/picolisp/p gtk-mandelbrot.l -bye
# requires http://www.gtk-server.org/embedded.l
# based on http://www.turtle.dds.nl/newlisp/fractal.lsp

(load "embedded.l")

# Callback to exit program
(de Exit_Prog ()
   (gtk_exit 0) )

# Callback to clear canvas
(de Clear_Canvas ()
   (gdk_color_parse "#ffffff" COLOR)
   (gdk_gc_set_rgb_fg_color GC COLOR)
   (gdk_draw_rectangle PIX GC 1 0 0 450 265)
   (gdk_color_parse "#000000" COLOR)
   (gdk_gc_set_rgb_fg_color GC COLOR)
   (gdk_draw_layout PIX GC 120 240 LAYOUT)
   (gtk_widget_queue_draw IMAGE) )

(setq *Scl 6)

# TODO based on http://logand.com/picoWiki/mandelbrot
(de mandelbrotPoint (X Y N)
   (let (X0 X Y0 Y I 0)
      (while (and (< I N)
                (<= (+ (*/ X X 1.0) (*/ Y Y 1.0)) 4.0) )
         (let (Xx (+ X0 (- (*/ X X 1.0) (*/ Y Y 1.0)))
               Yy (+ Y0 (*/ 2 X Y 1.0)) )
            (setq X Xx Y Yy) )
         (inc 'I) )
      I ) )

(de mandelbrot (X Y Sx Sy W H C)
   (let (N (- C 1)
         X1 (- X (/ Sx 2))
         Y1 (- Y (/ Sy 2)) )
      (for (J 0 (< J H) (inc J))
         (for (I 0 (< I W) (inc I))
            (let (X (+ X1 (*/ I Sx W))
                  Y (+ Y1 (*/ J Sy H)) )
               (pixel I J (mandelbrotPoint X Y N) C) ) )
         (row) ) ) )

(de Draw_Fractal ()
   # Tell drawing is starting
   (gdk_color_parse "#000000" COLOR)
   (gdk_gc_set_rgb_fg_color GC COLOR)
   (gdk_draw_layout PIX GC 10 240 START)
   (gtk_widget_queue_draw IMAGE)
   # draw the fractal
   (mandelbrot -0.5 0 3.0 2.0 300 265 100)
   # Wipe wait text
   (gdk_color_parse "#ffffff" COLOR)
   (gdk_gc_set_rgb_fg_color GC COLOR)
   (gdk_draw_rectangle PIX GC 1 10 240 120 25)
   # Tell drawing is ready
   (gdk_color_parse "#000000" COLOR)
   (gdk_gc_set_rgb_fg_color GC COLOR)
   (gdk_draw_layout PIX GC 10 240 READY)
   (gtk_widget_queue_draw IMAGE) )

(de pix (X Y C)
   (gdk_color_parse C COLOR)
   (gdk_gc_set_rgb_fg_color GC COLOR)
   (gdk_draw_point PIX GC X Y) )

(de bw (N C)
   (let V (*/ 255 N C)
      (pack "#"
         (pad 2 (hex V))
         (pad 2 (hex V))
         (pad 2 (hex V)) ) ) )
   
(de pixel (X Y N C)
   (let L '("#800000" "#800080" "#8000FF" "#808000"
            "#808080" "#8080FF" "#80FF00" "#80FF80"
            "#80FFFF" "#FF0000" "#FF0080" "#FF00FF"
            "#FF8000" "#FF8080" "#FF80FF" "#FFFF00" )
      (if (< N (- C 1))
         (pix X Y (nth L (+ (*/ 15 N (- C 1)) 1) 1))
#         (pix I J (bw (rand 0 (- C 1)) C))
#         (pix I J (bw N C))
         (pix X Y "#000000") ) ) )

(de row ()
   (gtk_widget_queue_draw IMAGE)
   (gtk_main_iteration) )
         
(de mainLoop @
   (let E 0 # TODO dispatch events automatically
      (until (prog
                (setq E (gtk_server_callback 'wait))
                (or (= E 'Exit_Prog) (= E WIN)) )
        (case E
           (Draw_Fractal (Draw_Fractal))
           (Clear_Canvas (Clear_Canvas)) )
           ) )
   (gtk_exit 0)
   (wait 200) ) # TODO remove this fix Could not delete FIFO. ERROR
   
# Window
(gtk_init 0 0)
(set 'WIN (gtk_window_new 0))
(gtk_window_set_title WIN "picoLisp fractal")
(gtk_widget_set_size_request WIN 300 300)
(gtk_window_set_position WIN 1)
(gtk_window_set_resizable WIN 0)
(gtk_server_connect WIN 'delete-event 'Exit_Prog)
# Create widget to display image
(set 'IMAGE (gtk_image_new))
# Create eventbox to catch mouseclick
(set 'EBOX (gtk_event_box_new))
(gtk_container_add EBOX IMAGE)
# Separator
(set 'SEP (gtk_hseparator_new))
# Action button
(set 'ACTION_BUTTON (gtk_button_new_with_label "Draw!"))
(gtk_widget_set_size_request ACTION_BUTTON 75 30)
(gtk_server_connect ACTION_BUTTON 'clicked 'Draw_Fractal)
# Clear button
(set 'CLEAR_BUTTON (gtk_button_new_with_label "Clear"))
(gtk_widget_set_size_request CLEAR_BUTTON 75 30)
(gtk_server_connect CLEAR_BUTTON 'clicked 'Clear_Canvas)
# Exit button
(set 'EXIT_BUTTON (gtk_button_new_with_label "Exit"))
(gtk_widget_set_size_request EXIT_BUTTON 75 30)
(gtk_server_connect EXIT_BUTTON 'clicked 'Exit_Prog)
# Now arrange widgets on window using boxes
(set 'HBOX (gtk_hbox_new 0 0))
(gtk_box_pack_start HBOX CLEAR_BUTTON 0 0 1)
(gtk_box_pack_start HBOX ACTION_BUTTON 0 0 1)
(gtk_box_pack_end HBOX EXIT_BUTTON 0 0 1)
(set 'VBOX (gtk_vbox_new 0 0))
(gtk_box_pack_start VBOX EBOX 0 0 1)
(gtk_box_pack_start VBOX SEP 0 0 1)
(gtk_box_pack_end VBOX HBOX 0 0 1)
(gtk_container_add WIN VBOX)
# Show all widgets
(gtk_widget_show_all WIN)
# Create the pixmap
(set 'GDKWIN (gtk_widget_get_parent_window IMAGE))
(set 'PIX (gdk_pixmap_new GDKWIN 300 265 -1))
(set 'GC (gdk_gc_new PIX))
(gtk_image_set_from_pixmap IMAGE PIX 0)
# Allocate memory with some random widget for GdkColor
(set 'COLOR (gtk_frame_new 'NULL))
# Now set foreground and backgroundcolors to WHITE
(gdk_color_parse "#ffffff" COLOR)
(gdk_gc_set_rgb_bg_color GC COLOR)
(gdk_gc_set_rgb_fg_color GC COLOR)
# Clear the complete pixmap with WHITE
(gdk_draw_rectangle PIX GC 1 0 0 300 265)
# Set color to BLACK
(gdk_color_parse "#000000" COLOR)
(gdk_gc_set_rgb_fg_color GC COLOR)
# Put some text on the canvas
(set 'LAYOUT
(gtk_widget_create_pango_layout IMAGE "Draw a fractal with picoLisp!") )
(gdk_draw_layout PIX GC 120 240 LAYOUT)
# Define start and finishing text
(set 'START (gtk_widget_create_pango_layout IMAGE "Please wait..."))
(set 'READY (gtk_widget_create_pango_layout IMAGE "Drawing ready."))
# Update the IMAGE widget with the pixmap
(gtk_widget_queue_draw IMAGE)
#(gtk_main)
(mainLoop)