|
Programming Guru
Join Date: Apr 2005
Location: Waterloo, Ontario
Posts: 1,869
Rep Power: 5 
|
Simple GUI Library (only the DropDown Menu, rest are in the original GUI library)
unit
module pervasive DropMenu
export AddGroup, AddItem, Make, Update, GetSelectionValue,
GetSelection, Trash, ChangeSelection, DrawBar,
~. * MAXITEMS, ~. * MAXMENUS
const MAXITEMS := 10
const MAXMENUS := 10
var main : array 1 .. MAXMENUS of
record
drop_menu : array 1 .. MAXITEMS of string
dropped, mouse_down : boolean
num_of_items, current_selection, highlight, NeedProcess, x, y,
width, bgcol, hgcol : int
end record
var font, mx, my, mb, menuI, last : int
font := Font.New ("Arial:12")
menuI := 0
procedure Trash
menuI := 0
end Trash
procedure pic1 (x, y : int)
drawdot (x + 0, y + 17, 30)
drawdot (x + 0, y + 16, 30)
drawdot (x + 0, y + 15, 30)
drawdot (x + 0, y + 14, 30)
drawdot (x + 0, y + 13, 30)
drawdot (x + 0, y + 12, 30)
drawdot (x + 0, y + 11, 30)
drawdot (x + 0, y + 10, 30)
drawdot (x + 0, y + 9, 30)
drawdot (x + 0, y + 8, 30)
drawdot (x + 0, y + 7, 30)
drawdot (x + 0, y + 6, 30)
drawdot (x + 0, y + 5, 30)
drawdot (x + 0, y + 4, 30)
drawdot (x + 0, y + 3, 30)
drawdot (x + 0, y + 2, 30)
drawdot (x + 0, y + 1, 30)
drawdot (x + 0, y + 0, 7)
drawdot (x + 1, y + 17, 30)
drawdot (x + 1, y + 16, 0)
drawdot (x + 1, y + 15, 0)
drawdot (x + 1, y + 14, 0)
drawdot (x + 1, y + 13, 0)
drawdot (x + 1, y + 12, 0)
drawdot (x + 1, y + 11, 0)
drawdot (x + 1, y + 10, 0)
drawdot (x + 1, y + 9, 0)
drawdot (x + 1, y + 8, 0)
drawdot (x + 1, y + 7, 0)
drawdot (x + 1, y + 6, 0)
drawdot (x + 1, y + 5, 0)
drawdot (x + 1, y + 4, 0)
drawdot (x + 1, y + 3, 0)
drawdot (x + 1, y + 2, 0)
drawdot (x + 1, y + 1, 15)
drawdot (x + 1, y + 0, 7)
drawdot (x + 2, y + 17, 30)
drawdot (x + 2, y + 16, 0)
drawdot (x + 2, y + 15, 8)
drawdot (x + 2, y + 14, 8)
drawdot (x + 2, y + 13, 8)
drawdot (x + 2, y + 12, 8)
drawdot (x + 2, y + 11, 8)
drawdot (x + 2, y + 10, 8)
drawdot (x + 2, y + 9, 8)
drawdot (x + 2, y + 8, 8)
drawdot (x + 2, y + 7, 8)
drawdot (x + 2, y + 6, 8)
drawdot (x + 2, y + 5, 8)
drawdot (x + 2, y + 4, 8)
drawdot (x + 2, y + 3, 8)
drawdot (x + 2, y + 2, 8)
drawdot (x + 2, y + 1, 15)
drawdot (x + 2, y + 0, 7)
drawdot (x + 3, y + 17, 30)
drawdot (x + 3, y + 16, 0)
drawdot (x + 3, y + 15, 8)
drawdot (x + 3, y + 14, 8)
drawdot (x + 3, y + 13, 8)
drawdot (x + 3, y + 12, 8)
drawdot (x + 3, y + 11, 8)
drawdot (x + 3, y + 10, 8)
drawdot (x + 3, y + 9, 8)
drawdot (x + 3, y + 8, 8)
drawdot (x + 3, y + 7, 8)
drawdot (x + 3, y + 6, 8)
drawdot (x + 3, y + 5, 8)
drawdot (x + 3, y + 4, 8)
drawdot (x + 3, y + 3, 8)
drawdot (x + 3, y + 2, 8)
drawdot (x + 3, y + 1, 15)
drawdot (x + 3, y + 0, 7)
drawdot (x + 4, y + 17, 30)
drawdot (x + 4, y + 16, 0)
drawdot (x + 4, y + 15, 8)
drawdot (x + 4, y + 14, 8)
drawdot (x + 4, y + 13, 8)
drawdot (x + 4, y + 12, 8)
drawdot (x + 4, y + 11, 8)
drawdot (x + 4, y + 10, 7)
drawdot (x + 4, y + 9, 8)
drawdot (x + 4, y + 8, 8)
drawdot (x + 4, y + 7, 8)
drawdot (x + 4, y + 6, 8)
drawdot (x + 4, y + 5, 8)
drawdot (x + 4, y + 4, 8)
drawdot (x + 4, y + 3, 8)
drawdot (x + 4, y + 2, 8)
drawdot (x + 4, y + 1, 15)
drawdot (x + 4, y + 0, 7)
drawdot (x + 5, y + 17, 30)
drawdot (x + 5, y + 16, 0)
drawdot (x + 5, y + 15, 8)
drawdot (x + 5, y + 14, 8)
drawdot (x + 5, y + 13, 8)
drawdot (x + 5, y + 12, 8)
drawdot (x + 5, y + 11, 8)
drawdot (x + 5, y + 10, 7)
drawdot (x + 5, y + 9, 7)
drawdot (x + 5, y + 8, 8)
drawdot (x + 5, y + 7, 8)
drawdot (x + 5, y + 6, 8)
drawdot (x + 5, y + 5, 8)
drawdot (x + 5, y + 4, 8)
drawdot (x + 5, y + 3, 8)
drawdot (x + 5, y + 2, 8)
drawdot (x + 5, y + 1, 15)
drawdot (x + 5, y + 0, 7)
drawdot (x + 6, y + 17, 30)
drawdot (x + 6, y + 16, 0)
drawdot (x + 6, y + 15, 8)
drawdot (x + 6, y + 14, 8)
drawdot (x + 6, y + 13, 8)
drawdot (x + 6, y + 12, 8)
drawdot (x + 6, y + 11, 8)
drawdot (x + 6, y + 10, 7)
drawdot (x + 6, y + 9, 7)
drawdot (x + 6, y + 8, 7)
drawdot (x + 6, y + 7, 8)
drawdot (x + 6, y + 6, 8)
drawdot (x + 6, y + 5, 8)
drawdot (x + 6, y + 4, 8)
drawdot (x + 6, y + 3, 8)
drawdot (x + 6, y + 2, 8)
drawdot (x + 6, y + 1, 15)
drawdot (x + 6, y + 0, 7)
drawdot (x + 7, y + 17, 30)
drawdot (x + 7, y + 16, 0)
drawdot (x + 7, y + 15, 8)
drawdot (x + 7, y + 14, 8)
drawdot (x + 7, y + 13, 8)
drawdot (x + 7, y + 12, 8)
drawdot (x + 7, y + 11, 8)
drawdot (x + 7, y + 10, 7)
drawdot (x + 7, y + 9, 7)
drawdot (x + 7, y + 8, 7)
drawdot (x + 7, y + 7, 7)
drawdot (x + 7, y + 6, 8)
drawdot (x + 7, y + 5, 8)
drawdot (x + 7, y + 4, 8)
drawdot (x + 7, y + 3, 8)
drawdot (x + 7, y + 2, 8)
drawdot (x + 7, y + 1, 15)
drawdot (x + 7, y + 0, 7)
drawdot (x + 8, y + 17, 30)
drawdot (x + 8, y + 16, 0)
drawdot (x + 8, y + 15, 8)
drawdot (x + 8, y + 14, 8)
drawdot (x + 8, y + 13, 8)
drawdot (x + 8, y + 12, 8)
drawdot (x + 8, y + 11, 8)
drawdot (x + 8, y + 10, 7)
drawdot (x + 8, y + 9, 7)
drawdot (x + 8, y + 8, 7)
drawdot (x + 8, y + 7, 8)
drawdot (x + 8, y + 6, 8)
drawdot (x + 8, y + 5, 8)
drawdot (x + 8, y + 4, 8)
drawdot (x + 8, y + 3, 8)
drawdot (x + 8, y + 2, 8)
drawdot (x + 8, y + 1, 15)
drawdot (x + 8, y + 0, 7)
drawdot (x + 9, y + 17, 30)
drawdot (x + 9, y + 16, 0)
drawdot (x + 9, y + 15, 8)
drawdot (x + 9, y + 14, 8)
drawdot (x + 9, y + 13, 8)
drawdot (x + 9, y + 12, 8)
drawdot (x + 9, y + 11, 8)
drawdot (x + 9, y + 10, 7)
drawdot (x + 9, y + 9, 7)
drawdot (x + 9, y + 8, 8)
drawdot (x + 9, y + 7, 8)
drawdot (x + 9, y + 6, 8)
drawdot (x + 9, y + 5, 8)
drawdot (x + 9, y + 4, 8)
drawdot (x + 9, y + 3, 8)
drawdot (x + 9, y + 2, 8)
drawdot (x + 9, y + 1, 15)
drawdot (x + 9, y + 0, 7)
drawdot (x + 10, y + 17, 30)
drawdot (x + 10, y + 16, 0)
drawdot (x + 10, y + 15, 8)
drawdot (x + 10, y + 14, 8)
drawdot (x + 10, y + 13, 8)
drawdot (x + 10, y + 12, 8)
drawdot (x + 10, y + 11, 8)
drawdot (x + 10, y + 10, 7)
drawdot (x + 10, y + 9, 8)
drawdot (x + 10, y + 8, 8)
drawdot (x + 10, y + 7, 8)
drawdot (x + 10, y + 6, 8)
drawdot (x + 10, y + 5, 8)
drawdot (x + 10, y + 4, 8)
drawdot (x + 10, y + 3, 8)
drawdot (x + 10, y + 2, 8)
drawdot (x + 10, y + 1, 15)
drawdot (x + 10, y + 0, 7)
drawdot (x + 11, y + 17, 30)
drawdot (x + 11, y + 16, 0)
drawdot (x + 11, y + 15, 8)
drawdot (x + 11, y + 14, 8)
drawdot (x + 11, y + 13, 8)
drawdot (x + 11, y + 12, 8)
drawdot (x + 11, y + 11, 8)
drawdot (x + 11, y + 10, 8)
drawdot (x + 11, y + 9, 8)
drawdot (x + 11, y + 8, 8)
drawdot (x + 11, y + 7, 8)
drawdot (x + 11, y + 6, 8)
drawdot (x + 11, y + 5, 8)
drawdot (x + 11, y + 4, 8)
drawdot (x + 11, y + 3, 8)
drawdot (x + 11, y + 2, 8)
drawdot (x + 11, y + 1, 15)
drawdot (x + 11, y + 0, 7)
drawdot (x + 12, y + 17, 30)
drawdot (x + 12, y + 16, 0)
drawdot (x + 12, y + 15, 8)
drawdot (x + 12, y + 14, 8)
drawdot (x + 12, y + 13, 8)
drawdot (x + 12, y + 12, 8)
drawdot (x + 12, y + 11, 8)
drawdot (x + 12, y + 10, 8)
drawdot (x + 12, y + 9, 8)
drawdot (x + 12, y + 8, 8)
drawdot (x + 12, y + 7, 8)
drawdot (x + 12, y + 6, 8)
drawdot (x + 12, y + 5, 8)
drawdot (x + 12, y + 4, 8)
drawdot (x + 12, y + 3, 8)
drawdot (x + 12, y + 2, 8)
drawdot (x + 12, y + 1, 15)
drawdot (x + 12, y + 0, 7)
drawdot (x + 13, y + 17, 30)
drawdot (x + 13, y + 16, 0)
drawdot (x + 13, y + 15, 8)
drawdot (x + 13, y + 14, 8)
drawdot (x + 13, y + 13, 8)
drawdot (x + 13, y + 12, 8)
drawdot (x + 13, y + 11, 8)
drawdot (x + 13, y + 10, 8)
drawdot (x + 13, y + 9, 8)
drawdot (x + 13, y + 8, 8)
drawdot (x + 13, y + 7, 8)
drawdot (x + 13, y + 6, 8)
drawdot (x + 13, y + 5, 8)
drawdot (x + 13, y + 4, 8)
drawdot (x + 13, y + 3, 8)
drawdot (x + 13, y + 2, 8)
drawdot (x + 13, y + 1, 15)
drawdot (x + 13, y + 0, 7)
drawdot (x + 14, y + 17, 30)
drawdot (x + 14, y + 16, 15)
drawdot (x + 14, y + 15, 15)
drawdot (x + 14, y + 14, 15)
drawdot (x + 14, y + 13, 15)
drawdot (x + 14, y + 12, 15)
drawdot (x + 14, y + 11, 15)
drawdot (x + 14, y + 10, 15)
drawdot (x + 14, y + 9, 15)
drawdot (x + 14, y + 8, 15)
drawdot (x + 14, y + 7, 15)
drawdot (x + 14, y + 6, 15)
drawdot (x + 14, y + 5, 15)
drawdot (x + 14, y + 4, 15)
drawdot (x + 14, y + 3, 15)
drawdot (x + 14, y + 2, 15)
drawdot (x + 14, y + 1, 15)
drawdot (x + 14, y + 0, 7)
drawdot (x + 15, y + 17, 7)
drawdot (x + 15, y + 16, 7)
drawdot (x + 15, y + 15, 7)
drawdot (x + 15, y + 14, 7)
drawdot (x + 15, y + 13, 7)
drawdot (x + 15, y + 12, 7)
drawdot (x + 15, y + 11, 7)
drawdot (x + 15, y + 10, 7)
drawdot (x + 15, y + 9, 7)
drawdot (x + 15, y + 8, 7)
drawdot (x + 15, y + 7, 7)
drawdot (x + 15, y + 6, 7)
drawdot (x + 15, y + 5, 7)
drawdot (x + 15, y + 4, 7)
drawdot (x + 15, y + 3, 7)
drawdot (x + 15, y + 2, 7)
drawdot (x + 15, y + 1, 7)
drawdot (x + 15, y + 0, 7)
drawdot (x + 16, y + 17, 30)
drawdot (x + 16, y + 16, 30)
drawdot (x + 16, y + 15, 30)
drawdot (x + 16, y + 14, 30)
drawdot (x + 16, y + 13, 30)
drawdot (x + 16, y + 12, 30)
drawdot (x + 16, y + 11, 30)
drawdot (x + 16, y + 10, 30)
drawdot (x + 16, y + 9, 30)
drawdot (x + 16, y + 8, 30)
drawdot (x + 16, y + 7, 30)
drawdot (x + 16, y + 6, 30)
drawdot (x + 16, y + 5, 30)
drawdot (x + 16, y + 4, 30)
drawdot (x + 16, y + 3, 30)
drawdot (x + 16, y + 2, 30)
drawdot (x + 16, y + 1, 30)
drawdot (x + 16, y + 0, 30)
end pic1
procedure pic2 (x, y : int)
drawdot (x + 0, y + 20, 7)
drawdot (x + 0, y + 19, 15)
drawdot (x + 0, y + 18, 15)
drawdot (x + 0, y + 17, 15)
drawdot (x + 0, y + 16, 15)
drawdot (x + 0, y + 15, 15)
drawdot (x + 0, y + 14, 15)
drawdot (x + 0, y + 13, 15)
drawdot (x + 0, y + 12, 15)
drawdot (x + 0, y + 11, 15)
drawdot (x + 0, y + 10, 15)
drawdot (x + 0, y + 9, 15)
drawdot (x + 0, y + 8, 15)
drawdot (x + 0, y + 7, 15)
drawdot (x + 0, y + 6, 15)
drawdot (x + 0, y + 5, 15)
drawdot (x + 0, y + 4, 15)
drawdot (x + 0, y + 3, 15)
drawdot (x + 0, y + 2, 15)
drawdot (x + 0, y + 1, 15)
drawdot (x + 0, y + 0, 15)
drawdot (x + 1, y + 20, 7)
drawdot (x + 1, y + 19, 7)
drawdot (x + 1, y + 18, 7)
drawdot (x + 1, y + 17, 7)
drawdot (x + 1, y + 16, 7)
drawdot (x + 1, y + 15, 7)
drawdot (x + 1, y + 14, 7)
drawdot (x + 1, y + 13, 7)
drawdot (x + 1, y + 12, 7)
drawdot (x + 1, y + 11, 7)
drawdot (x + 1, y + 10, 7)
drawdot (x + 1, y + 9, 7)
drawdot (x + 1, y + 8, 7)
drawdot (x + 1, y + 7, 7)
drawdot (x + 1, y + 6, 7)
drawdot (x + 1, y + 5, 7)
drawdot (x + 1, y + 4, 7)
drawdot (x + 1, y + 3, 7)
drawdot (x + 1, y + 2, 7)
drawdot (x + 1, y + 1, 7)
drawdot (x + 1, y + 0, 30)
end pic2
procedure pic3 (x, y : int)
drawdot (x + 0, y + 20, 15)
drawdot (x + 0, y + 19, 7)
drawdot (x + 0, y + 18, 0)
drawdot (x + 0, y + 17, 0)
drawdot (x + 0, y + 16, 0)
drawdot (x + 0, y + 15, 0)
drawdot (x + 0, y + 14, 0)
drawdot (x + 0, y + 13, 0)
drawdot (x + 0, y + 12, 0)
drawdot (x + 0, y + 11, 0)
drawdot (x + 0, y + 10, 0)
drawdot (x + 0, y + 9, 0)
drawdot (x + 0, y + 8, 0)
drawdot (x + 0, y + 7, 0)
drawdot (x + 0, y + 6, 0)
drawdot (x + 0, y + 5, 0)
drawdot (x + 0, y + 4, 0)
drawdot (x + 0, y + 3, 0)
drawdot (x + 0, y + 2, 0)
drawdot (x + 0, y + 1, 0)
drawdot (x + 0, y + 0, 30)
end pic3
procedure pic4 (x, y : int)
drawdot (x + 0, y + 20, 8)
drawdot (x + 0, y + 19, 8)
drawdot (x + 0, y + 18, 8)
drawdot (x + 0, y + 17, 8)
drawdot (x + 0, y + 16, 8)
drawdot (x + 0, y + 15, 8)
drawdot (x + 0, y + 14, 8)
drawdot (x + 0, y + 13, 8)
drawdot (x + 0, y + 12, 8)
drawdot (x + 0, y + 11, 8)
drawdot (x + 0, y + 10, 8)
drawdot (x + 0, y + 9, 8)
drawdot (x + 0, y + 8, 8)
drawdot (x + 0, y + 7, 8)
drawdot (x + 0, y + 6, 8)
drawdot (x + 0, y + 5, 8)
drawdot (x + 0, y + 4, 8)
drawdot (x + 0, y + 3, 8)
drawdot (x + 0, y + 2, 8)
drawdot (x + 0, y + 1, 8)
drawdot (x + 0, y + 0, 8)
end pic4
procedure AddItem (i : int, text : string)
main (i).num_of_items += 1
main (i).drop_menu (main (i).num_of_items) := text
end AddItem
procedure AddGroup (i : int, l : string, split : string (1))
var list : string := l + split
last := 0
for m : 1 .. length (list)
if (list (m) = split) then
AddItem (i, list (last + 1 .. m - 1))
last := m
end if
end for
end AddGroup
procedure ChangeSelection (i, select : int)
main (i).current_selection := select
end ChangeSelection
function GetSelection (i : int) : int
result main (i).current_selection
end GetSelection
function GetSelectionValue (i : int) : string
result main (i).drop_menu (main (i).current_selection)
end GetSelectionValue
procedure draw_drop (i : int)
drawfillbox (main (i).x, main (i).y - 1, main (i).x +
main (i).width, main (i).y - (main (i).num_of_items * 20) - 1,
31)
drawbox (main (i).x, main (i).y - 1, main (i).x + main (i).width -
1, main (i).y - (main (i).num_of_items * 20) - 1, grey)
drawbox (main (i).x + 1, main (i).y, main (i).x + main (i).width,
main (i).y - (main (i).num_of_items * 20), 7)
drawfillbox (main (i).x + 2, main (i).y - (main (i).highlight * 20)
+ 1, main (i).x + main (i).width - 1, main (i).y
- (main (i).highlight * 20) + 19, main (i).hgcol)
for m : 1 .. main (i).num_of_items
if m = main (i).highlight then
Font.Draw (main (i).drop_menu (m), main (i).x + 6,
main (i).y - (m * 20) + 2, font, 0)
else
Font.Draw (main (i).drop_menu (m), main (i).x + 6,
main (i).y - (m * 20) + 2, font, 7)
end if
end for
end draw_drop
procedure DrawBar (i : int)
pic2 (main (i).x, main (i).y)
for m : main (i).x + 2 .. main (i).x + main (i).width - 1
pic3 (m, main (i).y)
end for
pic1 (main (i).x + main (i).width - 16, main (i).y + 1)
pic4 (main (i).x + main (i).width, main (i).y)
Font.Draw (main (i).drop_menu (main (i).current_selection),
main (i).x + 5, main (i).y + 1, font, 7)
end DrawBar
function Make (x2, y2, width2, bgcol2, hgcol2 : int) : int
menuI += 1
assert menuI <= MAXMENUS
main (menuI).x := x2
main (menuI).y := y2
main (menuI).width := width2
main (menuI).bgcol := bgcol2
main (menuI).hgcol := hgcol2
main (menuI).NeedProcess := 0
main (menuI).dropped := false
main (menuI).mouse_down := false
main (menuI).num_of_items := 0
main (menuI).current_selection := 1
result menuI
end Make
procedure Process (i : int)
case main (i).NeedProcess of
label 1 :
draw_drop (i)
label 2 :
drawfillbox (main (i).x, main (i).y - 1, main (i).x +
main (i).width, main (i).y - (main (i).num_of_items *
20) - 1, main (i).bgcol)
label 3 :
draw_drop (i)
label 4 :
drawfillbox (main (i).x + 4, main (i).y + 1, main (i).x +
main (i).width - 17, main (i).y + 17, 0)
Font.Draw (main (i).drop_menu (main (i).current_selection),
main (i).x + 5, main (i).y + 1, font, 7)
drawfillbox (main (i).x, main (i).y - 1, main (i).x +
main (i).width, main (i).y - (main (i).num_of_items *
20) - 1, main (i).bgcol)
label :
end case
main (i).NeedProcess := 0
end Process
procedure Update (i : int)
Mouse.Where (mx, my, mb)
if mb = 0 and main (i).mouse_down = true then
main (i).mouse_down := false
if main (i).dropped then
main (i).NeedProcess := 2
main (i).dropped := false
if main (i).current_selection not= main (i).highlight then
main (i).NeedProcess := 4
main (i).current_selection := main (i).highlight
end if
end if
elsif mb = 1 and main (i).mouse_down = false then
main (i).mouse_down := true
if mx > main (i).x + main (i).width - 16 and my > main (i).y + 1
and mx < main (i).x + main (i).width and my < main (i).y
+
18 then
main (i).dropped := true
main (i).highlight := 1
main (i).NeedProcess := 1
end if
elsif main (i).dropped then
if my < main (i).y and my > main (i).y - (main (i).num_of_items
* 20) then
if (main (i).y - my) div 20 + 1 not= main (i).highlight then
main (i).NeedProcess := 3
main (i).highlight := (main (i).y - my) div 20 + 1
end if
end if
end if
if main (i).NeedProcess > 0 then
Process (i)
end if
end Update
end DropMenu
It works VERY well. I'm extremely happy with it.
example code:
import DropMenu %in "%oot/rough/DropMenu"
setscreen ("graphics:415;190")
setscreen ("noecho")
setscreen ("nocursor")
var menu1, menu2 : int
% x,y,width,bgcolor,highlight
menu1 := DropMenu.Make (5, 140, 200, 0, 2)
menu2 := DropMenu.Make (210, 140, 200, 0, 7)
DropMenu.AddGroup (menu1, "The Best Programmer is: &The Supreme Being is: &Will Die First --> &I <3 &This Program is > than ", "&")
DropMenu.DrawBar (menu1)
DropMenu.AddGroup (menu2, "Pedja#Aaron#Mr Reid#Zacc#Barnabas#Danny#Noob", "#")
DropMenu.DrawBar (menu2)
loop
locate (1, 1)
put DropMenu.GetSelectionValue (menu1),
DropMenu.GetSelectionValue (menu2),
" " : 30
DropMenu.Update (menu1)
DropMenu.Update (menu2)
end loop
DropMenu.Trash
|