![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to menulife.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo|
Return to menulife.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo |
1.1 root 1:
2: %% Events of interest:
3: %%
4: %% Clear_All Clear the board
5: %% Set_All Set all cells in the board
6: %% Randomize Randomly set cells (within randomize area)
7: %% Stop Stop generating
8: %% Go Continue generating
9: %% Mutate Set mutation on or off
10: %% Single_Step Generate once
11: %% New_Rules Change rules of generation
12: %% Set_Cells Set cells alive or dead
13: %% Expose Expose a region of the board
14: %% ReSize Resize the board
15: %% Quit Done
16:
17: %% Event Caused by
18: %% None nothing
19: %% Clear 'c'
20: %% Randomize 'r'
21: %% Stop ' '
22: %% Go '<cr>'
23: %% Mutate 'm'
24: %% Single_Step ' ' or middle button
25: %% New_Rules not-implemented yet
26: %% Set_Cells left button
27: %% Expose windowUp (same size)
28: %% ReSize windowUp (new size)
29: %% Quit 'q'
30:
31: %% Clear then Randomize right button
32:
33: xevent = oneof[
34: None: null,
35: Clear_All: null,
36: Set_All: null,
37: Randomize: null,
38: Stop: null,
39: Go: null,
40: Mutate: null,
41: Single_Step: null,
42: New_Rules: null,
43: Start_Setting:null,
44: Set_Cell: null,
45: Stop_Setting: null,
46: Expose: null,
47: ReSize: null,
48: Select: sel_event,
49: Quit: null
50: ]
51:
52: sel_event = struct[
53: Menu: menu,
54: Item: menu_item
55: ]
56:
57: eNone = xevent$Make_None(nil)
58: eClear_All = xevent$Make_Clear_All(nil)
59: eSet_All = xevent$Make_Set_All(nil)
60: eRandomize = xevent$Make_Randomize(nil)
61: eStop = xevent$Make_Stop(nil)
62: eGo = xevent$Make_Go(nil)
63: eMutate = xevent$Make_Mutate(nil)
64: eSingle_Step = xevent$Make_Single_Step(nil)
65: eNew_Rules = xevent$Make_New_Rules(nil)
66: eStart_Setting = xevent$Make_Start_Setting(nil)
67: eSet_Cell = xevent$Make_Set_Cell(nil)
68: eStop_Setting = xevent$Make_Stop_Setting(nil)
69: eExpose = xevent$Make_Expose(nil)
70: eReSize = xevent$Make_ReSize(nil)
71: eQuit = xevent$Make_Quit(nil)
72:
73: qi = sequence[int]
74: ai = array[int]
75: ab = array[bool]
76: ae = array[xevent]
77: gapsize = 1
78: pwidth = 8
79: cwidth = pwidth - gapsize
80:
81: right_Arrow = "\000\002\000\003\200\003\300\003" ||
82: "\340\003\360\003\370\003\374\003" ||
83: "\376\003\377\003\360\003\260\003" ||
84: "\030\003\030\002\014\000\014\000"
85:
86: ra_Width = 10
87: ra_Height = 16
88: ra_X = 9
89: ra_Y = 0
90:
91: left_Arrow = "\000\000\002\000\006\000\016\000\036\000\076\000" ||
92: "\176\000\376\000\376\001\376\003\376\007\176\000" ||
93: "\156\000\306\000\302\000\200\001\200\001\000\000"
94: left_Mask = "\003\000\007\000\017\000\037\000\077\000\177\000" ||
95: "\377\000\377\001\377\003\377\007\377\017\377\017" ||
96: "\377\000\357\001\347\001\303\003\300\003\200\001"
97:
98: la_Width = 12
99: la_Height = 18
100: la_X = 1
101: la_Y = 1
102:
103: info_rec = record[
104: Arena: field,
105: W: x_window ]
106:
107: ints = sequence[int]
108:
109: vNormalHNs = ints$[ -1, -1, -1, 0, 0, 1, 1, 1 ]
110: vNormalWNs = ints$[ -1, 0, 1, -1, 1, -1, 0, 1 ]
111:
112: vKnightHNs = ints$[ -2, -2, -1, -1, 1, 1, 2, 2 ]
113: vKnightWNs = ints$[ -1, 1, -2, 2, -2, 2, -1, 1 ]
114:
115: vDiamondHNs = ints$[ -2, -1, -1, 0, 0, 1, 1, 2 ]
116: vDiamondWNs = ints$[ 0, -1, 1, -2, 2, -1, 1, 0 ]
117:
118: vTest1HNs = ints$[ -2, -1, -1, 0, 0, 1, 1, 2 ]
119: vTest1WNs = ints$[ -2, -1, 0, -1, 1, 0, 1, 2 ]
120:
121: vTest2HNs = ints$[ -1, -1, -1, 0, 0, 1, 2, 2 ]
122: vTest2WNs = ints$[ -1, 0, 1, -1, 1, 0, -2, 2 ]
123:
124: vTest3HNs = ints$[ -1, -1, -1, 0, 0, 1, 2, 1 ]
125: vTest3WNs = ints$[ -1, 0, 1, -1, 2, 0, -2, 1 ]
126:
127: vTest4HNs = ints$[ -1, -1, -1, 0, 0, 1, 2, 2 ]
128: vTest4WNs = ints$[ -1, 0, 1, -1, 2, -1, 0, 2 ]
129:
130: rule_info = record[
131: Rule_MI: menu_item,
132: HNs: ints,
133: WNs: ints
134: ]
135: rules = array[rule_info]
136:
137:
138:
139: MenuLifeDemo = proc ()
140: x_keymap$Load("")
141: bwidth: int := int$parse(xdemo_default("menulife", "BorderWidth"))
142: except when not_found, overflow, bad_format: bwidth := 2 end
143: back: x_pixmap := x_display$White()
144: bdr: x_pixmap := x_display$Black()
145: backpix: int := WhitePixel
146: forepix: int := BlackPixel
147: mousepix: int := BlackPixel
148: if x_display$Cells() > 2
149: then begin
150: r, g, b: int := x_parse_color(xdemo_default("menulife", "Border"))
151: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
152: end except when not_found: end
153: begin
154: r, g, b: int := x_parse_color(xdemo_default("menulife", "Background"))
155: backpix := x_display$alloc_color(r, g, b)
156: back := x_pixmap$tile(backpix)
157: end except when not_found: end
158: begin
159: r, g, b: int := x_parse_color(xdemo_default("menulife", "Foreground"))
160: forepix := x_display$alloc_color(r, g, b)
161: mousepix := forepix
162: end except when not_found: end
163: begin
164: r, g, b: int := x_parse_color(xdemo_default("menulife", "Mouse"))
165: mousepix := x_display$alloc_color(r, g, b)
166: end except when not_found: end
167: end
168: F: x_font := x_font$Create("8x13")
169: W: x_window, XWidth, YHeight: int := x_tcons("menulife", back, bdr,
170: xdemo_geometry(), "=40x40+1+1",
171: F, 8, 8, 1, 3, 3, bwidth)
172: x_font$Destroy(F)
173: x_window$Set_Resize(W, 1, 8, 1, 8)
174: W.Name := "menulife"
175: x_window$Map(W)
176: x_input$Set_Squish(false)
177:
178: Cr: x_cursor := x_cursor$SCons(la_Width, la_Height,
179: left_Arrow, left_Mask,
180: mousepix, backpix,
181: la_X, la_Y, GXcopy)
182:
183: W.Input := keyPressed + keyReleased +
184: buttonPressed + buttonReleased +
185: exposeRegion
186:
187: MFN: string := xdemo_default("menulife", "MenuFont")
188: except when not_found: MFN := "kiltercrn" end
189: MF: x_font := x_font$Create(MFN)
190: MenuBack: int := WhitePixel
191: MenuPlane: int := 1
192: MenuMouse: int := BlackPixel
193: if x_display$Cells() > 2
194: then begin
195: r, g, b: int := x_parse_color(xdemo_default("menulife", "MenuMouse"))
196: MenuMouse := x_display$alloc_color(r, g, b)
197: end except when not_found: end
198: cfore: string := xdemo_default("menulife", "MenuForeground")
199: cback: string := xdemo_default("menulife", "MenuBackground")
200: pixs: pixellist
201: pixs, MenuPlane := x_display$Alloc_Cells(1, 1, false)
202: MenuBack := pixs[1]
203: r, g, b: int := x_parse_color(cfore)
204: x_display$store_color(MenuBack + MenuPlane, r, g, b)
205: r, g, b := x_parse_color(cback)
206: x_display$store_color(MenuBack, r, g, b)
207: end except when not_found: end
208: MB: menu_bar := menu_bar$Init(W, MF, MenuBack, MenuPlane, MenuMouse)
209: Quit_Menu: menu := menu$New(MB, "Exit")
210: Quit_MI: menu_item := menu_item$Create(MB, "Quit", MF)
211: menu$Append(Quit_Menu, Quit_MI)
212:
213: Cntl_Menu: menu := menu$New(MB, "Control")
214: Go_MI: menu_item := menu_item$Create(MB, "Go", MF)
215: menu$Append(Cntl_Menu, Go_MI)
216: menu$Append(Cntl_Menu, menu_item$Empty(MB))
217: Mutate_MI: menu_item := menu_item$Create(MB, "Mutate", MF)
218: menu$Append(Cntl_Menu, Mutate_MI)
219: menu$Append(Cntl_Menu, menu_item$Empty(MB))
220: Clear_All_MI: menu_item := menu_item$Create(MB, "Clear All", MF)
221: menu$Append(Cntl_Menu, Clear_All_MI)
222: Set_All_MI: menu_item := menu_item$Create(MB, "Set All", MF)
223: menu$Append(Cntl_Menu, Set_All_MI)
224: Randomize_MI: menu_item := menu_item$Create(MB, "Randomize", MF)
225: menu$Append(Cntl_Menu, Randomize_MI)
226:
227: Rule_List: rules := rules$[]
228: Rule_MI: menu_item := menu_item$Create(MB, "Normal", MF)
229: Rule_MI.Checked := true
230: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
231: HNs: vNormalHNs,
232: WNs: vNormalWNs
233: })
234: Rule_MI := menu_item$Create(MB, "Knight", MF)
235: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
236: HNs: vKnightHNs,
237: WNs: vKnightWNs
238: })
239: Rule_MI := menu_item$Create(MB, "Diamond", MF)
240: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
241: HNs: vDiamondHNs,
242: WNs: vDiamondWNs
243: })
244: Rule_MI := menu_item$Create(MB, "Test1", MF)
245: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
246: HNs: vTest1HNs,
247: WNs: vTest1WNs
248: })
249: Rule_MI := menu_item$Create(MB, "Test2", MF)
250: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
251: HNs: vTest2HNs,
252: WNs: vTest2WNs
253: })
254: Rule_MI := menu_item$Create(MB, "Test3", MF)
255: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
256: HNs: vTest3HNs,
257: WNs: vTest3WNs
258: })
259: Rule_MI := menu_item$Create(MB, "Test4", MF)
260: rules$AddH(Rule_List, rule_info${ Rule_MI: Rule_MI,
261: HNs: vTest4HNs,
262: WNs: vTest4WNs
263: })
264: Rule_Menu: menu := menu$New(MB, "Rules")
265: for RI: rule_info in rules$Elements(Rule_List) do
266: menu$Append(Rule_Menu, RI.Rule_MI)
267: end
268:
269: menu_bar$Append(MB, Quit_Menu)
270: menu_bar$Append(MB, Cntl_Menu)
271: menu_bar$Append(MB, Rule_Menu)
272:
273: Stopped: bool := true
274: EQ: event_queue := event_queue$Create()
275: event_queue$Queue_Event(EQ, eReSize)
276: No_Changes: bool := false
277: Height: int := -1
278: Width: int := -1
279: Last_I: int := -1
280: Last_J: int := -1
281: Setting: bool := false
282: Set_It: bool := false
283: Was_Stopped: bool := true
284: Mutating: bool := false
285: Mutate_Count: int := 0
286: Next_Mutate: int := 5
287: while (true) do
288: Arena: field
289: Info: info_rec := info_rec${ Arena: Arena,
290: W: W }
291: if (Mutating)
292: then if (random$Next(100) < 2)
293: then Mutate(Arena, W)
294: elseif (false)
295: then Mutate_Count := Mutate_Count + 1
296: if (Mutate_Count >= Next_Mutate)
297: then Mutate(Arena, W)
298: Next_Mutate := 5 + random$Next(10) + 1
299: Mutate_Count := 0
300: end
301: end
302: No_Changes := false
303: end
304: Next_Event: xevent, X, Y, Wd, Ht: int :=
305: event_queue$Next_Event[info_rec](EQ,
306: MB,
307: (Stopped cor
308: No_Changes),
309: Expose_Handler,
310: Info
311: )
312: tagcase Next_Event
313: tag ReSize:
314: if ((Width = (X / pwidth)) cand
315: (Height = (Y / pwidth)))
316: then Expose_Region(X, Y, Wd, Ht, Arena, W)
317: No_Changes := false
318: continue
319: end
320: Sx, Sy, Bw, Sm, Wk: int
321: IW: x_window
322: Sx, Sy, Width, Height, Bw, Sm, Wk, IW := x_window$Query(W)
323: if ((Height < pwidth) cor
324: (Width < pwidth))
325: then x_window$Destroy(W)
326: return
327: end
328: if (((Height // pwidth) ~= gapsize) cor
329: ((Width // pwidth) ~= gapsize))
330: then Height := pwidth * (Height / pwidth) + gapsize
331: Width := pwidth * (Width / pwidth) + gapsize
332: x_window$Change(W, Width, Height)
333: end
334: x_window$Clear(W)
335: W.Cursor := x_cursor$None()
336: x_flush()
337: Width := Width / pwidth
338: Height := Height / pwidth
339: for RI: rule_info in rules$Elements(Rule_List) do
340: if (RI.Rule_MI.Checked)
341: then %% First through away old field so GC can reclaim it.
342: Arena := _cvt[null, field](nil)
343: Arena := field$Create(Height, Width, pwidth, gapsize,
344: RI.HNs, RI.WNs, forepix, backpix)
345: break
346: end
347: end
348: Span: int := Width * Height
349: Span := Span - Width
350: W.Cursor := Cr
351: No_Changes := false
352: tag None:
353: if (~ Stopped)
354: then No_Changes := ~ field$Display_Changes(Arena,
355: W, cwidth)
356: end
357: tag Clear_All:
358: x_window$Clear(W)
359: field$Clear(Arena)
360: No_Changes := false
361: tag Set_All:
362: Set_All(Arena, W)
363: No_Changes := false
364: tag Randomize:
365: Randomize(Arena, W)
366: No_Changes := false
367: tag Stop:
368: Stopped := true
369: No_Changes := false
370: Go_MI.Text := "Go"
371: menu$Item_Changed(Cntl_Menu, Go_MI)
372: tag Go:
373: Stopped := false
374: No_Changes := ~ field$Display_Changes(Arena,
375: W, cwidth)
376: Go_MI.Text := "Stop"
377: menu$Item_Changed(Cntl_Menu, Go_MI)
378: tag Mutate:
379: Mutating := ~ Mutating
380: Mutate_MI.Checked := ~ Mutate_MI.Checked
381: tag Single_Step:
382: if (Stopped)
383: then event_queue$Queue_Event(EQ, eGo)
384: event_queue$Queue_Event(EQ, eStop)
385: else event_queue$Queue_Event(EQ, eStop)
386: end
387: No_Changes := false
388: continue
389: tag New_Rules:
390: tag Start_Setting:
391: W.Input := keyPressed + keyReleased +
392: buttonPressed + buttonReleased +
393: exposeRegion + mouseMoved
394: Last_I, Last_J, Set_It := Set_Cell(X, Y,
395: -1, -1,
396: true,
397: Arena, W)
398: Setting := true
399: Was_Stopped := Stopped
400: Stopped := true
401: tag Set_Cell:
402: if (Setting)
403: then Dummy_Set_It: bool
404: Last_I, Last_J, Dummy_Set_It := Set_Cell(X, Y,
405: Last_I, Last_J,
406: Set_It,
407: Arena, W)
408: No_Changes := false
409: end
410: tag Stop_Setting:
411: W.Input := keyPressed + keyReleased +
412: buttonPressed + buttonReleased +
413: exposeRegion
414: Setting := false
415: Stopped := Was_Stopped
416: tag Expose:
417: Expose_Region(X, Y, Wd, Ht, Arena, W)
418: No_Changes := false
419: tag Quit:
420: x_window$Destroy(W)
421: return
422: tag Select (SE: sel_event):
423: if (SE.Menu = Quit_Menu)
424: then if (SE.Item = Quit_MI)
425: then x_window$Destroy(W)
426: return
427: end
428: elseif (SE.Menu = Cntl_Menu)
429: then if (SE.Item = Go_MI)
430: then if (Stopped)
431: then event_queue$Queue_Event(EQ, eGo)
432: else event_queue$Queue_Event(EQ, eStop)
433: end
434: elseif (SE.Item = Mutate_MI)
435: then event_queue$Queue_Event(EQ, eMutate)
436: elseif (SE.Item = Clear_All_MI)
437: then event_queue$Queue_Event(EQ, eClear_All)
438: elseif (SE.Item = Set_All_MI)
439: then event_queue$Queue_Event(EQ, eSet_All)
440: elseif (SE.Item = Randomize_MI)
441: then event_queue$Queue_Event(EQ, eRandomize)
442: end
443: elseif (SE.Menu = Rule_Menu)
444: then for RI: rule_info in rules$Elements(Rule_List) do
445: if (RI.Rule_MI.Checked)
446: then if (RI.Rule_MI ~= SE.Item)
447: then RI.Rule_MI.Checked := false
448: end
449: else if (RI.Rule_MI = SE.Item)
450: then RI.Rule_MI.Checked := true
451: event_queue$Queue_Event(EQ, eReSize)
452: end
453: end
454: end
455: end
456: end
457: end
458: end MenuLifeDemo
459:
460: Expose_Handler = proc (W: x_window, X: int, Y: int, Width: int, Height: int,
461: Sub_W: x_window, Info: info_rec)
462: if (W = Info.W)
463: then Expose_Region(X, Y, Width, Height, Info.Arena, Info.W)
464: end
465: end Expose_Handler
466:
467:
468: Randomize = proc (Arena: field, W: x_window)
469: for I: int, J: int, Is_Set: bool in field$Random_Changes(Arena) do
470: XC: int := (I - 1) * pwidth + gapsize
471: YC: int := (J - 1) * pwidth + gapsize
472: if (Is_Set)
473: then %% Set a cell
474: x_window$Pix_Set(W, Arena.SetPix, YC, XC, cwidth, cwidth)
475: else %% Clear a cell
476: x_window$Pix_Set(W, Arena.ClearPix, YC, XC, cwidth, cwidth)
477: end
478: end
479: end Randomize
480:
481: Mutate = proc (Arena: field, W: x_window)
482: Num_Cells: int := field$Size(Arena)
483: Height: int, Width: int := field$Dimensions(Arena)
484: %% Num_Mutates: int := ((Num_Cells * (random$Next(5) + 1)) / 1000) + 1
485: Num_Mutates: int := 1
486: for N: int in int$From_To(1, Num_Mutates) do
487: I: int := random$Next(Height) + 1
488: J: int := random$Next(Width) + 1
489: field$Set_Alive(Arena, I, J,
490: (~ field$Is_Alive(Arena, I, J)))
491: field$Display_Cell(Arena, I, J,
492: W, cwidth )
493: end
494: end Mutate
495:
496: Expose_Region = proc (X1: int, Y1: int, Width: int, Height: int,
497: Arena: field, W: x_window)
498: Width := (X1 + Width - 1) / pwidth
499: Height := (Y1 + Height - 1) / pwidth
500: X1 := X1 / pwidth
501: Y1 := Y1 / pwidth
502: for I: int in int$From_To(Y1, Height) do
503: for J: int in int$From_To(X1, Width) do
504: if (field$Is_Alive(Arena, I+1, J+1))
505: then x_window$Pix_Set(W, Arena.SetPix,
506: ((J * pwidth) + gapsize),
507: ((I * pwidth) + gapsize),
508: cwidth, cwidth)
509: end
510: except when bounds:
511: end
512: end
513: end
514: end Expose_Region
515:
516: Set_All = proc (Arena: field, W: x_window)
517: Height: int, Width: int := field$Dimensions(Arena)
518: for X: int in int$From_To(1, Height) do
519: for Y: int in int$From_To(1, Width) do
520: if (~ field$Is_Alive(Arena, X, Y))
521: then field$Set_Alive(Arena, X, Y, true)
522: field$Display_Cell(Arena, X, Y, W, cwidth)
523: end
524: end
525: end
526: end Set_All
527:
528: Set_Cell = proc (X: int, Y: int, Last_I: int, Last_J: int, Set_It: bool,
529: Arena: field, W: x_window)
530: returns (int, int, bool)
531: J: int := int$Max(0, (X - gapsize)) / pwidth + 1
532: I: int := int$Max(0, (Y - gapsize)) / pwidth + 1
533: if (Last_I = -1)
534: then Set_It := ~ field$Is_Alive(Arena, I, J)
535: elseif ((Last_I = I) cand (Last_J = J))
536: then return (I, J, Set_It)
537: end
538: field$Set_Alive(Arena, I, J, Set_It)
539: except when Bounds:
540: return (Last_I, Last_J, Set_It)
541: end
542: field$Display_Cell(Arena, I, J,
543: W, cwidth)
544: return (I, J, Set_It)
545: end Set_Cell
546:
547:
548:
549: event_queue = cluster is create, queue_event, next_event
550:
551: full_event = struct[ E: xevent,
552: X: int,
553: Y: int,
554: X0: int,
555: Y0: int ]
556: queue = array[full_event]
557: rep = record[event: event,
558: queue: queue]
559:
560: Create = proc () returns (cvt)
561: return (rep${event: x_input$Empty_Event(),
562: queue: queue$New()})
563: end Create
564:
565: Queue_Event = proc (EQ: cvt, E: xevent)
566: queue$AddH(EQ.Queue, full_event${ E: E,
567: X: 0,
568: Y: 0,
569: X0: 0,
570: Y0: 0 })
571: end Queue_Event
572:
573: Next_Event = proc [evt: type] (EQ: cvt, MB: menu_bar, Wait: bool,
574: Exp_Handler: ehproc, EHArg: evt)
575: returns (xevent, int, int, int, int)
576: ehproc = proctype(x_window, int, int, int, int, x_window, evt)
577:
578: while (true) do
579: if (queue$Empty(EQ.Queue))
580: then if (Wait cor
581: x_input$Pending())
582: then x_input$DeQ(EQ.Event)
583: if (EQ.Event.Kind = KeyPressed)
584: then Ch: char := Lower(x_keymap$GetC(
585: EQ.Event.Value,
586: EQ.Event.Mask))
587: except when none, multi (*): continue end
588: %% Interpret char
589: if (Ch = 'c')
590: then return (eClear_All,
591: EQ.Event.X, EQ.Event.Y,
592: EQ.Event.X0, EQ.Event.Y0)
593: elseif (Ch = 's')
594: then return (eSet_All,
595: EQ.Event.X, EQ.Event.Y,
596: EQ.Event.X0, EQ.Event.Y0)
597: elseif (Ch = ' ')
598: then return (eSingle_Step,
599: EQ.Event.X, EQ.Event.Y,
600: EQ.Event.X0, EQ.Event.Y0)
601: elseif (Ch = 'r')
602: then return (eRandomize,
603: EQ.Event.X, EQ.Event.Y,
604: EQ.Event.X0, EQ.Event.Y0)
605: elseif (Ch = 'm')
606: then return (eMutate,
607: EQ.Event.X, EQ.Event.Y,
608: EQ.Event.X0, EQ.Event.Y0)
609: elseif (Ch = '\r')
610: then return (eGo,
611: EQ.Event.X, EQ.Event.Y,
612: EQ.Event.X0, EQ.Event.Y0)
613: elseif (Ch = 'q')
614: then return (eQuit,
615: EQ.Event.X, EQ.Event.Y,
616: EQ.Event.X0, EQ.Event.Y0)
617: end
618: elseif (EQ.Event.Kind = ButtonPressed cand
619: EQ.Event.Value = LeftButton)
620: then %% Start setting cells
621: return (eStart_Setting,
622: EQ.Event.X, EQ.Event.Y,
623: EQ.Event.X0, EQ.Event.Y0)
624: elseif (EQ.Event.Kind = ButtonReleased cand
625: EQ.Event.Value = LeftButton)
626: then %% Stop setting cells
627: return (eStop_Setting,
628: EQ.Event.X, EQ.Event.Y,
629: EQ.Event.X0, EQ.Event.Y0)
630: elseif (EQ.Event.Kind = ButtonPressed cand
631: EQ.Event.Value = RightButton)
632: then return (eSingle_Step,
633: EQ.Event.X, EQ.Event.Y,
634: EQ.Event.X0, EQ.Event.Y0)
635: elseif (EQ.Event.Kind = ButtonReleased cand
636: EQ.Event.Value = RightButton)
637: then %% Ignore
638: continue
639: elseif (EQ.Event.Kind = ButtonPressed cand
640: EQ.Event.Value = MiddleButton)
641: then M: menu, MI: menu_item :=
642: menu_bar$Select[evt](MB, EQ.Event.X, EQ.Event.Y, Exp_Handler, EHArg)
643: except when None:
644: continue
645: end
646: return (xevent$Make_Select(
647: sel_event${
648: Menu: M,
649: Item: MI }),
650: EQ.Event.X, EQ.Event.Y,
651: EQ.Event.X0, EQ.Event.Y0)
652: elseif (EQ.Event.Kind = ButtonReleased cand
653: EQ.Event.Value = MiddleButton)
654: then %% Ignore
655: % continue
656: elseif (EQ.Event.Kind = mouseMoved)
657: then %% Mouse has moved
658: return (eSet_Cell,
659: EQ.Event.X, EQ.Event.Y,
660: EQ.Event.X0, EQ.Event.Y0)
661: elseif (EQ.Event.Kind = ExposeWindow)
662: then return (eReSize,
663: EQ.Event.X, EQ.Event.Y,
664: EQ.Event.X0, EQ.Event.Y0)
665: else return (eExpose,
666: EQ.Event.X, EQ.Event.Y,
667: EQ.Event.X0, EQ.Event.Y0)
668: end
669: else return (eNone, 0, 0, 0, 0)
670: end
671: else EQ.Queue.Low := 1
672: FE: full_Event := queue$RemL(EQ.Queue)
673: return (FE.E, FE.X, FE.Y, FE.X0, FE.Y0)
674: end
675: end
676: end Next_Event
677:
678: end event_queue
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.