%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % BtolPopup.ps v1.0 % % Date: January 17, 1990 % Authors: % % David G. Zawada % EAIS-VIS % Argonne National Laboratory % zawada@athens.ees.anl.gov % % David C. Mak % EAIS-VIS % Argonne National Laboratory % mak@athens.ees.anl.gov % % PopupItem.ps is the class definition for a new type % of cycle item. Given a list of items, a PopupItem % allows for the selection of one of the items in the % list through a popup menu that it displays when it % is clicked on. The function of a PopupItem is best % described by an example, so here's one... % % /win framebuffer /new DefaultWindow send def % { % 20 dup 500 350 reshape % % /items % [ % [ % (Popup Items) (by) (Dave Zawada) % (and) (Dave Mak) (Argonne National Laboratory) % ] % {} ClientCanvas 0 0 /new BtolPopup send % { % /ItemLabelFont /Times-Roman findfont 32 scalefont def % /ItemFont /Helvetica findfont 32 scalefont def % 20 270 move % move to specific location; let PopupItem handle scaling % 0 sethue % } 1 index send % % [ (Option1) (Option2) (Option3) (Option4) (Option5) ] % {} ClientCanvas 0 0 /new BtolPopup send % { % /ItemLabelFont /Times-Roman findfont 18 scalefont def % /ItemFont /Times-Roman findfont 14 scalefont def % 20 190 150 0 reshape % scale and move yourself if desired % 0.3 sethue % } 1 index send % % [ % (Btol version 1.3) (coming) (SOON!!!) % (watch news-makers) % ] {} ClientCanvas 0 0 /new BtolPopup send % 20 150 /move 3 index send % true /setcycleon 2 index send % ] def % % /PaintClient { 0.7 0.7 0.7 rgbcolor fillcanvas items paintitems } def % % items forkitems pop % totop % map % } win send % END OF EXAMPLE % % By the way, a new version of our BTOL toolkit is in the works and % will include Popup items, DualScrollBars, FieldItems, as well as % terminal emulators, and a drawing package. Look for it soon on % news-makers!!! % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% systemdict begin currentdict /Item known not { version (1.1) eq %For X/NeWS compatibility { ($NEWSHOME/lib/NeWS/liteitem.ps) run } { ($OPENWINHOME/etc/NeWS/liteitem.ps) run } ifelse } if /BtolPopup Item dictbegin /Hue 0 def % The default color scheme /ShadowColor 0.1 0.1 0.1 rgbcolor def /HiLiteColor 0.9 0.9 0.9 rgbcolor def /FaceColor 0.7 0.7 0.7 rgbcolor def /ItemX 0 def % Location of the item /ItemY 0 def /PopCan null def % Pop down menu's canvas /PopCanHeight 0 def /PopCanWidth 0 def /ItemLabelFont /Helvetica-Bold findfont 14 scalefont def /EntryHeight 0 def %need because Label and List may use different fonts /EntryWidth 0 def %need because Label and List may use different fonts /EntryList [] def % List of items to be displayed by Popup /EntryGap 5 def /NumEntries 0 def /CycleOn? false def % If true, clicking and releasing on the % item will cause cycling through the list % See the example program above dictend classbegin /new % [] notify parent w h => instance { /new super send begin /NotifyUser exch def /EntryList exch def /NumEntries EntryList length def /ItemValue 0 def /ItemFont /Helvetica findfont 14 scalefont def /ItemFillColor FaceColor def /ItemFrame 2 def /PopCan ItemParent newcanvas dup begin /Transparent false def /SaveBehind true def end def currentdict end } def /setcycleon % boolean => - { /CycleOn? exch def } def /move % x y - => - { /ItemY exch def /ItemX exch def ItemX ItemY /move super send } def /reshape % x y w h => - { /ItemHeight exch def /ItemWidth exch def /ItemY exch def /ItemX exch def EntryList { ItemFont ThingSize /EntryHeight exch EntryHeight max def /EntryWidth exch ItemFrame 2 mul add EntryWidth max def } forall EntryList { ItemLabelFont ThingSize /ItemHeight exch ItemHeight max def /ItemWidth exch ItemFrame 2 mul add ItemWidth max def } forall /EntryHeight EntryHeight ItemFrame 2 mul add def /EntryWidth EntryWidth ItemFrame 2 mul add ItemWidth max def /PopCanHeight EntryHeight EntryGap add EntryList length mul EntryGap add def /PopCanWidth EntryWidth EntryGap 2 mul add ItemFrame dup add add def /ItemHeight ItemHeight EntryHeight ItemFrame dup add add max def /ItemWidth ItemWidth PopCanWidth max def /PopCanWidth ItemWidth def gsave % reshape the Pop down menu ItemParent setcanvas 0 0 PopCanWidth PopCanHeight rectpath PopCan reshapecanvas PopCan setcanvas ItemX ItemY PopCanHeight sub movecanvas grestore ItemX ItemY ItemWidth ItemHeight /reshape super send % reshape the item } def /resetcolors % => - { /ShadowColor .1 .1 .1 rgbcolor store /HiLiteColor .9 .9 .9 rgbcolor store /FaceColor .7 .7 .7 rgbcolor store /ItemFillColor .5 .5 .5 rgbcolor store } def /sethue % hue => - { /Hue exch def /ShadowColor Hue 1 0.45 hsbcolor def /HiLiteColor Hue 0.3 1 hsbcolor def /FaceColor Hue 0.4 .9 hsbcolor def /ItemFillColor Hue 1 0.7 hsbcolor def } def /incvalue % - => - { /ItemValue ItemValue 1 add NumEntries mod def paint } def /ClientEnter { } def /ClientExit { } def /ClientUp % - => - { gsave PopCan setcanvas CurrentEvent begin YLocation cvi XLocation cvi end 1 index gsave clippath pathbbox points2rect rectpath pointinpath grestore { YtoValue /ItemValue exch def paint } { pop gsave ItemCanvas setcanvas currentcursorlocation clippath pathbbox points2rect rectpath pointinpath CycleOn? and { incvalue } if grestore } ifelse grestore PopCan /Mapped false put } def /ClientDown % - => - { PopCan canvastotop PopCan /Mapped true put PaintPopCan /ItemPaintedValue null def } def /ClientDrag % - => - { gsave PopCan setcanvas CurrentEvent begin YLocation cvi XLocation cvi end 1 index gsave clippath pathbbox points2rect rectpath pointinpath grestore { YtoValue dup ItemPaintedValue ne { ItemPaintedValue null ne { ItemPaintedValue DeHiLiteItem } if dup HiLiteItem /ItemPaintedValue exch def } if } { pop ItemPaintedValue null ne { ItemPaintedValue DeHiLiteItem } if /ItemPaintedValue null def } ifelse grestore } def /PaintItem % - => - Paint the item { FaceColor setcolor newpath 0 0 ItemWidth ItemHeight rectpath fill HiLiteColor setcolor newpath 0 0 moveto ItemFrame dup rlineto 0 ItemHeight ItemFrame 2 mul sub rlineto ItemWidth ItemFrame 2 mul sub 0 rlineto ItemFrame dup rlineto ItemWidth neg 0 rlineto fill ShadowColor setcolor newpath 0 0 moveto ItemFrame dup rlineto ItemWidth ItemFrame 2 mul sub 0 rlineto 0 ItemHeight ItemFrame 2 mul sub rlineto ItemFrame dup rlineto 0 ItemHeight neg rlineto fill ShadowColor ItemLabelFont setfont setcolor EntryList ItemValue get 100 string cvs ItemWidth ItemFrame dup add sub 2 div currentfont fontdescent ItemFrame 4 mul max moveto cshow } def /PaintPopCan % - => - Paint the Pop down menu { PopCan setcanvas FaceColor fillcanvas ShadowColor strokecanvas HiLiteColor setcolor 0 0 moveto 0 PopCanHeight rlineto PopCanWidth 0 rlineto stroke ShadowColor setcolor ItemFont setfont 0 1 NumEntries 1 sub { dup EntryList exch get EntryGap ItemFrame add 3 -1 roll 1 add dup EntryGap mul exch EntryHeight mul add PopCanHeight exch sub currentfont fontdescent ItemFrame 2 mul max add moveto show } for } def /DeHiLiteItem % value => - { gsave FaceColor setcolor EntryGap % x 1 index 1 add dup EntryGap mul exch EntryHeight mul add PopCanHeight exch sub % y translate 0 EntryGap -2 div EntryWidth EntryHeight EntryGap 2 div add rectpath gsave stroke grestore fill ShadowColor setcolor ItemFont setfont ItemFrame currentfont fontdescent ItemFrame 2 mul max moveto EntryList exch get show grestore } def /HiLiteItem % value => - { gsave EntryGap % x 1 index 1 add dup EntryGap mul exch EntryHeight mul add PopCanHeight exch sub % y translate FaceColor setcolor 0 EntryGap -2 div EntryWidth EntryHeight EntryGap 2 div add rectpath fill ShadowColor setcolor 0 EntryGap -2 div moveto 0 EntryHeight EntryGap 2 div add rlineto EntryWidth 0 rlineto stroke HiLiteColor setcolor 0 EntryGap -2 div moveto EntryWidth 0 rlineto 0 EntryHeight EntryGap 2 div add rlineto stroke ShadowColor setcolor 1 -1 translate ItemFont setfont ItemFrame currentfont fontdescent ItemFrame 2 mul max moveto EntryList exch get show grestore } def %%%%%%%%%%%%%%%%%%%%% % Geometric Utilities %%%%%%%%%%%%%%%%%%%%% /YtoValue % y => value { EntryHeight EntryGap add idiv NumEntries 1 sub exch sub 0 max } def classend def end