1
2
3
4
5
6
7
8
9
10
11
12
13
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
43 (context 'MAIN)
44
45
46
47
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
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
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
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
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
123 (constant 'PICOL '("#800000" "#800080" "#8000FF" "#808000"
124 "#808080" "#8080FF" "#80FF00" "#80FF80" "#80FFFF"
125 "#FF0000" "#FF0080" "#FF00FF" "#FF8000" "#FF8080"
126 "#FF80FF" "#FFFF00"))
127
128
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
136 (set 'IMAGE (gtk_image_new))
137
138 (set 'EBOX (gtk_event_box_new))
139 (gtk_container_add EBOX IMAGE)
140
141 (set 'SEP (gtk_hseparator_new))
142
143 (set 'ACTION_BUTTON (gtk_button_new_with_label "Draw!"))
144 (gtk_widget_set_size_request ACTION_BUTTON 75 30)
145
146 (set 'CLEAR_BUTTON (gtk_button_new_with_label "Clear"))
147 (gtk_widget_set_size_request CLEAR_BUTTON 75 30)
148
149 (set 'EXIT_BUTTON (gtk_button_new_with_label "Exit"))
150 (gtk_widget_set_size_request EXIT_BUTTON 75 30)
151
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
162 (gtk_widget_show_all WIN)
163
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
169 (set 'COLOR (gtk_frame_new NULL))
170
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
175 (gdk_draw_rectangle PIX GC 1 0 0 300 265)
176
177 (gdk_color_parse "#000000" COLOR)
178 (gdk_gc_set_rgb_fg_color GC COLOR)
179
180 (set 'LAYOUT (gtk_widget_create_pango_layout IMAGE {"Draw a fractal with newLisp!"}))
181 (gdk_draw_layout PIX GC 130 240 LAYOUT)
182
183 (set 'START (gtk_widget_create_pango_layout IMAGE {"Please wait..."}))
184 (set 'READY (gtk_widget_create_pango_layout IMAGE {"Drawing ready."}))
185
186 (gtk_widget_queue_draw IMAGE)
187
188
189 (do-until (or (= event WIN)(= event EXIT_BUTTON))
190
191
192 (set 'event (gtk_server_callback "wait"))
193
194
195 (if (= event ACTION_BUTTON) (Draw_Fractal))
196
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
208 (exit)