![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to menus.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 menus.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo |
1.1 ! root 1: ! 2: left_Arrow = "\000\000\002\000\006\000\016\000\036\000\076\000" || ! 3: "\176\000\376\000\376\001\376\003\376\007\176\000" || ! 4: "\156\000\306\000\302\000\200\001\200\001\000\000" ! 5: left_Mask = "\003\000\007\000\017\000\037\000\077\000\177\000" || ! 6: "\377\000\377\001\377\003\377\007\377\017\377\017" || ! 7: "\377\000\357\001\347\001\303\003\300\003\200\001" ! 8: ! 9: la_Width = 12 ! 10: la_Height = 18 ! 11: la_X = 1 ! 12: la_Y = 1 ! 13: ! 14: vLine_Width = 1 ! 15: vBottom_Space = 2 ! 16: vTop_Space = 2 ! 17: vLeft_Space = 1 %% avg_width chars ! 18: vRight_Space = 1 ! 19: ! 20: ! 21: menu_bar = cluster is ! 22: init, ! 23: reset, ! 24: insert, ! 25: append, ! 26: remove, ! 27: select, ! 28: get_cursor, get_fore, get_back, get_forepix, get_backpix, get_plane ! 29: ! 30: title = record [ Menu: menu, ! 31: Window: x_window ] ! 32: at = array[title] ! 33: ! 34: rep = record[ ! 35: Window: x_window, ! 36: White_W: x_window, ! 37: MBW: x_window, ! 38: Cursor: x_cursor, ! 39: Font: x_font, ! 40: Fore: x_pixmap, ! 41: Back: x_pixmap, ! 42: ForePix: int, ! 43: BackPix: int, ! 44: Plane: int, ! 45: Titles: at, ! 46: Ch_Width: int, ! 47: Height: int, ! 48: Width: int ! 49: ] ! 50: ! 51: vExtra_Width = 4 * vLine_Width ! 52: vExtra_Height = 4 * vLine_Width ! 53: vWhite_Border = 1 ! 54: vWExtra_Width = vExtra_Width + (2 * vWhite_Border) ! 55: vWExtra_Height = vExtra_Height + (2 * vWhite_Border) ! 56: vLeft_Offset = vLine_Width ! 57: vTop_Offset = vLine_Width ! 58: vHighLight_Offset = vLine_Width ! 59: vHighLight_Height = vExtra_Height - vTop_Offset - vHighLight_Offset ! 60: vHighLight_Width = vExtra_Width - vLeft_Offset - vHighLight_Offset ! 61: ! 62: Init = proc (W: x_window, Font: x_font, BackPix, Plane, MousePix: int) ! 63: returns (cvt) signals (error(string)) ! 64: ForePix: int := i_xor(BackPix, Plane) ! 65: Cursor: x_cursor := x_cursor$SCons(la_Width, la_Height, ! 66: left_Arrow, left_Mask, ! 67: MousePix, BackPix, ! 68: la_X, la_Y, GXcopy) ! 69: Avg_Width: int, ! 70: Height: int, ! 71: Ch1: char, ! 72: ChLast: char, ! 73: BaseLine: int, ! 74: FixedWidth: bool := x_font$Query(Font) ! 75: resignal Error ! 76: Height := Height + vTop_Space + vBottom_Space ! 77: Back: x_pixmap := x_pixmap$Tile(BackPix) ! 78: Fore: x_pixmap := x_pixmap$Tile(ForePix) ! 79: White_W: x_window := x_window$Create( ! 80: 0, ! 81: 0, ! 82: vWExtra_Width, ! 83: Height + vWExtra_Height, ! 84: Back, ! 85: x_display$Root(), ! 86: 0, ! 87: Back) ! 88: White_W.Input := buttonReleased % + enterWindow ! 89: White_W.Cursor := Cursor ! 90: MBW: x_window := x_window$Create( ! 91: 1, ! 92: 1, ! 93: vExtra_Width, ! 94: Height + vExtra_Height, ! 95: Fore, ! 96: White_W, ! 97: 0, ! 98: Fore) ! 99: MBW.Input := buttonReleased % + enterWindow) ! 100: MBW.Cursor := Cursor ! 101: x_window$Map(MBW) ! 102: return (rep${ Window: W, ! 103: White_W: White_W, ! 104: MBW: MBW, ! 105: Cursor: Cursor, ! 106: Font: Font, ! 107: Fore: Fore, ! 108: Back: Back, ! 109: ForePix: ForePix, ! 110: BackPix: BackPix, ! 111: Plane: Plane, ! 112: Titles: at$[], ! 113: Ch_Width: Avg_Width, ! 114: Height: Height, ! 115: Width: vLeft_Offset }) ! 116: end Init ! 117: ! 118: Reset = proc (MB: cvt) ! 119: x_window$Destroy(MB.White_W) ! 120: for T: title in at$Elements(MB.Titles) do ! 121: menu$Reset(T.Menu) ! 122: end ! 123: MB.Titles := at$[] ! 124: MB.Width := vLeft_Offset ! 125: MB.White_W := x_window$Create( ! 126: 0, ! 127: 0, ! 128: vWExtra_Width, ! 129: MB.Height + vWExtra_Height, ! 130: MB.Back, ! 131: x_display$Root(), ! 132: 0, ! 133: MB.Back) ! 134: MB.White_W.Input := buttonReleased % + enterWindow) ! 135: MB.White_W.Cursor := MB.Cursor ! 136: MB.MBW := x_window$Create( ! 137: 1, ! 138: 1, ! 139: vExtra_Width, ! 140: MB.Height + vExtra_Height, ! 141: MB.Fore, ! 142: MB.White_W, ! 143: 0, ! 144: MB.Fore) ! 145: MB.MBW.Input := buttonReleased % + enterWindow) ! 146: MB.MBW.Cursor := MB.Cursor ! 147: x_window$Map(MB.MBW) ! 148: end Reset ! 149: ! 150: Insert = proc (MB: cvt, M: menu, Before_M: menu) signals (not_found) ! 151: for I: int in at$Indexes(MB.Titles) do ! 152: T: title := MB.Titles[I] ! 153: if (T.Menu = Before_M) ! 154: then M.Width := x_font$Width(MB.Font, M.Title) + ! 155: (MB.Ch_Width * ! 156: (vLeft_Space + vRight_Space)) ! 157: MB.Width := MB.Width + M.Width ! 158: x_window$Change(MB.White_W, ! 159: MB.Width - vLeft_Offset + vWExtra_Width, ! 160: MB.Height + vWExtra_Height) ! 161: x_window$Change(MB.MBW, ! 162: MB.Width - vLeft_Offset + vExtra_Width, ! 163: MB.Height + vExtra_Height) ! 164: M.Start := T.Menu.Start ! 165: MW: x_window := x_window$Create( ! 166: M.Start, vTop_Offset, ! 167: M.Width, MB.Height, ! 168: MB.Back, ! 169: MB.MBW, ! 170: 0, ! 171: MB.Fore) ! 172: MW.Input := buttonReleased + enterWindow ! 173: MW.Cursor := MB.Cursor ! 174: x_window$Map(MW) ! 175: New_T: title := title${ Menu: M, ! 176: Window: MW } ! 177: at$AddH(MB.Titles, New_T) ! 178: for J: int in int$From_To(at$High(MB.Titles) - 1, I) do ! 179: T := MB.Titles[J] ! 180: MB.Titles[J+1] := MB.Titles[J] ! 181: T.Menu.Start := T.Menu.Start + M.Width ! 182: x_window$Move(T.Window, T.Menu.Start, 0) ! 183: end ! 184: MB.Titles[I] := New_T ! 185: return ! 186: end ! 187: end ! 188: signal Not_Found ! 189: end Insert ! 190: ! 191: Append = proc (MB: cvt, M: menu) ! 192: M.Start := MB.Width ! 193: M.Width := x_font$Width(MB.Font, M.Title) + ! 194: (MB.Ch_Width * ! 195: (vLeft_Space + vRight_Space)) ! 196: MB.Width := MB.Width + M.Width ! 197: x_window$Change(MB.White_W, ! 198: MB.Width - vLeft_Offset + vWExtra_Width, ! 199: MB.Height + vWExtra_Height) ! 200: x_window$Change(MB.MBW, ! 201: MB.Width - vLeft_Offset + vExtra_Width, ! 202: MB.Height + vExtra_Height) ! 203: MW: x_window := x_window$Create( ! 204: M.Start, vTop_Offset, ! 205: M.Width, MB.Height, ! 206: MB.Back, ! 207: MB.MBW, ! 208: 0, ! 209: MB.Fore) ! 210: MW.Input := buttonReleased + enterWindow ! 211: MW.Cursor := MB.Cursor ! 212: x_window$Map(MW) ! 213: at$AddH(MB.Titles, title${ Menu: M, ! 214: Window: MW }) ! 215: end Append ! 216: ! 217: Remove = proc (MB: cvt, M: menu) signals (not_found) ! 218: for I: int in at$Indexes(MB.Titles) do ! 219: if (MB.Titles[I].Menu = M) ! 220: then MW: x_window := MB.Titles[I].Window ! 221: for J: int in int$From_To(I+1, at$High(MB.Titles)) do ! 222: T: title := MB.Titles[J] ! 223: T.Menu.Start := T.Menu.Start - M.Width ! 224: MB.Titles[J-1] := T ! 225: end ! 226: at$RemH(MB.Titles) ! 227: x_window$Destroy(MW) ! 228: MB.Width := MB.Width - M.Width ! 229: x_window$Change(MB.White_W, ! 230: MB.Width - vLeft_Offset + vWExtra_Width, ! 231: MB.Height + vWExtra_Height) ! 232: x_window$Change(MB.MBW, ! 233: MB.Width - vLeft_Offset + vExtra_Width, ! 234: MB.Height + vExtra_Height) ! 235: menu$Reset(M) ! 236: return ! 237: end ! 238: end ! 239: signal Not_Found ! 240: end Remove ! 241: ! 242: Select = proc [evt: type] (MB: cvt, Start_X: int, Start_Y: int, ! 243: Expose_Handler: ehand_proc, Expose_Hand_Arg: evt) ! 244: returns (menu, menu_item) signals (none) ! 245: ehand_proc = proctype(x_window, int, int, int, int, x_window, evt) ! 246: own E: event := x_input$Empty_Event() ! 247: %% There are three windows of interest: ! 248: %% The main window (of which this is a menu bar) (MB.Window) ! 249: %% The pop-up menu bar window. ! 250: %% The (current) pull-down menu. ! 251: W_X: int, ! 252: W_Y: int, ! 253: W_Width: int, ! 254: W_Height: int, ! 255: W_Border: int, ! 256: W_Map: int, ! 257: W_Kind: int, ! 258: W_Icon: x_window := x_window$Query(MB.Window) ! 259: Left: int := int$Max(W_X + Start_X - (MB.Width / 2), 0) ! 260: Top: int := int$Max(W_Y + Start_Y - (MB.Height / 2), 0) ! 261: ! 262: Display_Bar(MB, Left, Top) ! 263: ! 264: X: int := W_X + Start_X + vLeft_Offset - Left ! 265: Y: int := W_Y + Start_Y + vTop_Offset - Top ! 266: ! 267: Selected_T: title := Title_Selected(X, Y, MB) ! 268: Select_Menu(Selected_T, MB, Top, Left) ! 269: ! 270: Have_Item: bool := false ! 271: Selected_Item: menu_item ! 272: ! 273: while (true) do ! 274: x_input$DeQ(E) ! 275: if (E.Kind = ButtonReleased cand E.Value = MiddleButton) ! 276: then break ! 277: elseif (E.Kind = EnterWindow) ! 278: then %% Check if a Title. ! 279: if (E.Win = Selected_T.Window) ! 280: then continue %% Same old title ! 281: end ! 282: for New_T: title in at$Elements(MB.Titles) do ! 283: if (E.Win = New_T.Window) ! 284: then DeSelect_Menu(Selected_T, MB) ! 285: Select_Menu(New_T, MB, Top, Left) ! 286: Selected_T := New_T ! 287: continue %% New title ! 288: end ! 289: end; ! 290: %% Must be a new item. ! 291: if (Have_Item) ! 292: then %%% ??? ! 293: continue ! 294: end ! 295: Selected_Item := Item_Selected(E.Win, ! 296: Selected_T, MB) ! 297: except when None: ! 298: continue ! 299: end ! 300: Select_Item(Selected_Item, Selected_T) ! 301: Have_Item := true ! 302: elseif (E.Kind = LeaveWindow) ! 303: then if (~ (Have_Item cand ! 304: menu_item$Match(Selected_Item, E.Win))) ! 305: then %%% ????? ! 306: continue ! 307: else DeSelect_Item(Selected_Item, ! 308: Selected_T) ! 309: Have_Item := false ! 310: end ! 311: elseif (E.Kind = ExposeRegion) ! 312: then Expose_Handler(E.Win, E.X, E.Y, E.X0, E.Y0, E.Sub, Expose_Hand_Arg) ! 313: end ! 314: end ! 315: %X, Y, SubW := x_window$Query_Mouse(TopW) ! 316: %Item_Was_Selected: bool := (Have_Item cand ! 317: % Inside_Item(SubW, Selected_Item)) ! 318: Item_Was_Selected: bool := Have_Item ! 319: if (Item_Was_Selected) ! 320: then Flash_Item(Selected_Item, Selected_T) ! 321: DeSelect_Item(Selected_Item, Selected_T) ! 322: end ! 323: DeSelect_Menu(Selected_T, MB) ! 324: ! 325: x_window$UnMap(MB.White_W) ! 326: if (Item_Was_Selected) ! 327: then return (Selected_T.Menu, Selected_Item) ! 328: else signal None ! 329: end ! 330: end Select ! 331: ! 332: Title_Selected = proc (X: int, Y: int, MB: rep) returns (title) signals (none) ! 333: if ((Y < 0) cor (Y >= MB.Height)) ! 334: then signal None ! 335: end ! 336: for T: title in at$Elements(MB.Titles) do ! 337: if ((X >= T.Menu.Start) cand (X < T.Menu.Start + T.Menu.Width)) ! 338: then return (T) ! 339: end ! 340: end ! 341: signal None ! 342: end Title_Selected ! 343: ! 344: Select_Menu = proc (Menu_T: title, MB: rep, Top: int, Left: int) ! 345: if (Menu_T = at$Bottom(MB.Titles)) ! 346: then Left := Left - vLeft_Offset ! 347: end ! 348: menu$Select(Menu_T.Menu, ! 349: (Left + Menu_T.Menu.Start + vLine_Width), ! 350: (Top + vTop_Offset + MB.Height + vLine_Width)) ! 351: x_window$Pix_Fill(Menu_T.Window, 0, x_bitmap$None(), 0, 0, ! 352: Menu_T.Menu.Width, MB.Height, GXinvert, MB.Plane) ! 353: end Select_Menu ! 354: ! 355: DeSelect_Menu = proc (Menu_T: title, MB: rep) ! 356: menu$DeSelect(Menu_T.Menu) ! 357: if (Menu_T = at$Bottom(MB.Titles)) ! 358: then %% Lower left highlight ! 359: x_window$Pix_Set(MB.MBW, MB.BackPix, ! 360: 0, ! 361: MB.Height + vExtra_Height - vHighLight_Height, ! 362: vHighLight_Height, vHighLight_Width) ! 363: ! 364: end ! 365: x_window$Pix_Fill(Menu_T.Window, 0, x_bitmap$None(), 0, 0, ! 366: Menu_T.Menu.Width, MB.Height, GXinvert, MB.Plane) ! 367: end DeSelect_Menu ! 368: ! 369: Inside_Item = proc (SubW: x_window, MI: menu_item) ! 370: returns (bool) ! 371: return (menu_item$Match(MI, SubW)) ! 372: end Inside_Item ! 373: ! 374: Item_Selected = proc (Sub_W: x_window, T: title, MB: rep) ! 375: returns (menu_item) signals (none) ! 376: for TstMI: menu_item in menu$All_Items(T.Menu) do ! 377: if (menu_item$Match(TstMI, Sub_W)) ! 378: then if (TstMI.Selectable cand TstMI.Enabled) ! 379: then return (TstMI) ! 380: else signal None ! 381: end ! 382: end ! 383: end ! 384: signal None ! 385: end Item_Selected ! 386: ! 387: Select_Item = proc (MI: menu_item, M_T: title) ! 388: menu_item$Invert(MI, M_T.Menu.Max_Width) ! 389: end Select_Item ! 390: ! 391: DeSelect_Item = proc (MI: menu_item, M_T: title) ! 392: menu_item$Invert(MI, M_T.Menu.Max_Width) ! 393: end DeSelect_Item ! 394: ! 395: Flash_Item = proc (MI: menu_item, M_T: title) ! 396: M: menu := M_T.Menu ! 397: for I: int in int$From_To(1, 6) do ! 398: menu_item$Invert(MI, M.Max_Width) ! 399: x_flush() ! 400: _Sleep(30) ! 401: end ! 402: end Flash_Item ! 403: ! 404: Display_Bar = proc (MB: rep, Left: int, Top: int) ! 405: White_W: x_window := MB.White_W ! 406: x_window$Move(White_W, Left, Top) ! 407: x_window$Map(White_W) ! 408: Black_W: x_window := MB.MBW ! 409: %% Lower left highlight ! 410: x_window$Pix_Set(Black_W, MB.BackPix, ! 411: 0, ! 412: MB.Height + vExtra_Height - vHighLight_Height, ! 413: vHighLight_Height, vHighLight_Width) ! 414: %% Upper right highlight ! 415: x_window$Pix_Set(Black_W, MB.BackPix, ! 416: MB.Width - vLeft_Offset + vExtra_Width - vHighLight_Width, ! 417: 0, ! 418: vHighLight_Height, vHighLight_Width) ! 419: for T: title in at$Elements(MB.Titles) do ! 420: x_window$Text(T.Window, T.Menu.Title, MB.Font, ! 421: i_xor(MB.BackPix, MB.Plane), MB.BackPix, ! 422: (vLeft_Space * MB.Ch_Width), ! 423: vTop_Space) ! 424: end ! 425: end Display_Bar ! 426: ! 427: Get_Cursor = proc (MB: cvt) returns (x_cursor) ! 428: return(MB.Cursor) ! 429: end Get_Cursor ! 430: ! 431: Get_Fore = proc (MB: cvt) returns (x_pixmap) ! 432: return(MB.Fore) ! 433: end Get_Fore ! 434: ! 435: Get_Back = proc (MB: cvt) returns (x_pixmap) ! 436: return(MB.Back) ! 437: end Get_Back ! 438: ! 439: Get_ForePix = proc (MB: cvt) returns (int) ! 440: return(MB.ForePix) ! 441: end Get_ForePix ! 442: ! 443: Get_BackPix = proc (MB: cvt) returns (int) ! 444: return(MB.BackPix) ! 445: end Get_BackPix ! 446: ! 447: Get_Plane = proc (MB: cvt) returns (int) ! 448: return(MB.Plane) ! 449: end Get_Plane ! 450: ! 451: end menu_bar ! 452: ! 453: menu = cluster is ! 454: new, ! 455: reset, ! 456: equal, ! 457: get_title, ! 458: append, ! 459: remove, ! 460: item_changed, ! 461: all_items, ! 462: set_start, get_start, ! 463: set_width, get_width, ! 464: get_num_items, ! 465: get_max_width, ! 466: get_window, ! 467: select, deselect ! 468: ! 469: mis = sequence[menu_item] ! 470: ! 471: rep = record[ Title: string, ! 472: MB: menu_bar, ! 473: Items: mis, ! 474: Start: int, ! 475: Height: int, ! 476: Max_Width: int, ! 477: Width: int, ! 478: White_W: x_window, ! 479: Window: x_window ] ! 480: ! 481: vExtra_Width = 4 * vLine_Width ! 482: vExtra_Height = 4 * vLine_Width ! 483: vWhite_Border = 1 ! 484: vWExtra_Width = vExtra_Width + (2 * vWhite_Border) ! 485: vWExtra_Height = vExtra_Height + (2 * vWhite_Border) ! 486: vTop_Offset = vLine_Width ! 487: vLeft_Offset = vLine_Width ! 488: vHighLight_Offset = vLine_Width ! 489: vHighLight_Height = vExtra_Height - vTop_Offset - vHighLight_Offset ! 490: vHighLight_Width = vExtra_Width - vLeft_Offset - vHighLight_Offset ! 491: ! 492: New = proc (MB: menu_bar, Title: string) returns (cvt) ! 493: White_W: x_window := x_window$Create( % A minimal window ! 494: 0, 0, ! 495: vWExtra_Width, ! 496: vWExtra_Height, ! 497: MB.Back, ! 498: x_display$Root(), ! 499: 0, ! 500: MB.Back) ! 501: White_W.Input := buttonReleased % + ! 502: %enterWindow + ! 503: %leaveWindow ! 504: White_W.Cursor := MB.Cursor ! 505: Menu_W: x_window := x_window$Create( % A minimal window ! 506: 1, 1, ! 507: vExtra_Width, ! 508: vExtra_Height, ! 509: MB.Fore, ! 510: White_W, ! 511: 0, ! 512: MB.Fore) ! 513: Menu_W.Input := buttonReleased % + ! 514: %enterWindow + ! 515: %leaveWindow ! 516: Menu_W.Cursor := MB.Cursor ! 517: x_window$Map(Menu_W) ! 518: return (rep${ Title: Title, ! 519: MB: MB, ! 520: Items: mis$[], ! 521: Start: 0, ! 522: Height: vTop_Offset, ! 523: Max_Width: 0, ! 524: Width: vLeft_Offset, ! 525: White_W: White_W, ! 526: Window: Menu_W }) ! 527: end New ! 528: ! 529: Reset = proc (M: cvt) ! 530: %% ??? ! 531: end Reset ! 532: ! 533: Equal = proc (M1: cvt, M2: cvt) returns (bool) ! 534: return (M1 = M2) ! 535: end Equal ! 536: ! 537: Get_Title = proc (M: cvt) returns (string) ! 538: return (M.Title) ! 539: end Get_Title ! 540: ! 541: Set_Width = proc (M: cvt, W: int) ! 542: M.Width := W ! 543: end Set_Width ! 544: ! 545: Get_Width = proc (M: cvt) returns (int) ! 546: return (M.Width) ! 547: end Get_Width ! 548: ! 549: Set_Start = proc (M: cvt, S: int) ! 550: M.Start := S ! 551: end Set_Start ! 552: ! 553: Get_Start = proc (M: cvt) returns (int) ! 554: return (M.Start) ! 555: end Get_Start ! 556: ! 557: Append = proc (M: cvt, MI: menu_item) ! 558: Max_Width: int := int$Max(MI.Width, M.Max_Width) ! 559: MI.Start := M.Height ! 560: M.Height := M.Height + MI.Height ! 561: x_window$Change(M.White_W, ! 562: Max_Width + vWExtra_Width, ! 563: M.Height - vTop_Offset + vWExtra_Height) ! 564: x_window$Change(M.Window, ! 565: Max_Width + vExtra_Width, ! 566: M.Height - vTop_Offset + vExtra_Height) ! 567: if (Max_Width > M.Max_Width) ! 568: then M.Max_Width := Max_Width ! 569: for TMI: menu_item in mis$Elements(M.Items) do ! 570: menu_item$Setup(TMI, M.Window, vLeft_Offset, M.Max_Width) ! 571: end ! 572: end ! 573: M.Items := mis$AddH(M.Items, MI) ! 574: menu_item$Setup(MI, M.Window, vLeft_Offset, M.Max_Width) ! 575: end Append ! 576: ! 577: Remove = proc (M: cvt, MI: menu_item) signals (not_found) ! 578: Max_Width: int := 0 ! 579: Found: bool := false ! 580: for Tst_MI: menu_item in mis$Elements(M.Items) do ! 581: if (Tst_MI = MI) ! 582: then Found := true ! 583: continue ! 584: end ! 585: if (Found) ! 586: then Tst_MI.Start := Tst_MI.Start - MI.Height ! 587: end ! 588: Max_Width := int$Max(Max_Width, Tst_MI.Width) ! 589: end ! 590: if (~ Found) ! 591: then signal Not_Found ! 592: end ! 593: M.Height := M.Height - MI.Height ! 594: x_window$Change(M.White_W, ! 595: Max_Width + vWExtra_Width, ! 596: M.Height - vTop_Offset + vWExtra_Height) ! 597: x_window$Change(M.Window, ! 598: Max_Width + vExtra_Width, ! 599: M.Height - vTop_Offset + vExtra_Height) ! 600: M.Max_Width := Max_Width ! 601: for TMI: menu_item in mis$Elements(M.Items) do ! 602: menu_item$Setup(TMI, M.Window, vLeft_Offset, M.Max_Width) ! 603: end ! 604: menu_item$Reset(MI) ! 605: end Remove ! 606: ! 607: Item_Changed = proc (M: cvt, MI: menu_item) signals (not_found) ! 608: Max_Width: int := 0 ! 609: for Tst_MI: menu_item in mis$Elements(M.Items) do ! 610: Max_Width := int$Max(Max_Width, Tst_MI.Width) ! 611: end ! 612: if (Max_Width ~= M.Max_Width) ! 613: then M.Max_Width := Max_Width ! 614: x_window$Change(M.White_W, ! 615: Max_Width + vWExtra_Width, ! 616: M.Height - vTop_Offset + vWExtra_Height) ! 617: x_window$Change(M.Window, ! 618: Max_Width + vExtra_Width, ! 619: M.Height - vTop_Offset + vExtra_Height) ! 620: for TMI: menu_item in mis$Elements(M.Items) do ! 621: menu_item$Setup(TMI, M.Window, vLeft_Offset, M.Max_Width) ! 622: end ! 623: end ! 624: end Item_Changed ! 625: ! 626: Get_Num_Items = proc (M: cvt) returns (int) ! 627: return (mis$Size(M.Items)) ! 628: end Get_Num_Items ! 629: ! 630: Get_Max_Width = proc (M: cvt) returns (int) ! 631: return (M.Max_Width) ! 632: end Get_Max_Width ! 633: ! 634: All_Items = iter (M: cvt) yields (menu_item) ! 635: for MI: menu_item in mis$Elements(M.Items) do ! 636: yield(MI) ! 637: end ! 638: end All_Items ! 639: ! 640: Get_Window = proc (M: cvt) returns (x_window) ! 641: return (M.Window) ! 642: end Get_Window ! 643: ! 644: Select = proc (M: cvt, X: int, Y: int) ! 645: x_window$Move(M.White_W, X-1, Y) ! 646: x_window$Map(M.White_W) ! 647: %% Lower left highlight ! 648: x_window$Pix_Set(M.Window, M.MB.BackPix, ! 649: 0, ! 650: M.Height - vTop_Offset + vExtra_Height - vHighLight_Height, ! 651: vHighLight_Height, vHighLight_Width) ! 652: %% Upper right highlight ! 653: x_window$Pix_Set(M.Window, M.MB.BackPix, ! 654: M.Max_Width + vExtra_Width - vHighLight_Height, ! 655: 0, ! 656: vHighLight_Height, vHighLight_Width) ! 657: for MI: menu_item in mis$Elements(M.Items) do ! 658: menu_item$Display(MI, M.Max_Width) ! 659: end; ! 660: end Select ! 661: ! 662: DeSelect = proc (M: cvt) ! 663: x_window$UnMap(M.White_W) ! 664: end DeSelect ! 665: ! 666: end menu ! 667: ! 668: menu_item = cluster is ! 669: create, empty, equal, ! 670: set_enabled, get_enabled, ! 671: set_selectable, get_selectable, ! 672: set_text, get_text, ! 673: set_checked, get_checked, ! 674: get_width, get_height, ! 675: set_start, get_start, ! 676: setup, reset, ! 677: display, ! 678: invert, ! 679: match ! 680: ! 681: ! 682: mw = oneof[one: x_window, none: null] ! 683: mf = oneof[one: x_font, none: null] ! 684: ! 685: rep = record[ ! 686: Checked: bool, ! 687: Enabled: bool, ! 688: Font: mf, ! 689: MB: menu_bar, ! 690: Chk_Width: int, ! 691: Left_Fill: int, ! 692: Height: int, ! 693: Selectable: bool, ! 694: Start: int, ! 695: Text: string, ! 696: Width: int, ! 697: Window: mw ! 698: ] ! 699: ! 700: vCheck_String = "* " ! 701: ! 702: Create = proc (MB: menu_bar, Text: string, Font: x_font) returns (cvt) ! 703: signals (error(string)) ! 704: Avg_Width: int, ! 705: Height: int, ! 706: Ch1: char, ! 707: ChLast: char, ! 708: BaseLine: int, ! 709: FixedWidth: bool := x_font$Query(Font) ! 710: resignal Error ! 711: Width: int := x_font$Width(Font, Text) + ! 712: x_font$Width(Font, vCheck_String) + ! 713: (vLeft_Space + vRight_Space) * Avg_Width ! 714: return (rep${ Checked: false, ! 715: Enabled: true, ! 716: Font: mf$Make_One(Font), ! 717: MB: MB, ! 718: Chk_Width: x_font$Width(Font, vCheck_String), ! 719: Left_Fill: (vLeft_Space * Avg_Width), ! 720: Height: Height + vTop_Space + vBottom_Space, ! 721: Selectable: true, ! 722: Start: 0, ! 723: Text: Text, ! 724: Width: Width, ! 725: Window: mw$Make_None(nil) }) ! 726: end Create ! 727: ! 728: Empty = proc (MB: menu_bar) returns (cvt) ! 729: vEmpty_Height = 10 ! 730: return (rep${ Checked: false, ! 731: Enabled: false, ! 732: Font: mf$Make_None(nil), ! 733: MB: MB, ! 734: Chk_Width: 0, ! 735: Left_Fill: 0, ! 736: Height: vEmpty_Height, ! 737: Selectable: false, ! 738: Start: 0, ! 739: Text: "", ! 740: Width: 0, ! 741: Window: mw$Make_None(nil) }) ! 742: end Empty ! 743: ! 744: Equal = proc (MI1: cvt, MI2: cvt) returns (bool) ! 745: return (MI1 = MI2) ! 746: end Equal ! 747: ! 748: Set_Enabled = proc (MI: cvt, E: bool) ! 749: MI.Enabled := E ! 750: end Set_Enabled ! 751: ! 752: Get_Enabled = proc (MI: cvt) returns (bool) ! 753: return (MI.Enabled) ! 754: end Get_Enabled ! 755: ! 756: Set_Checked = proc (MI: cvt, C: bool) ! 757: MI.Checked := C ! 758: end Set_Checked ! 759: ! 760: Get_Checked = proc (MI: cvt) returns (bool) ! 761: return (MI.Checked) ! 762: end Get_Checked ! 763: ! 764: Set_Selectable = proc (MI: cvt, S: bool) ! 765: MI.Selectable := S ! 766: end Set_Selectable ! 767: ! 768: Get_Selectable = proc (MI: cvt) returns (bool) ! 769: return (MI.Selectable) ! 770: end Get_Selectable ! 771: ! 772: Set_Text = proc (MI: cvt, Text: string) signals (is_empty) ! 773: Font: x_font := mf$Value_One(MI.Font) ! 774: except when Wrong_Tag: ! 775: signal Is_Empty ! 776: end ! 777: MI.Text := Text ! 778: Avg_Width: int, ! 779: Height: int, ! 780: Ch1: char, ! 781: ChLast: char, ! 782: BaseLine: int, ! 783: FixedWidth: bool := x_font$Query(Font) ! 784: MI.Width := x_font$Width(Font, Text) + ! 785: x_font$Width(Font, vCheck_String) + ! 786: (vLeft_Space + vRight_Space) * Avg_Width ! 787: end Set_Text ! 788: ! 789: Get_Text = proc (MI: cvt) returns (string) ! 790: return (MI.Text) ! 791: end Get_Text ! 792: ! 793: Get_Width = proc (MI: cvt) returns (int) ! 794: return (MI.Width) ! 795: end Get_Width ! 796: ! 797: Get_Height = proc (MI: cvt) returns (int) ! 798: return (MI.Height) ! 799: end Get_Height ! 800: ! 801: Get_Start = proc (MI: cvt) returns (int) ! 802: return (MI.Start) ! 803: end Get_Start ! 804: ! 805: Set_Start = proc (MI: cvt, Start: int) ! 806: MI.Start := Start ! 807: end Set_Start ! 808: ! 809: Setup = proc (MI: cvt, Menu_W: x_window, Left_Start: int, Full_Width: int) ! 810: W: x_window := mw$Value_One(MI.Window) ! 811: except when Wrong_Tag: ! 812: W := x_window$Create( ! 813: Left_Start, MI.Start, ! 814: Full_Width, MI.Height, ! 815: MI.MB.Back, ! 816: Menu_W, ! 817: 0, ! 818: MI.MB.Fore) ! 819: W.Input := buttonReleased + ! 820: enterWindow + ! 821: leaveWindow ! 822: W.Cursor := MI.MB.Cursor ! 823: x_window$Map(W) ! 824: MI.Window := mw$Make_One(W) ! 825: return ! 826: end ! 827: x_window$Change(W, Full_Width, MI.Height) ! 828: x_window$Move(W, Left_Start, MI.Start) ! 829: end Setup ! 830: ! 831: Display = proc (MI: cvt, Full_Width: int) ! 832: W: x_window := mw$Value_One(MI.Window) ! 833: if (MI.Selectable) ! 834: then if (MI.Checked) ! 835: then x_window$Text(W, ! 836: vCheck_String, mf$Value_One(MI.Font), ! 837: MI.MB.ForePix, MI.MB.BackPix, ! 838: MI.Left_Fill, vTop_Space) ! 839: end ! 840: x_window$Text(W, ! 841: MI.Text, mf$Value_One(MI.Font), ! 842: MI.MB.ForePix, MI.MB.BackPix, ! 843: (MI.Left_Fill + MI.Chk_Width), vTop_Space) ! 844: if (~ MI.Enabled) ! 845: then % x_window$Tile_Set(W, x_display$Gray(), ! 846: % 0, vTop_Space, ! 847: % Full_Width, ! 848: % MI.Height) ! 849: end ! 850: end ! 851: except when Wrong_Tag: %% No Font. ! 852: end ! 853: end Display ! 854: ! 855: Reset = proc (MI: cvt) ! 856: x_window$Destroy(mw$Value_One(MI.Window)) ! 857: except when Wrong_Tag: ! 858: return ! 859: end ! 860: MI.Window := mw$Make_None(nil) ! 861: end Reset ! 862: ! 863: Invert = proc (MI: cvt, Full_Width: int) ! 864: x_window$Pix_Fill(mw$Value_One(MI.Window), 0, x_bitmap$None(), 0, 0, ! 865: Full_Width, MI.Height, GXinvert, MI.MB.Plane) ! 866: except when Wrong_Tag: ! 867: end ! 868: end Invert ! 869: ! 870: Match = proc (MI: cvt, W: x_window) returns (bool) ! 871: return (mw$Value_One(MI.Window) = W) ! 872: except when Wrong_Tag: ! 873: return (false) ! 874: end ! 875: end Match ! 876: ! 877: end menu_item
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.