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