"SfR Fresh" - the SfR Freeware/Shareware Archive 
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 '
2 ' ####################
3 ' ##### PROLOG #####
4 ' ####################
5 '
6 PROGRAM "acircle"
7 VERSION "0.0006"
8 '
9 IMPORT "xst" ' Standard
10 IMPORT "xma" ' Mathematics
11 IMPORT "xgr" ' GraphicsDesigner
12 IMPORT "xui" ' GuiDesigner
13 '
14 '
15 DECLARE FUNCTION Entry ()
16 INTERNAL FUNCTION InitGui ()
17 INTERNAL FUNCTION InitProgram ()
18 INTERNAL FUNCTION CreateWindows ()
19 INTERNAL FUNCTION Circle (grid, message, v0, v1, v2, v3, r0, ANY)
20 INTERNAL FUNCTION CircleCode (grid, message, v0, v1, v2, v3, r0, ANY)
21 '
22 '
23 ' ######################
24 ' ##### Entry () #####
25 ' ######################
26 '
27 FUNCTION Entry ()
28 SHARED terminateProgram
29 SHARED paused
30 '
31 InitGui () ' initialize messages
32 InitProgram () ' initialize this program
33 CreateWindows () ' create main window and others
34 '
35 ' This message loop is modified to draw the circle pattern continuously
36 ' when not paused, but still process messages whenever they occur.
37 '
38 DO ' the message loop
39 count = 1 ' wait for 1+ messages, then process 1
40 IFZ paused THEN ' if circle drawing not paused
41 CircleCode (0, #Redraw, 0, 0, 0, 0, 0, 0) ' draw a few circles
42 count = 0 ' avoid hang up in XgrProcessMessages()
43 END IF
44 XgrProcessMessages (count) ' process zero or one message
45 LOOP UNTIL terminateProgram ' and repeats until program is terminated
46 END FUNCTION
47 '
48 '
49 ' ########################
50 ' ##### InitGui () #####
51 ' ########################
52 '
53 ' InitGui() initializes cursor, icon, message, and display variables.
54 ' Programs can reference these variables, but must never change them.
55 '
56 FUNCTION InitGui ()
57 '
58 ' ***************************************
59 ' ***** Register Standard Cursors *****
60 ' ***************************************
61 '
62 XgrRegisterCursor (@"Arrow", @#cursorArrow)
63 XgrRegisterCursor (@"UpArrow", @#cursorArrowN)
64 XgrRegisterCursor (@"Arrow", @#cursorArrowNW)
65 XgrRegisterCursor (@"SizeNS", @#cursorArrowsNS)
66 XgrRegisterCursor (@"SizeWE", @#cursorArrowsWE)
67 XgrRegisterCursor (@"SizeNWSE", @#cursorArrowsNWSE)
68 XgrRegisterCursor (@"SizeNESW", @#cursorArrowsNESW)
69 XgrRegisterCursor (@"SizeAll", @#cursorArrowsAll)
70 XgrRegisterCursor (@"CrossHair", @#cursorCrosshair)
71 XgrRegisterCursor (@"Arrow", @#cursorDefault)
72 XgrRegisterCursor (@"Wait", @#cursorHourglass)
73 XgrRegisterCursor (@"Insert", @#cursorInsert)
74 XgrRegisterCursor (@"No", @#cursorNo)
75 XgrRegisterCursor (@"Arrow", @#defaultCursor)
76 '
77 '
78 ' ********************************************
79 ' ***** Register Standard Window Icons *****
80 ' ********************************************
81 '
82 XgrRegisterIcon (@"hand", @#iconHand)
83 XgrRegisterIcon (@"asterisk", @#iconAsterisk)
84 XgrRegisterIcon (@"question", @#iconQuestion)
85 XgrRegisterIcon (@"exclamation", @#iconExclamation)
86 XgrRegisterIcon (@"application", @#iconApplication)
87 '
88 XgrRegisterIcon (@"hand", @#iconStop) ' alias
89 XgrRegisterIcon (@"asterisk", @#iconInformation) ' alias
90 XgrRegisterIcon (@"application", @#iconBlank) ' alias
91 '
92 XgrRegisterIcon (@"window", @#iconWindow) ' custom
93 '
94 '
95 ' ******************************
96 ' ***** Register Messages ***** Create message numbers for message names
97 ' ******************************
98 '
99 XgrRegisterMessage (@"Blowback", @#Blowback)
100 XgrRegisterMessage (@"Callback", @#Callback)
101 XgrRegisterMessage (@"Cancel", @#Cancel)
102 XgrRegisterMessage (@"Change", @#Change)
103 XgrRegisterMessage (@"CloseWindow", @#CloseWindow)
104 XgrRegisterMessage (@"ContextChange", @#ContextChange)
105 XgrRegisterMessage (@"Create", @#Create)
106 XgrRegisterMessage (@"CreateValueArray", @#CreateValueArray)
107 XgrRegisterMessage (@"CreateWindow", @#CreateWindow)
108 XgrRegisterMessage (@"CursorH", @#CursorH)
109 XgrRegisterMessage (@"CursorV", @#CursorV)
110 XgrRegisterMessage (@"Deselected", @#Deselected)
111 XgrRegisterMessage (@"Destroy", @#Destroy)
112 XgrRegisterMessage (@"Destroyed", @#Destroyed)
113 XgrRegisterMessage (@"DestroyWindow", @#DestroyWindow)
114 XgrRegisterMessage (@"Disable", @#Disable)
115 XgrRegisterMessage (@"Disabled", @#Disabled)
116 XgrRegisterMessage (@"Displayed", @#Displayed)
117 XgrRegisterMessage (@"DisplayWindow", @#DisplayWindow)
118 XgrRegisterMessage (@"Enable", @#Enable)
119 XgrRegisterMessage (@"Enabled", @#Enabled)
120 XgrRegisterMessage (@"Enter", @#Enter)
121 XgrRegisterMessage (@"ExitMessageLoop", @#ExitMessageLoop)
122 XgrRegisterMessage (@"Find", @#Find)
123 XgrRegisterMessage (@"FindForward", @#FindForward)
124 XgrRegisterMessage (@"FindReverse", @#FindReverse)
125 XgrRegisterMessage (@"Forward", @#Forward)
126 XgrRegisterMessage (@"GetAlign", @#GetAlign)
127 XgrRegisterMessage (@"GetBorder", @#GetBorder)
128 XgrRegisterMessage (@"GetBorderOffset", @#GetBorderOffset)
129 XgrRegisterMessage (@"GetCallback", @#GetCallback)
130 XgrRegisterMessage (@"GetCallbackArgs", @#GetCallbackArgs)
131 XgrRegisterMessage (@"GetCan", @#GetCan)
132 XgrRegisterMessage (@"GetCharacterMapArray", @#GetCharacterMapArray)
133 XgrRegisterMessage (@"GetClipGrid", @#GetClipGrid)
134 XgrRegisterMessage (@"GetColor", @#GetColor)
135 XgrRegisterMessage (@"GetColorExtra", @#GetColorExtra)
136 XgrRegisterMessage (@"GetCursor", @#GetCursor)
137 XgrRegisterMessage (@"GetCursorXY", @#GetCursorXY)
138 XgrRegisterMessage (@"GetDisplay", @#GetDisplay)
139 XgrRegisterMessage (@"GetEnclosedGrids", @#GetEnclosedGrids)
140 XgrRegisterMessage (@"GetEnclosingGrid", @#GetEnclosingGrid)
141 XgrRegisterMessage (@"GetFocusColor", @#GetFocusColor)
142 XgrRegisterMessage (@"GetFocusColorExtra", @#GetFocusColorExtra)
143 XgrRegisterMessage (@"GetFont", @#GetFont)
144 XgrRegisterMessage (@"GetFontNumber", @#GetFontNumber)
145 XgrRegisterMessage (@"GetGridFunction", @#GetGridFunction)
146 XgrRegisterMessage (@"GetGridFunctionName", @#GetGridFunctionName)
147 XgrRegisterMessage (@"GetGridName", @#GetGridName)
148 XgrRegisterMessage (@"GetGridNumber", @#GetGridNumber)
149 XgrRegisterMessage (@"GetGridType", @#GetGridType)
150 XgrRegisterMessage (@"GetGridTypeName", @#GetGridTypeName)
151 XgrRegisterMessage (@"GetGroup", @#GetGroup)
152 XgrRegisterMessage (@"GetHelp", @#GetHelp)
153 XgrRegisterMessage (@"GetHelpFile", @#GetHelpFile)
154 XgrRegisterMessage (@"GetHelpString", @#GetHelpString)
155 XgrRegisterMessage (@"GetHelpStrings", @#GetHelpStrings)
156 XgrRegisterMessage (@"GetHintString", @#GetHintString)
157 XgrRegisterMessage (@"GetImage", @#GetImage)
158 XgrRegisterMessage (@"GetImageCoords", @#GetImageCoords)
159 XgrRegisterMessage (@"GetIndent", @#GetIndent)
160 XgrRegisterMessage (@"GetInfo", @#GetInfo)
161 XgrRegisterMessage (@"GetJustify", @#GetJustify)
162 XgrRegisterMessage (@"GetKeyboardFocus", @#GetKeyboardFocus)
163 XgrRegisterMessage (@"GetKeyboardFocusGrid", @#GetKeyboardFocusGrid)
164 XgrRegisterMessage (@"GetKidNumber", @#GetKidNumber)
165 XgrRegisterMessage (@"GetKids", @#GetKids)
166 XgrRegisterMessage (@"GetKidArray", @#GetKidArray)
167 XgrRegisterMessage (@"GetKind", @#GetKind)
168 XgrRegisterMessage (@"GetMaxMinSize", @#GetMaxMinSize)
169 XgrRegisterMessage (@"GetMessageFunc", @#GetMessageFunc)
170 XgrRegisterMessage (@"GetMessageFuncArray", @#GetMessageFuncArray)
171 XgrRegisterMessage (@"GetMessageSub", @#GetMessageSub)
172 XgrRegisterMessage (@"GetMessageSubArray", @#GetMessageSubArray)
173 XgrRegisterMessage (@"GetModalInfo", @#GetModalInfo)
174 XgrRegisterMessage (@"GetModalWindow", @#GetModalWindow)
175 XgrRegisterMessage (@"GetParent", @#GetParent)
176 XgrRegisterMessage (@"GetPosition", @#GetPosition)
177 XgrRegisterMessage (@"GetProtoInfo", @#GetProtoInfo)
178 XgrRegisterMessage (@"GetRedrawFlags", @#GetRedrawFlags)
179 XgrRegisterMessage (@"GetSize", @#GetSize)
180 XgrRegisterMessage (@"GetSmallestSize", @#GetSmallestSize)
181 XgrRegisterMessage (@"GetState", @#GetState)
182 XgrRegisterMessage (@"GetStyle", @#GetStyle)
183 XgrRegisterMessage (@"GetTabArray", @#GetTabArray)
184 XgrRegisterMessage (@"GetTabWidth", @#GetTabWidth)
185 XgrRegisterMessage (@"GetTextArray", @#GetTextArray)
186 XgrRegisterMessage (@"GetTextArrayBounds", @#GetTextArrayBounds)
187 XgrRegisterMessage (@"GetTextArrayLine", @#GetTextArrayLine)
188 XgrRegisterMessage (@"GetTextArrayLines", @#GetTextArrayLines)
189 XgrRegisterMessage (@"GetTextCursor", @#GetTextCursor)
190 XgrRegisterMessage (@"GetTextFilename", @#GetTextFilename)
191 XgrRegisterMessage (@"GetTextPosition", @#GetTextPosition)
192 XgrRegisterMessage (@"GetTextSelection", @#GetTextSelection)
193 XgrRegisterMessage (@"GetTextString", @#GetTextString)
194 XgrRegisterMessage (@"GetTextStrings", @#GetTextStrings)
195 XgrRegisterMessage (@"GetTexture", @#GetTexture)
196 XgrRegisterMessage (@"GetTimer", @#GetTimer)
197 XgrRegisterMessage (@"GetValue", @#GetValue)
198 XgrRegisterMessage (@"GetValues", @#GetValues)
199 XgrRegisterMessage (@"GetValueArray", @#GetValueArray)
200 XgrRegisterMessage (@"GetWindow", @#GetWindow)
201 XgrRegisterMessage (@"GetWindowFunction", @#GetWindowFunction)
202 XgrRegisterMessage (@"GetWindowGrid", @#GetWindowGrid)
203 XgrRegisterMessage (@"GetWindowIcon", @#GetWindowIcon)
204 XgrRegisterMessage (@"GetWindowSize", @#GetWindowSize)
205 XgrRegisterMessage (@"GetWindowTitle", @#GetWindowTitle)
206 XgrRegisterMessage (@"GotKeyboardFocus", @#GotKeyboardFocus)
207 XgrRegisterMessage (@"GrabArray", @#GrabArray)
208 XgrRegisterMessage (@"GrabTextArray", @#GrabTextArray)
209 XgrRegisterMessage (@"GrabTextString", @#GrabTextString)
210 XgrRegisterMessage (@"GrabValueArray", @#GrabValueArray)
211 XgrRegisterMessage (@"Help", @#Help)
212 XgrRegisterMessage (@"Hidden", @#Hidden)
213 XgrRegisterMessage (@"HideTextCursor", @#HideTextCursor)
214 XgrRegisterMessage (@"HideWindow", @#HideWindow)
215 XgrRegisterMessage (@"Initialize", @#Initialize)
216 XgrRegisterMessage (@"Initialized", @#Initialized)
217 XgrRegisterMessage (@"Inline", @#Inline)
218 XgrRegisterMessage (@"InquireText", @#InquireText)
219 XgrRegisterMessage (@"KeyboardFocusBackward", @#KeyboardFocusBackward)
220 XgrRegisterMessage (@"KeyboardFocusForward", @#KeyboardFocusForward)
221 XgrRegisterMessage (@"KeyDown", @#KeyDown)
222 XgrRegisterMessage (@"KeyUp", @#KeyUp)
223 XgrRegisterMessage (@"LostKeyboardFocus", @#LostKeyboardFocus)
224 XgrRegisterMessage (@"LostTextSelection", @#LostTextSelection)
225 XgrRegisterMessage (@"Maximized", @#Maximized)
226 XgrRegisterMessage (@"MaximizeWindow", @#MaximizeWindow)
227 XgrRegisterMessage (@"Maximum", @#Maximum)
228 XgrRegisterMessage (@"Minimized", @#Minimized)
229 XgrRegisterMessage (@"MinimizeWindow", @#MinimizeWindow)
230 XgrRegisterMessage (@"Minimum", @#Minimum)
231 XgrRegisterMessage (@"MonitorContext", @#MonitorContext)
232 XgrRegisterMessage (@"MonitorHelp", @#MonitorHelp)
233 XgrRegisterMessage (@"MonitorKeyboard", @#MonitorKeyboard)
234 XgrRegisterMessage (@"MonitorMouse", @#MonitorMouse)
235 XgrRegisterMessage (@"MouseDown", @#MouseDown)
236 XgrRegisterMessage (@"MouseDrag", @#MouseDrag)
237 XgrRegisterMessage (@"MouseEnter", @#MouseEnter)
238 XgrRegisterMessage (@"MouseExit", @#MouseExit)
239 XgrRegisterMessage (@"MouseMove", @#MouseMove)
240 XgrRegisterMessage (@"MouseUp", @#MouseUp)
241 XgrRegisterMessage (@"MuchLess", @#MuchLess)
242 XgrRegisterMessage (@"MuchMore", @#MuchMore)
243 XgrRegisterMessage (@"OneLess", @#OneLess)
244 XgrRegisterMessage (@"OneMore", @#OneMore)
245 XgrRegisterMessage (@"PokeArray", @#PokeArray)
246 XgrRegisterMessage (@"PokeTextArray", @#PokeTextArray)
247 XgrRegisterMessage (@"PokeTextString", @#PokeTextString)
248 XgrRegisterMessage (@"PokeValueArray", @#PokeValueArray)
249 XgrRegisterMessage (@"Print", @#Print)
250 XgrRegisterMessage (@"Redraw", @#Redraw)
251 XgrRegisterMessage (@"RedrawGrid", @#RedrawGrid)
252 XgrRegisterMessage (@"RedrawLines", @#RedrawLines)
253 XgrRegisterMessage (@"RedrawText", @#RedrawText)
254 XgrRegisterMessage (@"RedrawWindow", @#RedrawWindow)
255 XgrRegisterMessage (@"Replace", @#Replace)
256 XgrRegisterMessage (@"ReplaceForward", @#ReplaceForward)
257 XgrRegisterMessage (@"ReplaceReverse", @#ReplaceReverse)
258 XgrRegisterMessage (@"Reset", @#Reset)
259 XgrRegisterMessage (@"Resize", @#Resize)
260 XgrRegisterMessage (@"Resized", @#Resized)
261 XgrRegisterMessage (@"ResizeNot", @#ResizeNot)
262 XgrRegisterMessage (@"ResizeWindow", @#ResizeWindow)
263 XgrRegisterMessage (@"ResizeWindowToGrid", @#ResizeWindowToGrid)
264 XgrRegisterMessage (@"Resized", @#Resized)
265 XgrRegisterMessage (@"Reverse", @#Reverse)
266 XgrRegisterMessage (@"ScrollH", @#ScrollH)
267 XgrRegisterMessage (@"ScrollV", @#ScrollV)
268 XgrRegisterMessage (@"Select", @#Select)
269 XgrRegisterMessage (@"Selected", @#Selected)
270 XgrRegisterMessage (@"Selection", @#Selection)
271 XgrRegisterMessage (@"SelectWindow", @#SelectWindow)
272 XgrRegisterMessage (@"SetAlign", @#SetAlign)
273 XgrRegisterMessage (@"SetBorder", @#SetBorder)
274 XgrRegisterMessage (@"SetBorderOffset", @#SetBorderOffset)
275 XgrRegisterMessage (@"SetCallback", @#SetCallback)
276 XgrRegisterMessage (@"SetCan", @#SetCan)
277 XgrRegisterMessage (@"SetCharacterMapArray", @#SetCharacterMapArray)
278 XgrRegisterMessage (@"SetClipGrid", @#SetClipGrid)
279 XgrRegisterMessage (@"SetColor", @#SetColor)
280 XgrRegisterMessage (@"SetColorAll", @#SetColorAll)
281 XgrRegisterMessage (@"SetColorExtra", @#SetColorExtra)
282 XgrRegisterMessage (@"SetColorExtraAll", @#SetColorExtraAll)
283 XgrRegisterMessage (@"SetCursor", @#SetCursor)
284 XgrRegisterMessage (@"SetCursorXY", @#SetCursorXY)
285 XgrRegisterMessage (@"SetDisplay", @#SetDisplay)
286 XgrRegisterMessage (@"SetFocusColor", @#SetFocusColor)
287 XgrRegisterMessage (@"SetFocusColorExtra", @#SetFocusColorExtra)
288 XgrRegisterMessage (@"SetFont", @#SetFont)
289 XgrRegisterMessage (@"SetFontNumber", @#SetFontNumber)
290 XgrRegisterMessage (@"SetGridFunction", @#SetGridFunction)
291 XgrRegisterMessage (@"SetGridFunctionName", @#SetGridFunctionName)
292 XgrRegisterMessage (@"SetGridName", @#SetGridName)
293 XgrRegisterMessage (@"SetGridType", @#SetGridType)
294 XgrRegisterMessage (@"SetGridTypeName", @#SetGridTypeName)
295 XgrRegisterMessage (@"SetGroup", @#SetGroup)
296 XgrRegisterMessage (@"SetHelp", @#SetHelp)
297 XgrRegisterMessage (@"SetHelpFile", @#SetHelpFile)
298 XgrRegisterMessage (@"SetHelpString", @#SetHelpString)
299 XgrRegisterMessage (@"SetHelpStrings", @#SetHelpStrings)
300 XgrRegisterMessage (@"SetHintString", @#SetHintString)
301 XgrRegisterMessage (@"SetImage", @#SetImage)
302 XgrRegisterMessage (@"SetImageCoords", @#SetImageCoords)
303 XgrRegisterMessage (@"SetIndent", @#SetIndent)
304 XgrRegisterMessage (@"SetInfo", @#SetInfo)
305 XgrRegisterMessage (@"SetJustify", @#SetJustify)
306 XgrRegisterMessage (@"SetKeyboardFocus", @#SetKeyboardFocus)
307 XgrRegisterMessage (@"SetKeyboardFocusGrid", @#SetKeyboardFocusGrid)
308 XgrRegisterMessage (@"SetMaxMinSize", @#SetMaxMinSize)
309 XgrRegisterMessage (@"SetMessageFunc", @#SetMessageFunc)
310 XgrRegisterMessage (@"SetMessageFuncArray", @#SetMessageFuncArray)
311 XgrRegisterMessage (@"SetMessageSub", @#SetMessageSub)
312 XgrRegisterMessage (@"SetMessageSubArray", @#SetMessageSubArray)
313 XgrRegisterMessage (@"SetModalWindow", @#SetModalWindow)
314 XgrRegisterMessage (@"SetParent", @#SetParent)
315 XgrRegisterMessage (@"SetPosition", @#SetPosition)
316 XgrRegisterMessage (@"SetRedrawFlags", @#SetRedrawFlags)
317 XgrRegisterMessage (@"SetSize", @#SetSize)
318 XgrRegisterMessage (@"SetState", @#SetState)
319 XgrRegisterMessage (@"SetStyle", @#SetStyle)
320 XgrRegisterMessage (@"SetTabArray", @#SetTabArray)
321 XgrRegisterMessage (@"SetTabWidth", @#SetTabWidth)
322 XgrRegisterMessage (@"SetTextArray", @#SetTextArray)
323 XgrRegisterMessage (@"SetTextArrayLine", @#SetTextArrayLine)
324 XgrRegisterMessage (@"SetTextArrayLines", @#SetTextArrayLines)
325 XgrRegisterMessage (@"SetTextCursor", @#SetTextCursor)
326 XgrRegisterMessage (@"SetTextFilename", @#SetTextFilename)
327 XgrRegisterMessage (@"SetTextSelection", @#SetTextSelection)
328 XgrRegisterMessage (@"SetTextString", @#SetTextString)
329 XgrRegisterMessage (@"SetTextStrings", @#SetTextStrings)
330 XgrRegisterMessage (@"SetTexture", @#SetTexture)
331 XgrRegisterMessage (@"SetTimer", @#SetTimer)
332 XgrRegisterMessage (@"SetValue", @#SetValue)
333 XgrRegisterMessage (@"SetValues", @#SetValues)
334 XgrRegisterMessage (@"SetValueArray", @#SetValueArray)
335 XgrRegisterMessage (@"SetWindowFunction", @#SetWindowFunction)
336 XgrRegisterMessage (@"SetWindowIcon", @#SetWindowIcon)
337 XgrRegisterMessage (@"SetWindowTitle", @#SetWindowTitle)
338 XgrRegisterMessage (@"ShowTextCursor", @#ShowTextCursor)
339 XgrRegisterMessage (@"ShowWindow", @#ShowWindow)
340 XgrRegisterMessage (@"SomeLess", @#SomeLess)
341 XgrRegisterMessage (@"SomeMore", @#SomeMore)
342 XgrRegisterMessage (@"StartTimer", @#StartTimer)
343 XgrRegisterMessage (@"SystemMessage", @#SystemMessage)
344 XgrRegisterMessage (@"TextDelete", @#TextDelete)
345 XgrRegisterMessage (@"TextEvent", @#TextEvent)
346 XgrRegisterMessage (@"TextInsert", @#TextInsert)
347 XgrRegisterMessage (@"TextModified", @#TextModified)
348 XgrRegisterMessage (@"TextReplace", @#TextReplace)
349 XgrRegisterMessage (@"TimeOut", @#TimeOut)
350 XgrRegisterMessage (@"Update", @#Update)
351 XgrRegisterMessage (@"WindowClose", @#WindowClose)
352 XgrRegisterMessage (@"WindowCreate", @#WindowCreate)
353 XgrRegisterMessage (@"WindowDeselected", @#WindowDeselected)
354 XgrRegisterMessage (@"WindowDestroy", @#WindowDestroy)
355 XgrRegisterMessage (@"WindowDestroyed", @#WindowDestroyed)
356 XgrRegisterMessage (@"WindowDisplay", @#WindowDisplay)
357 XgrRegisterMessage (@"WindowDisplayed", @#WindowDisplayed)
358 XgrRegisterMessage (@"WindowGetDisplay", @#WindowGetDisplay)
359 XgrRegisterMessage (@"WindowGetFunction", @#WindowGetFunction)
360 XgrRegisterMessage (@"WindowGetIcon", @#WindowGetIcon)
361 XgrRegisterMessage (@"WindowGetKeyboardFocusGrid", @#WindowGetKeyboardFocusGrid)
362 XgrRegisterMessage (@"WindowGetSelectedWindow", @#WindowGetSelectedWindow)
363 XgrRegisterMessage (@"WindowGetSize", @#WindowGetSize)
364 XgrRegisterMessage (@"WindowGetTitle", @#WindowGetTitle)
365 XgrRegisterMessage (@"WindowHelp", @#WindowHelp)
366 XgrRegisterMessage (@"WindowHide", @#WindowHide)
367 XgrRegisterMessage (@"WindowHidden", @#WindowHidden)
368 XgrRegisterMessage (@"WindowKeyDown", @#WindowKeyDown)
369 XgrRegisterMessage (@"WindowKeyUp", @#WindowKeyUp)
370 XgrRegisterMessage (@"WindowMaximize", @#WindowMaximize)
371 XgrRegisterMessage (@"WindowMaximized", @#WindowMaximized)
372 XgrRegisterMessage (@"WindowMinimize", @#WindowMinimize)
373 XgrRegisterMessage (@"WindowMinimized", @#WindowMinimized)
374 XgrRegisterMessage (@"WindowMonitorContext", @#WindowMonitorContext)
375 XgrRegisterMessage (@"WindowMonitorHelp", @#WindowMonitorHelp)
376 XgrRegisterMessage (@"WindowMonitorKeyboard", @#WindowMonitorKeyboard)
377 XgrRegisterMessage (@"WindowMonitorMouse", @#WindowMonitorMouse)
378 XgrRegisterMessage (@"WindowMouseDown", @#WindowMouseDown)
379 XgrRegisterMessage (@"WindowMouseDrag", @#WindowMouseDrag)
380 XgrRegisterMessage (@"WindowMouseEnter", @#WindowMouseEnter)
381 XgrRegisterMessage (@"WindowMouseExit", @#WindowMouseExit)
382 XgrRegisterMessage (@"WindowMouseMove", @#WindowMouseMove)
383 XgrRegisterMessage (@"WindowMouseUp", @#WindowMouseUp)
384 XgrRegisterMessage (@"WindowRedraw", @#WindowRedraw)
385 XgrRegisterMessage (@"WindowRegister", @#WindowRegister)
386 XgrRegisterMessage (@"WindowResize", @#WindowResize)
387 XgrRegisterMessage (@"WindowResized", @#WindowResized)
388 XgrRegisterMessage (@"WindowResizeToGrid", @#WindowResizeToGrid)
389 XgrRegisterMessage (@"WindowSelect", @#WindowSelect)
390 XgrRegisterMessage (@"WindowSelected", @#WindowSelected)
391 XgrRegisterMessage (@"WindowSetFunction", @#WindowSetFunction)
392 XgrRegisterMessage (@"WindowSetIcon", @#WindowSetIcon)
393 XgrRegisterMessage (@"WindowSetKeyboardFocusGrid", @#WindowSetKeyboardFocusGrid)
394 XgrRegisterMessage (@"WindowSetTitle", @#WindowSetTitle)
395 XgrRegisterMessage (@"WindowShow", @#WindowShow)
396 XgrRegisterMessage (@"WindowSystemMessage", @#WindowSystemMessage)
397 XgrRegisterMessage (@"LastMessage", @#LastMessage)
398 '
399 XgrGetDisplaySize ("", @#displayWidth, @#displayHeight, @#windowBorderWidth, @#windowTitleHeight)
400 END FUNCTION
401 '
402 '
403 ' ############################
404 ' ##### InitProgram () #####
405 ' ############################
406 '
407 FUNCTION InitProgram ()
408 ' Initialize everything your program needs to initialize
409 END FUNCTION
410 '
411 '
412 ' ##############################
413 ' ##### CreateWindows () #####
414 ' ##############################
415 '
416 FUNCTION CreateWindows ()
417 SHARED Circle
418 '
419 wt = 0
420 ' wt = $$WindowTypeNoFrame
421 Circle (@Circle, #CreateWindow, 0, 0, 0, 0, wt, 0)
422 Circle ( Circle, #SetCallback, Circle, &CircleCode(), -1, -1, -1, -1)
423 XuiSendMessage (Circle, #DisplayWindow, 0, 0, 0, 0, 0, 0)
424 ' XuiSendMessage (Circle, #MaximizeWindow, 0, 0, 0, 0, 0, 0)
425 END FUNCTION
426 '
427 '
428 ' #######################
429 ' ##### Circle () #####
430 ' #######################
431 '
432 FUNCTION Circle (grid, message, v0, v1, v2, v3, r0, (r1, r1$, r1[], r1$[]))
433 STATIC designX, designY, designWidth, designHeight
434 STATIC SUBADDR sub[]
435 STATIC upperMessage
436 STATIC Circle
437 '
438 $Circle = 0 ' kid 0 grid type = Circle
439 $DrawingArea = 1 ' kid 1 grid type = XuiArea
440 $ClearButton = 2 ' kid 2 grid type = XuiPushButton
441 $PauseButton = 3 ' kid 3 grid type = XuiPushButton
442 $QuitButton = 4 ' kid 4 grid type = XuiPushButton
443 $UpperKid = 4 ' kid maximum
444 '
445 IFZ sub[] THEN GOSUB Initialize
446 ' XuiReportMessage (grid, message, v0, v1, v2, v3, r0, r1)
447 IF XuiProcessMessage (grid, message, @v0, @v1, @v2, @v3, @r0, @r1, Circle) THEN RETURN
448 IF (message <= upperMessage) THEN GOSUB @sub[message]
449 RETURN
450 '
451 '
452 ' ***** Callback ***** message = Callback : r1 = original message
453 '
454 SUB Callback
455 message = r1
456 callback = message
457 IF (message <= upperMessage) THEN GOSUB @sub[message]
458 END SUB
459 '
460 '
461 ' ***** Create ***** v0123 = xywh : r0 = window : r1 = parent
462 '
463 SUB Create
464 IF (v0 <= 0) THEN v0 = 0
465 IF (v1 <= 0) THEN v1 = 0
466 IF (v2 <= 0) THEN v2 = designWidth
467 IF (v3 <= 0) THEN v3 = designHeight
468 XuiCreateGrid (@grid, Circle, @v0, @v1, @v2, @v3, r0, r1, &Circle())
469 XuiSendMessage ( grid, #SetGridName, 0, 0, 0, 0, 0, @"Circle")
470 XuiArea (@g, #Create, 0, 0, 444, 444, r0, grid)
471 XuiSendMessage ( g, #SetCallback, grid, &Circle(), -1, -1, $DrawingArea, grid)
472 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"DrawingArea")
473 XuiSendMessage ( g, #SetColor, $$Black, $$White, $$Black, $$White, 0, 0)
474 XuiPushButton (@g, #Create, 0, 444, 148, 20, r0, grid)
475 XuiSendMessage ( g, #SetCallback, grid, &Circle(), -1, -1, $ClearButton, grid)
476 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"ClearButton")
477 XuiSendMessage ( g, #SetColor, $$BrightGreen, $$Black, $$Black, $$White, 0, 0)
478 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @" Clear ")
479 XuiPushButton (@g, #Create, 148, 444, 148, 20, r0, grid)
480 XuiSendMessage ( g, #SetCallback, grid, &Circle(), -1, -1, $PauseButton, grid)
481 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"PauseButton")
482 XuiSendMessage ( g, #SetColor, 110, $$Black, $$Black, $$White, 0, 0)
483 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @" Pause ")
484 XuiPushButton (@g, #Create, 296, 444, 148, 20, r0, grid)
485 XuiSendMessage ( g, #SetCallback, grid, &Circle(), -1, -1, $QuitButton, grid)
486 XuiSendMessage ( g, #SetGridName, 0, 0, 0, 0, 0, @"QuitButton")
487 XuiSendMessage ( g, #SetColor, 102, $$Black, $$Black, $$White, 0, 0)
488 XuiSendMessage ( g, #SetTextString, 0, 0, 0, 0, 0, @" Quit ")
489 GOSUB Resize
490 END SUB
491 '
492 '
493 ' ***** CreateWindow ***** v0123 = xywh : r0 = windowType : r1$ = display$
494 '
495 SUB CreateWindow
496 IF (v0 = 0) THEN v0 = designX
497 IF (v1 = 0) THEN v1 = designY
498 IF (v2 <= 0) THEN v2 = designWidth
499 IF (v3 <= 0) THEN v3 = designHeight
500 XuiWindow (@window, #WindowCreate, v0, v1, v2, v3, r0, @r1$)
501 v0 = 0 : v1 = 0 : r0 = window : ATTACH r1$ TO display$
502 GOSUB Create
503 r1 = 0 : ATTACH display$ TO r1$
504 XuiWindow (window, #WindowRegister, grid, -1, v2, v3, @r0, @"Circle")
505 END SUB
506 '
507 '
508 ' ***** GetSmallestSize ***** see "Anatomy of Grid Functions"
509 '
510 SUB GetSmallestSize
511 v2 = 100
512 v3 = 120
513 XuiGetBorder (grid, #GetBorder, 0, 0, 0, 0, 0, @bw)
514 FOR i = 2 TO 4
515 XuiSendMessage (grid, #GetSmallestSize, 0, 0, @ww, @hh, i, 0)
516 w = MAX (w, ww) : h = MAX (h, hh)
517 NEXT i
518 w = w + 4 AND -4
519 h = h + 4 AND -4
520 innerWidth = w + w + w
521 innerHeight = innerWidth + h
522 totalWidth = bw + bw + innerWidth
523 totalHeight = bw + bw + innerHeight
524 v2 = totalWidth
525 v3 = totalHeight
526 END SUB
527 '
528 '
529 ' ***** Resize ***** see "Anatomy of Grid Functions"
530 '
531 SUB Resize
532 v2Entry = v2
533 v3Entry = v3
534 GOSUB GetSmallestSize
535 v2 = MAX (v2, v2Entry)
536 v3 = MAX (v3, v3Entry)
537 '
538 XuiPositionGrid (grid, @v0, @v1, @v2, @v3)
539 innerWidth = v2 - bw - bw
540 innerHeight = v3 - bw - bw
541 gw = innerWidth
542 gh = innerHeight - h
543 bw0 = innerWidth / 3
544 bw1 = bw0
545 bw2 = innerWidth - bw1 - bw0
546 bx0 = bw
547 bx1 = bx0 + bw0
548 bx2 = bx1 + bw1
549 by = v3-h-bw
550 '
551 XuiSendMessage (grid, #Resize, bw, bw, gw, gh, 1, 0)
552 XuiSendMessage (grid, #Resize, bx0, by, bw0, h, 2, 0)
553 XuiSendMessage (grid, #Resize, bx1, by, bw1, h, 3, 0)
554 XuiSendMessage (grid, #Resize, bx2, by, bw2, h, 4, 0)
555 XuiResizeWindowToGrid (grid, #ResizeWindowToGrid, 0, 0, 0, 0, 0, 0)
556 XuiGetSize (grid, #GetSize, 0, 0, @width, @height, 0, 0)
557 XuiCallback (grid, #Resized, 0, 0, width, height, 0, 0)
558 END SUB
559 '
560 '
561 ' ***** Selection ***** see "Anatomy of Grid Functions"
562 '
563 SUB Selection
564 END SUB
565 '
566 '
567 ' ***** Initialize ***** see "Anatomy of Grid Functions"
568 '
569 SUB Initialize
570 XuiGetDefaultMessageFuncArray (@func[])
571 XgrMessageNameToNumber (@"LastMessage", @upperMessage)
572 '
573 func[#Callback] = &XuiCallback() ' disable to handle Callback messages internally
574 func[#Resize] = &XuiResizeNot()
575 func[#Selection] = &XuiCallback()
576 func[#GetSmallestSize] = 0 ' enable to add internal GetSmallestSize routine
577 func[#Resize] = 0 ' enable to add internal Resize routine
578 '
579 DIM sub[upperMessage]
580 ' sub[#Callback] = SUBADDRESS (Callback) ' enable to handle Callback messages internally
581 sub[#Create] = SUBADDRESS (Create) ' must be subroutine in this function
582 sub[#CreateWindow] = SUBADDRESS (CreateWindow) ' must be subroutine in this function
583 sub[#GetSmallestSize] = SUBADDRESS (GetSmallestSize) ' enable to add internal GetSmallestSize routine
584 sub[#Resize] = SUBADDRESS (Resize) ' enable to add internal Resize routine
585 sub[#Selection] = SUBADDRESS (Selection) ' routes Selection callbacks to subroutine
586 '
587 IF sub[0] THEN PRINT "Circle(): Initialize : error ::: (undefined message)"
588 IF func[0] THEN PRINT "Circle(): Initialize : error ::: (undefined message)"
589 XuiRegisterGridType (@Circle, "Circle", &Circle(), @func[], @sub[])
590 '
591 ' Don't remove the following 4 lines, or WindowFromFunction/WindowToFunction will not work
592 '
593 designX = 568
594 designY = 23
595 designWidth = 444
596 designHeight = 464
597 '
598 gridType = Circle
599 XuiSetGridTypeProperty (gridType, @"x", designX)
600 XuiSetGridTypeProperty (gridType, @"y", designY)
601 XuiSetGridTypeProperty (gridType, @"width", designWidth)
602 XuiSetGridTypeProperty (gridType, @"height", designHeight)
603 ' XuiSetGridTypeProperty (gridType, @"maxWidth", designWidth)
604 ' XuiSetGridTypeProperty (gridType, @"maxHeight", designHeight)
605 ' XuiSetGridTypeProperty (gridType, @"minWidth", designWidth)
606 ' XuiSetGridTypeProperty (gridType, @"minHeight", designHeight)
607 XuiSetGridTypeProperty (gridType, @"can", $$Focus OR $$Respond OR $$Callback)
608 XuiSetGridTypeProperty (gridType, @"focusKid", $DrawingArea)
609 IFZ message THEN RETURN
610 END SUB
611 END FUNCTION
612 '
613 '
614 ' ###########################
615 ' ##### CircleCode () #####
616 ' ###########################
617 '
618 FUNCTION CircleCode (grid, message, v0, v1, v2, v3, r0, r1)
619 SHARED Circle, CircleGrid
620 SHARED paused, circleWidth, circleHeight
621 STATIC entry, color, dx, dy, half, rad, jjj
622 STATIC s1#, s2#, a1#, a2#
623 '
624 $Circle = 0 ' kid 0 grid type = Circle
625 $DrawingArea = 1 ' kid 1 grid type = XuiArea
626 $ClearButton = 2 ' kid 2 grid type = XuiPushButton
627 $PauseButton = 3 ' kid 3 grid type = XuiPushButton
628 $QuitButton = 4 ' kid 4 grid type = XuiPushButton
629 $UpperKid = 4 ' kid maximum
630 '
631 IFZ entry THEN entry = $$TRUE : GOSUB Resized
632 ' XuiReportMessage (grid, message, v0, v1, v2, v3, r0, r1)
633 IF (message = #Callback) THEN message = r1
634 '
635 SELECT CASE message
636 ' CASE #Help: GOSUB Help
637 CASE #Redraw: GOSUB Redraw
638 CASE #Resized: GOSUB Resized
639 CASE #Selection: GOSUB Selection
640 END SELECT
641 RETURN
642 '
643 '
644 ' ***********************
645 ' ***** Selection ***** Callbacks from Circle() pushbuttons
646 ' ***********************
647 '
648 SUB Selection
649 SELECT CASE r0
650 CASE $ClearButton : XgrClearGrid (CircleGrid, -1)
651 CASE $PauseButton : paused = NOT paused
652 CASE $QuitButton : QUIT (0)
653 END SELECT
654 END SUB
655 '
656 '
657 ' *********************
658 ' ***** Resized ***** Callbacks from Circle() resize routine
659 ' *********************
660 '
661 SUB Resized
662 entry = $$TRUE
663 XuiSendMessage (Circle, #GetKidArray, 0, 0, 0, 0, 0, @kid[])
664 XuiSendMessage (Circle, #GetSize, 0, 0, @circleWidth, @circleHeight, 1, 0)
665 CircleGrid = kid[1]
666 s1# = $$PI / 256#
667 s2# = 4.9# * s1#
668 a1# = 0#
669 a2# = $$PI / 4#
670 dx = circleWidth >> 1
671 dy = circleHeight >> 1
672 rad = MIN (circleWidth, circleHeight) >> 1
673 rad = rad - 6
674 color = 0
675 XgrClearGrid (CircleGrid, -1)
676 END SUB
677 '
678 '
679 ' ********************
680 ' ***** Redraw ***** Messages from Entry ()
681 ' ********************
682 '
683 SUB Redraw
684 INC jjj
685 IF (jjj > 100) THEN jjj = 0
686 IF (jjj < 50) THEN XgrClearGrid (CircleGrid, -1) ' comment out or in for variety
687 FOR i = 0 TO 99
688 GOSUB Circle
689 NEXT i
690 INC color
691 END SUB
692 '
693 '
694 ' ********************
695 ' ***** Circle ***** Drawing subroutine
696 ' ********************
697 '
698 SUB Circle
699 IF (a1# >= $$TWOPI) THEN
700 a1# = a1# - $$TWOPI
701 color = (color + 3)
702 IF (color > 124) THEN color = color - 124
703 END IF
704 IF (a2# >= $$TWOPI) THEN
705 a2# = a2# - $$TWOPI
706 INC i
707 END IF
708 IFZ color THEN INC color
709 p1x = SIN (a1#) * rad + dx
710 p1y = COS (a1#) * rad + dy
711 p2x = SIN (a2#) * rad + dx
712 p2y = COS (a2#) * rad + dy
713 XgrDrawLine (CircleGrid, color, p1x, p1y, p2x, p2y)
714 a1# = a1# + s1#
715 a2# = a2# + s2#
716 s2# = 1.0002# * s2#
717 IF (s2# > $$TWOPI) THEN s2# = s2# - $$TWOPI
718 END SUB
719 END FUNCTION
720 END PROGRAM