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