#!/usr/bin/newlisp # Define libraries for each platform (case ostype ("Win32" (set 'GTK "libgtk-win32-2.0-0.dll") (set 'GDK "libgdk-win32-2.0-0.dll") (set 'GLIB "libglib-2.0-0.dll") (set 'GOBJECT "libgobject-2.0-0.dll")) ("OSX" (set 'GTK "/Library/Frameworks/Gtk.framework/Libraries/libgtk-quartz-2.0.0.dylib") (set 'GDK "/Library/Frameworks/Gtk.framework/Libraries/libgdk-quartz-2.0.0.dylib") (set 'GLIB "/Library/Frameworks/GLib.framework/Libraries/libglib-2.0.0.dylib") (set 'GOBJECT "/Library/Frameworks/GLib.framework/Libraries/libgobject-2.0.0.dylib")) (true (set 'GTK "libgtk-x11-2.0.so.0") (set 'GDK "libgdk-x11-2.0.so.0") (set 'GLIB "libglib-2.0.so.0") (set 'GOBJECT "libgobject-2.0.so.0"))) # Get the necessary functions (import GOBJECT "g_signal_connect_data") (import GLIB "g_malloc") (import GDK "gdk_color_parse") (import GDK "gdk_draw_layout") (import GDK "gdk_draw_point") (import GDK "gdk_draw_rectangle") (import GDK "gdk_gc_new") (import GDK "gdk_gc_set_rgb_bg_color") (import GDK "gdk_gc_set_rgb_fg_color") (import GDK "gdk_pixmap_new") (import GTK "gtk_box_pack_end") (import GTK "gtk_box_pack_start") (import GTK "gtk_button_new_with_label") (import GTK "gtk_container_add") (import GTK "gtk_event_box_new") (import GTK "gtk_exit") (import GTK "gtk_hbox_new") (import GTK "gtk_hseparator_new") (import GTK "gtk_image_new") (import GTK "gtk_image_set_from_pixmap") (import GTK "gtk_init") (import GTK "gtk_main") (import GTK "gtk_main_iteration") (import GTK "gtk_vbox_new") (import GTK "gtk_widget_create_pango_layout") (import GTK "gtk_widget_get_parent_window") (import GTK "gtk_widget_queue_draw") (import GTK "gtk_widget_set_size_request") (import GTK "gtk_widget_show_all") (import GTK "gtk_window_new") (import GTK "gtk_window_set_position") (import GTK "gtk_window_set_resizable") (import GTK "gtk_window_set_title") # Callback to exit program (define (Exit_Prog) (gtk_exit 0) (exit)) # Callback to clear canvas (define (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 130 240 LAYOUT) (gtk_widget_queue_draw IMAGE)) # 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) # 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) ) ) ) (gtk_widget_queue_draw IMAGE) (gtk_main_iteration)) # 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) ) #------------------------------------------------------- # 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 0 0) (set 'WIN (gtk_window_new 0)) (gtk_window_set_title WIN "newLisp fractal") (gtk_widget_set_size_request WIN 300 300) (gtk_window_set_position WIN 1) (gtk_window_set_resizable WIN 0) (g_signal_connect_data WIN "delete-event" (callback 0 'Exit_Prog) 0 0 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) (g_signal_connect_data ACTION_BUTTON "clicked" (callback 1 'Draw_Fractal) 0 0 0) # Clear button (set 'CLEAR_BUTTON (gtk_button_new_with_label "Clear")) (gtk_widget_set_size_request CLEAR_BUTTON 75 30) (g_signal_connect_data CLEAR_BUTTON "clicked" (callback 2 'Clear_Canvas) 0 0 0) # Exit button (set 'EXIT_BUTTON (gtk_button_new_with_label "Exit")) (gtk_widget_set_size_request EXIT_BUTTON 75 30) (g_signal_connect_data EXIT_BUTTON "clicked" (callback 0 'Exit_Prog) 0 0 0) # 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 (g_malloc 128)) # 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) (gtk_main)