![[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] / 43BSDTahoe / new / X / xdemo|
Return to menulife.clu CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / new / 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.