1 #!/usr/bin/newlisp
  2 #
  3 # Draw a fractal with the GTK-server and newLisp.
  4 #
  5 # Developed with newLisp 8.6.0 WinXP.
  6 #
  7 # newLisp draws the fractal extremely fast.
  8 # Codesample. July 27, 2005 - PvE.
  9 #
 10 # Rewritten to embedded GTK at july 23, 2006
 11 #------------------------------------------------------- GTK stuff
 12 
 13 # Import GTK-server
 14 (if (= (last (sys-info)) 6)
 15     (begin
 16         (import "gtk-server.dll" "gtk")
 17         (set 'cfgfile (open "C:\\GTK-server\\gtk-server.cfg" "read"))
 18     )
 19     (begin
 20         (import "libgtk-server.so" "gtk")
 21         (set 'cfgfile (open "/etc/gtk-server.cfg" "read"))
 22     )
 23 )
 24 
 25 (cond ((not cfgfile)(println "No GTK-server configfile found! Exiting...")(exit)))
 26 
 27 (while (read-line cfgfile)
 28     (if (starts-with (current-line) "FUNCTION_NAME")
 29         (begin
 30             (set 'func (chop ((parse (current-line) " ") 2)))
 31             (set 'lb (append {(lambda()(setq s "} func {")(dolist (x (args))(setq s (string s " " x)))(get-string (gtk s)))}))
 32             (constant (global (sym func)) (eval-string lb))
 33         )
 34     )
 35 )
 36 (close cfgfile)
 37 
 38 (constant (global 'NULL) "NULL")
 39 
 40 #-------------------------------------------------------
 41 
 42 # Main context starts here
 43 (context 'MAIN)
 44 
 45 # The core calculation routine was taken from http://www.cygnus-software.com/theory/theory.htm
 46 # and translated to newLisp by me.
 47 # With friendly permission of Cygnus-Software.
 48 
 49 (define (Draw_Fractal)
 50 
 51 (set 'MaxIters 100)
 52 (set 'SIZE 240)
 53 (set 'BLACK -1)
 54 (set 'LEFT -2.0)
 55 (set 'RIGHT 1.0)
 56 (set 'TOP 1.0)
 57 (set 'BOTTOM -1.0)
 58 
 59 # Tell drawing is starting
 60 (gdk_color_parse "#000000" COLOR)
 61 (gdk_gc_set_rgb_fg_color GC COLOR)
 62 (gdk_draw_layout PIX GC 10 240 START)
 63 (gtk_widget_queue_draw IMAGE)
 64 (gtk_server_callback "update")
 65 
 66 # The calculation
 67 (for (Y 0 SIZE)
 68     (for (X 0 SIZE)
 69         (set 'ZR 0.0)
 70         (set 'ZI 0.0)
 71         (set 'CR (add (div (mul (sub RIGHT LEFT) X) SIZE) LEFT))
 72         (set 'CI (add (div (mul (sub BOTTOM TOP) Y) SIZE) TOP))
 73 
 74         (set 'RSQUARED (mul ZR ZR))
 75         (set 'ISQUARED (mul ZI ZI))
 76 
 77         (set 'COUNT 0)
 78         (while (and (< (add RSQUARED ISQUARED) 2.0) (< COUNT MaxIters))
 79             (set 'ZI (mul (mul ZR ZI) 2.0))
 80             (set 'ZI (add ZI CI))
 81 
 82             (set 'ZR (sub RSQUARED ISQUARED))
 83             (set 'ZR (add ZR CR))
 84 
 85             (set 'RSQUARED (mul ZR ZR))
 86             (set 'ISQUARED (mul ZI ZI))
 87 
 88             (inc 'COUNT))
 89 
 90             (set 'SUM (add RSQUARED ISQUARED))
 91             (if (< SUM 2.0)
 92                 (begin
 93                     (if (< SUM 1.0)
 94                         (set 'INDEX (mul SUM 16))
 95                         (set 'INDEX 15)
 96                     )
 97                     (gdk_color_parse (nth INDEX PICOL) COLOR)
 98                     (gdk_gc_set_rgb_fg_color GC COLOR)
 99                     (gdk_draw_point PIX GC X Y)
100                     (set 'event (gtk_server_callback "update"))
101                     (if (or (= event EXIT_BUTTON) (= event WIN)) (exit))
102                 )
103             )
104         )
105         (gtk_widget_queue_draw IMAGE)
106         (gtk_server_callback "update"))
107 
108 # Wipe wait text
109 (gdk_color_parse "#ffffff" COLOR)
110 (gdk_gc_set_rgb_fg_color GC COLOR)
111 (gdk_draw_rectangle PIX GC 1 10 240 120 25)
112 # Tell drawing is ready
113 (gdk_color_parse "#000000" COLOR)
114 (gdk_gc_set_rgb_fg_color GC COLOR)
115 (gdk_draw_layout PIX GC 10 240 READY)
116 (gtk_widget_queue_draw IMAGE)
117 (gtk_server_callback "update")
118 )
119 
120 #-------------------------------------------------------
121 
122 # Define array with colors - taken from the newLisp HTML fractal example
123 (constant 'PICOL '("#800000" "#800080" "#8000FF" "#808000"
124 "#808080" "#8080FF" "#80FF00" "#80FF80" "#80FFFF"
125 "#FF0000" "#FF0080" "#FF00FF" "#FF8000" "#FF8080"
126 "#FF80FF" "#FFFF00"))
127 
128 # Window
129 (gtk_init NULL NULL)
130 (set 'WIN (gtk_window_new 0))
131 (gtk_window_set_title WIN {"newLisp with GTK-server"})
132 (gtk_widget_set_size_request WIN 300 300)
133 (gtk_window_set_position WIN 1)
134 (gtk_window_set_resizable WIN 0)
135 # Create widget to display image
136 (set 'IMAGE (gtk_image_new))
137 # Create eventbox to catch mouseclick
138 (set 'EBOX (gtk_event_box_new))
139 (gtk_container_add EBOX IMAGE)
140 # Separator
141 (set 'SEP (gtk_hseparator_new))
142 # Action button
143 (set 'ACTION_BUTTON (gtk_button_new_with_label "Draw!"))
144 (gtk_widget_set_size_request ACTION_BUTTON 75 30)
145 # Clear button
146 (set 'CLEAR_BUTTON (gtk_button_new_with_label "Clear"))
147 (gtk_widget_set_size_request CLEAR_BUTTON 75 30)
148 # Exit button
149 (set 'EXIT_BUTTON (gtk_button_new_with_label "Exit"))
150 (gtk_widget_set_size_request EXIT_BUTTON 75 30)
151 # Now arrange widgets on window using boxes
152 (set 'HBOX (gtk_hbox_new 0 0))
153 (gtk_box_pack_start HBOX CLEAR_BUTTON 0 0 1)
154 (gtk_box_pack_start HBOX ACTION_BUTTON 0 0 1)
155 (gtk_box_pack_end HBOX EXIT_BUTTON 0 0 1)
156 (set 'VBOX (gtk_vbox_new 0 0))
157 (gtk_box_pack_start VBOX EBOX 0 0 1)
158 (gtk_box_pack_start VBOX SEP 0 0 1)
159 (gtk_box_pack_end VBOX HBOX 0 0 1)
160 (gtk_container_add WIN VBOX)
161 # Show all widgets
162 (gtk_widget_show_all WIN)
163 # Create the pixmap
164 (set 'GDKWIN (gtk_widget_get_parent_window IMAGE))
165 (set 'PIX (gdk_pixmap_new GDKWIN 300 265 -1))
166 (set 'GC (gdk_gc_new PIX))
167 (gtk_image_set_from_pixmap IMAGE PIX NULL)
168 # Allocate memory with some random widget for GdkColor
169 (set 'COLOR (gtk_frame_new NULL))
170 # Now set foreground and backgroundcolors to WHITE
171 (gdk_color_parse "#ffffff" COLOR)
172 (gdk_gc_set_rgb_bg_color GC COLOR)
173 (gdk_gc_set_rgb_fg_color GC COLOR)
174 # Clear the complete pixmap with WHITE
175 (gdk_draw_rectangle PIX GC 1 0 0 300 265)
176 # Set color to BLACK
177 (gdk_color_parse "#000000" COLOR)
178 (gdk_gc_set_rgb_fg_color GC COLOR)
179 # Put some text on the canvas
180 (set 'LAYOUT (gtk_widget_create_pango_layout IMAGE {"Draw a fractal with newLisp!"}))
181 (gdk_draw_layout PIX GC 130 240 LAYOUT)
182 # Define start and finishing text
183 (set 'START (gtk_widget_create_pango_layout IMAGE {"Please wait..."}))
184 (set 'READY (gtk_widget_create_pango_layout IMAGE {"Drawing ready."}))
185 # Update the IMAGE widget with the pixmap
186 (gtk_widget_queue_draw IMAGE)
187 
188 # Mainloop
189 (do-until (or (= event WIN)(= event EXIT_BUTTON))
190           
191     # Get event
192     (set 'event (gtk_server_callback "wait"))
193 
194     # If action button is pressed
195     (if (= event ACTION_BUTTON) (Draw_Fractal))
196     # If clear button is pressed
197     (if (= event CLEAR_BUTTON)
198         (begin
199             (gdk_color_parse "#ffffff" COLOR)
200             (gdk_gc_set_rgb_fg_color GC COLOR)
201             (gdk_draw_rectangle PIX GC 1 0 0 450 265)
202             (gdk_color_parse "#000000" COLOR)
203             (gdk_gc_set_rgb_fg_color GC COLOR)
204             (gdk_draw_layout PIX GC 130 240 LAYOUT)
205             (gtk_widget_queue_draw IMAGE))))
206 
207 # Exit newLisp
208 (exit)