#!/usr/bin/newlisp
#
# Draw a fractal with the GTK-server and newLisp.
#
# Developed with newLisp 8.6.0 WinXP.
#
# newLisp draws the fractal extremely fast.
# Codesample. July 27, 2005 - PvE.
#
# Rewritten to embedded GTK at july 23, 2006
# Adjusted for newLisp 10 at december 25, 2008 - PvE.
#------------------------------------------------------- GTK stuff

# Import GTK-server and create global symbols for GTK function names
(if
    (= ostype "Win32") (import "gtk-server.dll" "gtk")
    (= ostype "OSX") (import "libgtk-server.dylib" "gtk")
    (= ostype "Linux") (import "libgtk-server.so" "gtk")
)

# Now try to find GTK-server configfile
(set 'cfgfile (open "gtk-server.cfg" "read"))
(when (not cfgfile)
    (set 'cfgfile (open "/usr/local/etc/gtk-server.cfg" "read"))
    (when (not cfgfile) (set 'cfgfile (open "/etc/gtk-server.cfg" "read"))))

# No configfile? Exit
(when (not cfgfile)(println "No GTK-server configfile found! Exiting...")(exit))

# Create global GTK symbols
(while (read-line cfgfile)
    (when (and (starts-with (current-line) "FUNCTION_NAME") (regex "gtk_+|gdk_+|g_+" (current-line)))
	(set 'func (chop ((parse (current-line) " ") 2)))
	(set 'lb (append {(lambda()(setq s "} func {")(dolist (x (args))(setq s (string s " " x)))(get-string (gtk s)))}))
	(constant (global (sym func)) (eval-string lb))))

(close cfgfile)

(constant (global 'NULL) "NULL")

(set-locale "C")

#-------------------------------------------------------

# Main context starts here
(context 'MAIN)

# The core calculation routine was taken from http://www.cygnus-software.com/theory/theory.htm
# and translated to newLisp by me.
# With friendly permission of Cygnus-Software.

(define (Draw_Fractal)

(set 'MaxIters 100)
(set 'SIZE 240)
(set 'BLACK -1)
(set 'LEFT -2.0)
(set 'RIGHT 1.0)
(set 'TOP 1.0)
(set 'BOTTOM -1.0)

# 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)
(gtk_server_callback "update")

# The calculation
(for (Y 0 SIZE)
    (for (X 0 SIZE)
	(set 'ZR 0.0)
	(set 'ZI 0.0)
	(set 'CR (add (div (mul (sub RIGHT LEFT) X) SIZE) LEFT))
	(set 'CI (add (div (mul (sub BOTTOM TOP) Y) SIZE) TOP))

	(set 'RSQUARED (mul ZR ZR))
	(set 'ISQUARED (mul ZI ZI))

	(set 'COUNT 0)
	(while (and (< (add RSQUARED ISQUARED) 2.0) (< COUNT MaxIters))
	    (set 'ZI (mul (mul ZR ZI) 2.0))
	    (set 'ZI (add ZI CI))

	    (set 'ZR (sub RSQUARED ISQUARED))
	    (set 'ZR (add ZR CR))

	    (set 'RSQUARED (mul ZR ZR))
	    (set 'ISQUARED (mul ZI ZI))

	    (inc COUNT))

	    (set 'SUM (add RSQUARED ISQUARED))
	    (if (< SUM 2.0)
		(begin
		    (if (< SUM 1.0)
			(set 'INDEX (mul SUM 16))
			(set 'INDEX 15)
		    )
		    (gdk_color_parse (nth INDEX PICOL) COLOR)
		    (gdk_gc_set_rgb_fg_color GC COLOR)
		    (gdk_draw_point PIX GC X Y)
		    (set 'event (gtk_server_callback "update"))
		    (if (or (= event EXIT_BUTTON) (= event WIN)) (exit))
		)
	    )
	)
	(gtk_widget_queue_draw IMAGE)
	(gtk_server_callback "update"))

# 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)
(gtk_server_callback "update")
)

#-------------------------------------------------------

# Define array with colors - taken from the newLisp HTML fractal example
(constant 'PICOL '("#800000" "#800080" "#8000FF" "#808000"
"#808080" "#8080FF" "#80FF00" "#80FF80" "#80FFFF"
"#FF0000" "#FF0080" "#FF00FF" "#FF8000" "#FF8080"
"#FF80FF" "#FFFF00"))

# Window
(gtk_init NULL NULL)
(set 'WIN (gtk_window_new 0))
(gtk_window_set_title WIN {"newLisp with GTK-server"})
(gtk_widget_set_size_request WIN 300 300)
(gtk_window_set_position WIN 1)
(gtk_window_set_resizable WIN 0)
# 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)
# Clear button
(set 'CLEAR_BUTTON (gtk_button_new_with_label "Clear"))
(gtk_widget_set_size_request CLEAR_BUTTON 75 30)
# Exit button
(set 'EXIT_BUTTON (gtk_button_new_with_label "Exit"))
(gtk_widget_set_size_request EXIT_BUTTON 75 30)
# 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 NULL)
# 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 newLisp!"}))
(gdk_draw_layout PIX GC 130 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)

# Mainloop
(do-until (or (= event WIN)(= event EXIT_BUTTON))
	  
    # Get event
    (set 'event (gtk_server_callback "wait"))

    # If action button is pressed
    (if (= event ACTION_BUTTON) (Draw_Fractal))
    # If clear button is pressed
    (if (= event CLEAR_BUTTON)
	(begin
	    (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 130 240 LAYOUT)
	    (gtk_widget_queue_draw IMAGE))))

# Exit newLisp
(exit)