+
+left_Arrow = "\000\000\002\000\006\000\016\000\036\000\076\000" ||
+ "\176\000\376\000\376\001\376\003\376\007\176\000" ||
+ "\156\000\306\000\302\000\200\001\200\001\000\000"
+left_Mask = "\003\000\007\000\017\000\037\000\077\000\177\000" ||
+ "\377\000\377\001\377\003\377\007\377\017\377\017" ||
+ "\377\000\357\001\347\001\303\003\300\003\200\001"
+
+la_Width = 12
+la_Height = 18
+la_X = 1
+la_Y = 1
+
+vLine_Width = 1
+vBottom_Space = 2
+vTop_Space = 2
+vLeft_Space = 1 %% avg_width chars
+vRight_Space = 1
+
+
+menu_bar = cluster is
+ init,
+ reset,
+ insert,
+ append,
+ remove,
+ select,
+ get_cursor, get_fore, get_back, get_forepix, get_backpix, get_plane
+
+ title = record [ Menu: menu,
+ Window: x_window ]
+ at = array[title]
+
+ rep = record[
+ Window: x_window,
+ White_W: x_window,
+ MBW: x_window,
+ Cursor: x_cursor,
+ Font: x_font,
+ Fore: x_pixmap,
+ Back: x_pixmap,
+ ForePix: int,
+ BackPix: int,
+ Plane: int,
+ Titles: at,
+ Ch_Width: int,
+ Height: int,
+ Width: int
+ ]
+
+ vExtra_Width = 4 * vLine_Width
+ vExtra_Height = 4 * vLine_Width
+ vWhite_Border = 1
+ vWExtra_Width = vExtra_Width + (2 * vWhite_Border)
+ vWExtra_Height = vExtra_Height + (2 * vWhite_Border)
+ vLeft_Offset = vLine_Width
+ vTop_Offset = vLine_Width
+ vHighLight_Offset = vLine_Width
+ vHighLight_Height = vExtra_Height - vTop_Offset - vHighLight_Offset
+ vHighLight_Width = vExtra_Width - vLeft_Offset - vHighLight_Offset
+
+ Init = proc (W: x_window, Font: x_font, BackPix, Plane, MousePix: int)
+ returns (cvt) signals (error(string))
+ ForePix: int := i_xor(BackPix, Plane)
+ Cursor: x_cursor := x_cursor$SCons(la_Width, la_Height,
+ left_Arrow, left_Mask,
+ MousePix, BackPix,
+ la_X, la_Y, GXcopy)
+ Avg_Width: int,
+ Height: int,
+ Ch1: char,
+ ChLast: char,
+ BaseLine: int,
+ FixedWidth: bool := x_font$Query(Font)
+ resignal Error
+ Height := Height + vTop_Space + vBottom_Space
+ Back: x_pixmap := x_pixmap$Tile(BackPix)
+ Fore: x_pixmap := x_pixmap$Tile(ForePix)
+ White_W: x_window := x_window$Create(
+ 0,
+ 0,
+ vWExtra_Width,
+ Height + vWExtra_Height,
+ Back,
+ x_display$Root(),
+ 0,
+ Back)
+ White_W.Input := buttonReleased % + enterWindow
+ White_W.Cursor := Cursor
+ MBW: x_window := x_window$Create(
+ 1,
+ 1,
+ vExtra_Width,
+ Height + vExtra_Height,
+ Fore,
+ White_W,
+ 0,
+ Fore)
+ MBW.Input := buttonReleased % + enterWindow)
+ MBW.Cursor := Cursor
+ x_window$Map(MBW)
+ return (rep${ Window: W,
+ White_W: White_W,
+ MBW: MBW,
+ Cursor: Cursor,
+ Font: Font,
+ Fore: Fore,
+ Back: Back,
+ ForePix: ForePix,
+ BackPix: BackPix,
+ Plane: Plane,
+ Titles: at$[],
+ Ch_Width: Avg_Width,
+ Height: Height,
+ Width: vLeft_Offset })
+ end Init
+
+ Reset = proc (MB: cvt)
+ x_window$Destroy(MB.White_W)
+ for T: title in at$Elements(MB.Titles) do
+ menu$Reset(T.Menu)
+ end
+ MB.Titles := at$[]
+ MB.Width := vLeft_Offset
+ MB.White_W := x_window$Create(
+ 0,
+ 0,
+ vWExtra_Width,
+ MB.Height + vWExtra_Height,
+ MB.Back,
+ x_display$Root(),
+ 0,
+ MB.Back)
+ MB.White_W.Input := buttonReleased % + enterWindow)
+ MB.White_W.Cursor := MB.Cursor
+ MB.MBW := x_window$Create(
+ 1,
+ 1,
+ vExtra_Width,
+ MB.Height + vExtra_Height,
+ MB.Fore,
+ MB.White_W,
+ 0,
+ MB.Fore)
+ MB.MBW.Input := buttonReleased % + enterWindow)
+ MB.MBW.Cursor := MB.Cursor
+ x_window$Map(MB.MBW)
+ end Reset
+
+ Insert = proc (MB: cvt, M: menu, Before_M: menu) signals (not_found)
+ for I: int in at$Indexes(MB.Titles) do
+ T: title := MB.Titles[I]
+ if (T.Menu = Before_M)
+ then M.Width := x_font$Width(MB.Font, M.Title) +
+ (MB.Ch_Width *
+ (vLeft_Space + vRight_Space))
+ MB.Width := MB.Width + M.Width
+ x_window$Change(MB.White_W,
+ MB.Width - vLeft_Offset + vWExtra_Width,
+ MB.Height + vWExtra_Height)
+ x_window$Change(MB.MBW,
+ MB.Width - vLeft_Offset + vExtra_Width,
+ MB.Height + vExtra_Height)
+ M.Start := T.Menu.Start
+ MW: x_window := x_window$Create(
+ M.Start, vTop_Offset,
+ M.Width, MB.Height,
+ MB.Back,
+ MB.MBW,
+ 0,
+ MB.Fore)
+ MW.Input := buttonReleased + enterWindow
+ MW.Cursor := MB.Cursor
+ x_window$Map(MW)
+ New_T: title := title${ Menu: M,
+ Window: MW }
+ at$AddH(MB.Titles, New_T)
+ for J: int in int$From_To(at$High(MB.Titles) - 1, I) do
+ T := MB.Titles[J]
+ MB.Titles[J+1] := MB.Titles[J]
+ T.Menu.Start := T.Menu.Start + M.Width
+ x_window$Move(T.Window, T.Menu.Start, 0)
+ end
+ MB.Titles[I] := New_T
+ return
+ end
+ end
+ signal Not_Found
+ end Insert
+
+ Append = proc (MB: cvt, M: menu)
+ M.Start := MB.Width
+ M.Width := x_font$Width(MB.Font, M.Title) +
+ (MB.Ch_Width *
+ (vLeft_Space + vRight_Space))
+ MB.Width := MB.Width + M.Width
+ x_window$Change(MB.White_W,
+ MB.Width - vLeft_Offset + vWExtra_Width,
+ MB.Height + vWExtra_Height)
+ x_window$Change(MB.MBW,
+ MB.Width - vLeft_Offset + vExtra_Width,
+ MB.Height + vExtra_Height)
+ MW: x_window := x_window$Create(
+ M.Start, vTop_Offset,
+ M.Width, MB.Height,
+ MB.Back,
+ MB.MBW,
+ 0,
+ MB.Fore)
+ MW.Input := buttonReleased + enterWindow
+ MW.Cursor := MB.Cursor
+ x_window$Map(MW)
+ at$AddH(MB.Titles, title${ Menu: M,
+ Window: MW })
+ end Append
+
+ Remove = proc (MB: cvt, M: menu) signals (not_found)
+ for I: int in at$Indexes(MB.Titles) do
+ if (MB.Titles[I].Menu = M)
+ then MW: x_window := MB.Titles[I].Window
+ for J: int in int$From_To(I+1, at$High(MB.Titles)) do
+ T: title := MB.Titles[J]
+ T.Menu.Start := T.Menu.Start - M.Width
+ MB.Titles[J-1] := T
+ end
+ at$RemH(MB.Titles)
+ x_window$Destroy(MW)
+ MB.Width := MB.Width - M.Width
+ x_window$Change(MB.White_W,
+ MB.Width - vLeft_Offset + vWExtra_Width,
+ MB.Height + vWExtra_Height)
+ x_window$Change(MB.MBW,
+ MB.Width - vLeft_Offset + vExtra_Width,
+ MB.Height + vExtra_Height)
+ menu$Reset(M)
+ return
+ end
+ end
+ signal Not_Found
+ end Remove
+
+ Select = proc [evt: type] (MB: cvt, Start_X: int, Start_Y: int,
+ Expose_Handler: ehand_proc, Expose_Hand_Arg: evt)
+ returns (menu, menu_item) signals (none)
+ ehand_proc = proctype(x_window, int, int, int, int, x_window, evt)
+ own E: event := x_input$Empty_Event()
+ %% There are three windows of interest:
+ %% The main window (of which this is a menu bar) (MB.Window)
+ %% The pop-up menu bar window.
+ %% The (current) pull-down menu.
+ W_X: int,
+ W_Y: int,
+ W_Width: int,
+ W_Height: int,
+ W_Border: int,
+ W_Map: int,
+ W_Kind: int,
+ W_Icon: x_window := x_window$Query(MB.Window)
+ Left: int := int$Max(W_X + Start_X - (MB.Width / 2), 0)
+ Top: int := int$Max(W_Y + Start_Y - (MB.Height / 2), 0)
+
+ Display_Bar(MB, Left, Top)
+
+ X: int := W_X + Start_X + vLeft_Offset - Left
+ Y: int := W_Y + Start_Y + vTop_Offset - Top
+
+ Selected_T: title := Title_Selected(X, Y, MB)
+ Select_Menu(Selected_T, MB, Top, Left)
+
+ Have_Item: bool := false
+ Selected_Item: menu_item
+
+ while (true) do
+ x_input$DeQ(E)
+ if (E.Kind = ButtonReleased cand E.Value = MiddleButton)
+ then break
+ elseif (E.Kind = EnterWindow)
+ then %% Check if a Title.
+ if (E.Win = Selected_T.Window)
+ then continue %% Same old title
+ end
+ for New_T: title in at$Elements(MB.Titles) do
+ if (E.Win = New_T.Window)
+ then DeSelect_Menu(Selected_T, MB)
+ Select_Menu(New_T, MB, Top, Left)
+ Selected_T := New_T
+ continue %% New title
+ end
+ end;
+ %% Must be a new item.
+ if (Have_Item)
+ then %%% ???
+ continue
+ end
+ Selected_Item := Item_Selected(E.Win,
+ Selected_T, MB)
+ except when None:
+ continue
+ end
+ Select_Item(Selected_Item, Selected_T)
+ Have_Item := true
+ elseif (E.Kind = LeaveWindow)
+ then if (~ (Have_Item cand
+ menu_item$Match(Selected_Item, E.Win)))
+ then %%% ?????
+ continue
+ else DeSelect_Item(Selected_Item,
+ Selected_T)
+ Have_Item := false
+ end
+ elseif (E.Kind = ExposeRegion)
+ then Expose_Handler(E.Win, E.X, E.Y, E.X0, E.Y0, E.Sub, Expose_Hand_Arg)
+ end
+ end
+ %X, Y, SubW := x_window$Query_Mouse(TopW)
+ %Item_Was_Selected: bool := (Have_Item cand
+ % Inside_Item(SubW, Selected_Item))
+ Item_Was_Selected: bool := Have_Item
+ if (Item_Was_Selected)
+ then Flash_Item(Selected_Item, Selected_T)
+ DeSelect_Item(Selected_Item, Selected_T)
+ end
+ DeSelect_Menu(Selected_T, MB)
+
+ x_window$UnMap(MB.White_W)
+ if (Item_Was_Selected)
+ then return (Selected_T.Menu, Selected_Item)
+ else signal None
+ end
+ end Select
+
+ Title_Selected = proc (X: int, Y: int, MB: rep) returns (title) signals (none)
+ if ((Y < 0) cor (Y >= MB.Height))
+ then signal None
+ end
+ for T: title in at$Elements(MB.Titles) do
+ if ((X >= T.Menu.Start) cand (X < T.Menu.Start + T.Menu.Width))
+ then return (T)
+ end
+ end
+ signal None
+ end Title_Selected
+
+ Select_Menu = proc (Menu_T: title, MB: rep, Top: int, Left: int)
+ if (Menu_T = at$Bottom(MB.Titles))
+ then Left := Left - vLeft_Offset
+ end
+ menu$Select(Menu_T.Menu,
+ (Left + Menu_T.Menu.Start + vLine_Width),
+ (Top + vTop_Offset + MB.Height + vLine_Width))
+ x_window$Pix_Fill(Menu_T.Window, 0, x_bitmap$None(), 0, 0,
+ Menu_T.Menu.Width, MB.Height, GXinvert, MB.Plane)
+ end Select_Menu
+
+ DeSelect_Menu = proc (Menu_T: title, MB: rep)
+ menu$DeSelect(Menu_T.Menu)
+ if (Menu_T = at$Bottom(MB.Titles))
+ then %% Lower left highlight
+ x_window$Pix_Set(MB.MBW, MB.BackPix,
+ 0,
+ MB.Height + vExtra_Height - vHighLight_Height,
+ vHighLight_Height, vHighLight_Width)
+
+ end
+ x_window$Pix_Fill(Menu_T.Window, 0, x_bitmap$None(), 0, 0,
+ Menu_T.Menu.Width, MB.Height, GXinvert, MB.Plane)
+ end DeSelect_Menu
+
+ Inside_Item = proc (SubW: x_window, MI: menu_item)
+ returns (bool)
+ return (menu_item$Match(MI, SubW))
+ end Inside_Item
+
+ Item_Selected = proc (Sub_W: x_window, T: title, MB: rep)
+ returns (menu_item) signals (none)
+ for TstMI: menu_item in menu$All_Items(T.Menu) do
+ if (menu_item$Match(TstMI, Sub_W))
+ then if (TstMI.Selectable cand TstMI.Enabled)
+ then return (TstMI)
+ else signal None
+ end
+ end
+ end
+ signal None
+ end Item_Selected
+
+ Select_Item = proc (MI: menu_item, M_T: title)
+ menu_item$Invert(MI, M_T.Menu.Max_Width)
+ end Select_Item
+
+ DeSelect_Item = proc (MI: menu_item, M_T: title)
+ menu_item$Invert(MI, M_T.Menu.Max_Width)
+ end DeSelect_Item
+
+ Flash_Item = proc (MI: menu_item, M_T: title)
+ M: menu := M_T.Menu
+ for I: int in int$From_To(1, 6) do
+ menu_item$Invert(MI, M.Max_Width)
+ x_flush()
+ _Sleep(30)
+ end
+ end Flash_Item
+
+ Display_Bar = proc (MB: rep, Left: int, Top: int)
+ White_W: x_window := MB.White_W
+ x_window$Move(White_W, Left, Top)
+ x_window$Map(White_W)
+ Black_W: x_window := MB.MBW
+ %% Lower left highlight
+ x_window$Pix_Set(Black_W, MB.BackPix,
+ 0,
+ MB.Height + vExtra_Height - vHighLight_Height,
+ vHighLight_Height, vHighLight_Width)
+ %% Upper right highlight
+ x_window$Pix_Set(Black_W, MB.BackPix,
+ MB.Width - vLeft_Offset + vExtra_Width - vHighLight_Width,
+ 0,
+ vHighLight_Height, vHighLight_Width)
+ for T: title in at$Elements(MB.Titles) do
+ x_window$Text(T.Window, T.Menu.Title, MB.Font,
+ i_xor(MB.BackPix, MB.Plane), MB.BackPix,
+ (vLeft_Space * MB.Ch_Width),
+ vTop_Space)
+ end
+ end Display_Bar
+
+ Get_Cursor = proc (MB: cvt) returns (x_cursor)
+ return(MB.Cursor)
+ end Get_Cursor
+
+ Get_Fore = proc (MB: cvt) returns (x_pixmap)
+ return(MB.Fore)
+ end Get_Fore
+
+ Get_Back = proc (MB: cvt) returns (x_pixmap)
+ return(MB.Back)
+ end Get_Back
+
+ Get_ForePix = proc (MB: cvt) returns (int)
+ return(MB.ForePix)
+ end Get_ForePix
+
+ Get_BackPix = proc (MB: cvt) returns (int)
+ return(MB.BackPix)
+ end Get_BackPix
+
+ Get_Plane = proc (MB: cvt) returns (int)
+ return(MB.Plane)
+ end Get_Plane
+
+ end menu_bar
+
+menu = cluster is
+ new,
+ reset,
+ equal,
+ get_title,
+ append,
+ remove,
+ item_changed,
+ all_items,
+ set_start, get_start,
+ set_width, get_width,
+ get_num_items,
+ get_max_width,
+ get_window,
+ select, deselect
+
+ mis = sequence[menu_item]
+
+ rep = record[ Title: string,
+ MB: menu_bar,
+ Items: mis,
+ Start: int,
+ Height: int,
+ Max_Width: int,
+ Width: int,
+ White_W: x_window,
+ Window: x_window ]
+
+ vExtra_Width = 4 * vLine_Width
+ vExtra_Height = 4 * vLine_Width
+ vWhite_Border = 1
+ vWExtra_Width = vExtra_Width + (2 * vWhite_Border)
+ vWExtra_Height = vExtra_Height + (2 * vWhite_Border)
+ vTop_Offset = vLine_Width
+ vLeft_Offset = vLine_Width
+ vHighLight_Offset = vLine_Width
+ vHighLight_Height = vExtra_Height - vTop_Offset - vHighLight_Offset
+ vHighLight_Width = vExtra_Width - vLeft_Offset - vHighLight_Offset
+
+ New = proc (MB: menu_bar, Title: string) returns (cvt)
+ White_W: x_window := x_window$Create( % A minimal window
+ 0, 0,
+ vWExtra_Width,
+ vWExtra_Height,
+ MB.Back,
+ x_display$Root(),
+ 0,
+ MB.Back)
+ White_W.Input := buttonReleased % +
+ %enterWindow +
+ %leaveWindow
+ White_W.Cursor := MB.Cursor
+ Menu_W: x_window := x_window$Create( % A minimal window
+ 1, 1,
+ vExtra_Width,
+ vExtra_Height,
+ MB.Fore,
+ White_W,
+ 0,
+ MB.Fore)
+ Menu_W.Input := buttonReleased % +
+ %enterWindow +
+ %leaveWindow
+ Menu_W.Cursor := MB.Cursor
+ x_window$Map(Menu_W)
+ return (rep${ Title: Title,
+ MB: MB,
+ Items: mis$[],
+ Start: 0,
+ Height: vTop_Offset,
+ Max_Width: 0,
+ Width: vLeft_Offset,
+ White_W: White_W,
+ Window: Menu_W })
+ end New
+
+ Reset = proc (M: cvt)
+ %% ???
+ end Reset
+
+ Equal = proc (M1: cvt, M2: cvt) returns (bool)
+ return (M1 = M2)
+ end Equal
+
+ Get_Title = proc (M: cvt) returns (string)
+ return (M.Title)
+ end Get_Title
+
+ Set_Width = proc (M: cvt, W: int)
+ M.Width := W
+ end Set_Width
+
+ Get_Width = proc (M: cvt) returns (int)
+ return (M.Width)
+ end Get_Width
+
+ Set_Start = proc (M: cvt, S: int)
+ M.Start := S
+ end Set_Start
+
+ Get_Start = proc (M: cvt) returns (int)
+ return (M.Start)
+ end Get_Start
+
+ Append = proc (M: cvt, MI: menu_item)
+ Max_Width: int := int$Max(MI.Width, M.Max_Width)
+ MI.Start := M.Height
+ M.Height := M.Height + MI.Height
+ x_window$Change(M.White_W,
+ Max_Width + vWExtra_Width,
+ M.Height - vTop_Offset + vWExtra_Height)
+ x_window$Change(M.Window,
+ Max_Width + vExtra_Width,
+ M.Height - vTop_Offset + vExtra_Height)
+ if (Max_Width > M.Max_Width)
+ then M.Max_Width := Max_Width
+ for TMI: menu_item in mis$Elements(M.Items) do
+ menu_item$Setup(TMI, M.Window, vLeft_Offset, M.Max_Width)
+ end
+ end
+ M.Items := mis$AddH(M.Items, MI)
+ menu_item$Setup(MI, M.Window, vLeft_Offset, M.Max_Width)
+ end Append
+
+ Remove = proc (M: cvt, MI: menu_item) signals (not_found)
+ Max_Width: int := 0
+ Found: bool := false
+ for Tst_MI: menu_item in mis$Elements(M.Items) do
+ if (Tst_MI = MI)
+ then Found := true
+ continue
+ end
+ if (Found)
+ then Tst_MI.Start := Tst_MI.Start - MI.Height
+ end
+ Max_Width := int$Max(Max_Width, Tst_MI.Width)
+ end
+ if (~ Found)
+ then signal Not_Found
+ end
+ M.Height := M.Height - MI.Height
+ x_window$Change(M.White_W,
+ Max_Width + vWExtra_Width,
+ M.Height - vTop_Offset + vWExtra_Height)
+ x_window$Change(M.Window,
+ Max_Width + vExtra_Width,
+ M.Height - vTop_Offset + vExtra_Height)
+ M.Max_Width := Max_Width
+ for TMI: menu_item in mis$Elements(M.Items) do
+ menu_item$Setup(TMI, M.Window, vLeft_Offset, M.Max_Width)
+ end
+ menu_item$Reset(MI)
+ end Remove
+
+ Item_Changed = proc (M: cvt, MI: menu_item) signals (not_found)
+ Max_Width: int := 0
+ for Tst_MI: menu_item in mis$Elements(M.Items) do
+ Max_Width := int$Max(Max_Width, Tst_MI.Width)
+ end
+ if (Max_Width ~= M.Max_Width)
+ then M.Max_Width := Max_Width
+ x_window$Change(M.White_W,
+ Max_Width + vWExtra_Width,
+ M.Height - vTop_Offset + vWExtra_Height)
+ x_window$Change(M.Window,
+ Max_Width + vExtra_Width,
+ M.Height - vTop_Offset + vExtra_Height)
+ for TMI: menu_item in mis$Elements(M.Items) do
+ menu_item$Setup(TMI, M.Window, vLeft_Offset, M.Max_Width)
+ end
+ end
+ end Item_Changed
+
+ Get_Num_Items = proc (M: cvt) returns (int)
+ return (mis$Size(M.Items))
+ end Get_Num_Items
+
+ Get_Max_Width = proc (M: cvt) returns (int)
+ return (M.Max_Width)
+ end Get_Max_Width
+
+ All_Items = iter (M: cvt) yields (menu_item)
+ for MI: menu_item in mis$Elements(M.Items) do
+ yield(MI)
+ end
+ end All_Items
+
+ Get_Window = proc (M: cvt) returns (x_window)
+ return (M.Window)
+ end Get_Window
+
+ Select = proc (M: cvt, X: int, Y: int)
+ x_window$Move(M.White_W, X-1, Y)
+ x_window$Map(M.White_W)
+ %% Lower left highlight
+ x_window$Pix_Set(M.Window, M.MB.BackPix,
+ 0,
+ M.Height - vTop_Offset + vExtra_Height - vHighLight_Height,
+ vHighLight_Height, vHighLight_Width)
+ %% Upper right highlight
+ x_window$Pix_Set(M.Window, M.MB.BackPix,
+ M.Max_Width + vExtra_Width - vHighLight_Height,
+ 0,
+ vHighLight_Height, vHighLight_Width)
+ for MI: menu_item in mis$Elements(M.Items) do
+ menu_item$Display(MI, M.Max_Width)
+ end;
+ end Select
+
+ DeSelect = proc (M: cvt)
+ x_window$UnMap(M.White_W)
+ end DeSelect
+
+ end menu
+
+menu_item = cluster is
+ create, empty, equal,
+ set_enabled, get_enabled,
+ set_selectable, get_selectable,
+ set_text, get_text,
+ set_checked, get_checked,
+ get_width, get_height,
+ set_start, get_start,
+ setup, reset,
+ display,
+ invert,
+ match
+
+
+ mw = oneof[one: x_window, none: null]
+ mf = oneof[one: x_font, none: null]
+
+ rep = record[
+ Checked: bool,
+ Enabled: bool,
+ Font: mf,
+ MB: menu_bar,
+ Chk_Width: int,
+ Left_Fill: int,
+ Height: int,
+ Selectable: bool,
+ Start: int,
+ Text: string,
+ Width: int,
+ Window: mw
+ ]
+
+ vCheck_String = "* "
+
+ Create = proc (MB: menu_bar, Text: string, Font: x_font) returns (cvt)
+ signals (error(string))
+ Avg_Width: int,
+ Height: int,
+ Ch1: char,
+ ChLast: char,
+ BaseLine: int,
+ FixedWidth: bool := x_font$Query(Font)
+ resignal Error
+ Width: int := x_font$Width(Font, Text) +
+ x_font$Width(Font, vCheck_String) +
+ (vLeft_Space + vRight_Space) * Avg_Width
+ return (rep${ Checked: false,
+ Enabled: true,
+ Font: mf$Make_One(Font),
+ MB: MB,
+ Chk_Width: x_font$Width(Font, vCheck_String),
+ Left_Fill: (vLeft_Space * Avg_Width),
+ Height: Height + vTop_Space + vBottom_Space,
+ Selectable: true,
+ Start: 0,
+ Text: Text,
+ Width: Width,
+ Window: mw$Make_None(nil) })
+ end Create
+
+ Empty = proc (MB: menu_bar) returns (cvt)
+ vEmpty_Height = 10
+ return (rep${ Checked: false,
+ Enabled: false,
+ Font: mf$Make_None(nil),
+ MB: MB,
+ Chk_Width: 0,
+ Left_Fill: 0,
+ Height: vEmpty_Height,
+ Selectable: false,
+ Start: 0,
+ Text: "",
+ Width: 0,
+ Window: mw$Make_None(nil) })
+ end Empty
+
+ Equal = proc (MI1: cvt, MI2: cvt) returns (bool)
+ return (MI1 = MI2)
+ end Equal
+
+ Set_Enabled = proc (MI: cvt, E: bool)
+ MI.Enabled := E
+ end Set_Enabled
+
+ Get_Enabled = proc (MI: cvt) returns (bool)
+ return (MI.Enabled)
+ end Get_Enabled
+
+ Set_Checked = proc (MI: cvt, C: bool)
+ MI.Checked := C
+ end Set_Checked
+
+ Get_Checked = proc (MI: cvt) returns (bool)
+ return (MI.Checked)
+ end Get_Checked
+
+ Set_Selectable = proc (MI: cvt, S: bool)
+ MI.Selectable := S
+ end Set_Selectable
+
+ Get_Selectable = proc (MI: cvt) returns (bool)
+ return (MI.Selectable)
+ end Get_Selectable
+
+ Set_Text = proc (MI: cvt, Text: string) signals (is_empty)
+ Font: x_font := mf$Value_One(MI.Font)
+ except when Wrong_Tag:
+ signal Is_Empty
+ end
+ MI.Text := Text
+ Avg_Width: int,
+ Height: int,
+ Ch1: char,
+ ChLast: char,
+ BaseLine: int,
+ FixedWidth: bool := x_font$Query(Font)
+ MI.Width := x_font$Width(Font, Text) +
+ x_font$Width(Font, vCheck_String) +
+ (vLeft_Space + vRight_Space) * Avg_Width
+ end Set_Text
+
+ Get_Text = proc (MI: cvt) returns (string)
+ return (MI.Text)
+ end Get_Text
+
+ Get_Width = proc (MI: cvt) returns (int)
+ return (MI.Width)
+ end Get_Width
+
+ Get_Height = proc (MI: cvt) returns (int)
+ return (MI.Height)
+ end Get_Height
+
+ Get_Start = proc (MI: cvt) returns (int)
+ return (MI.Start)
+ end Get_Start
+
+ Set_Start = proc (MI: cvt, Start: int)
+ MI.Start := Start
+ end Set_Start
+
+ Setup = proc (MI: cvt, Menu_W: x_window, Left_Start: int, Full_Width: int)
+ W: x_window := mw$Value_One(MI.Window)
+ except when Wrong_Tag:
+ W := x_window$Create(
+ Left_Start, MI.Start,
+ Full_Width, MI.Height,
+ MI.MB.Back,
+ Menu_W,
+ 0,
+ MI.MB.Fore)
+ W.Input := buttonReleased +
+ enterWindow +
+ leaveWindow
+ W.Cursor := MI.MB.Cursor
+ x_window$Map(W)
+ MI.Window := mw$Make_One(W)
+ return
+ end
+ x_window$Change(W, Full_Width, MI.Height)
+ x_window$Move(W, Left_Start, MI.Start)
+ end Setup
+
+ Display = proc (MI: cvt, Full_Width: int)
+ W: x_window := mw$Value_One(MI.Window)
+ if (MI.Selectable)
+ then if (MI.Checked)
+ then x_window$Text(W,
+ vCheck_String, mf$Value_One(MI.Font),
+ MI.MB.ForePix, MI.MB.BackPix,
+ MI.Left_Fill, vTop_Space)
+ end
+ x_window$Text(W,
+ MI.Text, mf$Value_One(MI.Font),
+ MI.MB.ForePix, MI.MB.BackPix,
+ (MI.Left_Fill + MI.Chk_Width), vTop_Space)
+ if (~ MI.Enabled)
+ then % x_window$Tile_Set(W, x_display$Gray(),
+ % 0, vTop_Space,
+ % Full_Width,
+ % MI.Height)
+ end
+ end
+ except when Wrong_Tag: %% No Font.
+ end
+ end Display
+
+ Reset = proc (MI: cvt)
+ x_window$Destroy(mw$Value_One(MI.Window))
+ except when Wrong_Tag:
+ return
+ end
+ MI.Window := mw$Make_None(nil)
+ end Reset
+
+ Invert = proc (MI: cvt, Full_Width: int)
+ x_window$Pix_Fill(mw$Value_One(MI.Window), 0, x_bitmap$None(), 0, 0,
+ Full_Width, MI.Height, GXinvert, MI.MB.Plane)
+ except when Wrong_Tag:
+ end
+ end Invert
+
+ Match = proc (MI: cvt, W: x_window) returns (bool)
+ return (mw$Value_One(MI.Window) = W)
+ except when Wrong_Tag:
+ return (false)
+ end
+ end Match
+
+ end menu_item
\ No newline at end of file
projects / unix-history / commitdiff