!Cette classe est la classe qui donne la fonctionnalite de la selection dans le menu; % Little width problem if a line is too long. Corrected. % Charles De Lean 19 Juillet 1995 listWindow CLASS PopupListWindow; BEGIN INTEGER PROCEDURE text_left; text_left:=0; INTEGER PROCEDURE text_border; text_border:=0; !selection is made un button_up; PROCEDURE handle_button_up(b); INTEGER b; BEGIN Line_last := min(info_top, Line_of(y_of_event)); parent.LineChoiceIn(Lines.get(Line_last),Line_last,this SubWindow); END; !Getting out of this window is the same as getting out of its parent (popupmenu); PROCEDURE handle_leave_window; parent.handle_leave_window; AllowChoice; setcursor("arrow"); END; popupwindow CLASS popupmenu(NoticeWindow);REF(XWindow) NoticeWindow; VIRTUAL: PROCEDURE CreateSelMenu IS PROCEDURE CreateSelMenu;; BEGIN REF(PopupListWindow) list_wnd; !Veritable fenetre de menu; INTEGER nblines; !nombre d items; !resize the subwindow and place it to be sure the whole areal is selectable; PROCEDURE handle_configure; IF list_wnd =/= NONE THEN list_wnd.SetSize(width,height+ list_wnd.font_height-list_wnd.font_ascent); !Finding position as if the window was a child window of NoticeWindow (a sort of PlaceAt); PROCEDURE FindPosition(XNotice,YNotice);INTEGER XNotice,YNotice; BEGIN INTEGER posx,posy,x,y,p_width,p_height,p_border,p_depth; INTEGER rootID; external C procedure xgetgeometry is Boolean procedure XGetGeometry( WindowID, rootID, x, y, width, height, borderwidth, depth); name rootID, x, y, width, height, borderwidth, depth; integer WindowID, rootID, x, y, width, height, borderwidth, depth;; external C procedure xrootwindow is integer procedure XRootWindow;; NoticeWindow.FindAbsolutePos(posx,posy); posx:=posx-NoticeWindow.borderwidth+XNotice; posy:=posy-NoticeWindow.borderwidth+YNotice; GetActualGeometry; !Verifier si la fenetre ne depasse pas l ecran; rootID := Xrootwindow; XGetGeometry(rootID,rootID,x,y,p_width,p_height,p_border,p_depth); posx:=Min(posx,p_width-width+2*(p_border-borderwidth)); posy:=Min(posy,p_height-height+2*(p_border-borderwidth)); PlaceAt(posx,posy); END; !Selection is reported; PROCEDURE LineChoiceIn(t,li,sw);TEXT t;INTEGER li;ref(SubWindow) sw; begin NoticeWindow.LineChoice(t); NoticeWindow.LineChoiceIn(t,li,NONE); end; !Getting out of the window means no selection; PROCEDURE handle_leave_window; begin NoticeWindow.LineChoice(NOTEXT); NoticeWindow.LineChoiceIn(NOTEXT,0,NONE); end; !Filling the window keeps track of width of lines; PROCEDURE PutLine(Line);TEXT Line; BEGIN INTEGER w; Line :- " "&Line&" "; !CDL 19 Jui 1995; % list_wnd.putline(" "&Line&" "); list_wnd.initputline(Line); w:= list_wnd.width_of_text(Line); IF w > width THEN SetWidth(w); NbLines:=NbLines+1; END; PROCEDURE SetDefault(idef);INTEGER idef; !Default choice. Must be called absolutely; BEGIN list_wnd.ScrollToLine(1); SetHeight(list_wnd.Font_Height*NbLines); FindPosition(0,-(idef-1)*list_wnd.Font_Height); list_wnd.handle_pointer_motion(1,(idef-1)*list_wnd.Font_Height +list_wnd.font_height-list_wnd.font_ascent+1); raise; END; PROCEDURE CreateSelMenu; BEGIN list_wnd :- NEW PopupListWindow(THIS XWindow); END; CreateSelMenu; list_wnd.SetBorderWidth(0); list_wnd.SetXFont(NoticeWindow.CurrentXFont); list_wnd.PlaceAt(0,-list_wnd.font_height+list_wnd.font_ascent); list_wnd.show; SetWidth(NoticeWindow.width+2*NoticeWindow.Borderwidth); FindPosition(0,0); SaveUnder; END; !This button gives the possibility of manipulating a menu. The heading is always the current choice; button CLASS MenuButton; BEGIN TEXT ARRAY Etiq(1:25),Cle(1:25); REF (PopupMenu) Menu; INTEGER iselect; !Initialization of Etiq, Cle and window width; PROCEDURE SetMenu(choix,default);TEXT choix,default; BEGIN text array CA (1:25); character C; integer i, Np, iDefault; Boolean OK; Text T; C := Choix.sub(1,1).getchar; Np := splitc(from(Choix,2), C, CA ); iDefault := 1; i := 0; for i := i+1 while i<=Np and then CA(i) =/= notext do BEGIN Cle (i) :- scanto(CA(i),':'); Etiq(i) :- rest(CA(i)); if Etiq(i) == notext then BEGIN TEXT tmp; Etiq(i) :- Cle(i); tmp :- copy(cle(i)); cle(i) :- lowcase(getWord(tmp)); END; if Cle(i) = Default then iDefault := i; SetWidth(Max(width,2*width_of_text(" ")+width_of_text(Etiq(i))+20)); END; SetHeading(" "&Etiq(iDefault)&" "); iselect:=iDefault; resize; show; refresh; IF menu =/= NONE THEN menu.destroy; Menu :- NEW PopupMenu("Popup",TopWindow,THIS XWindow); i:=0; FOR i:=i+1 WHILE Etiq(i) =/= NOTEXT DO Menu.PutLine(Etiq(i)); END; !If button is pressed, the menu is shown and the pointer is released from this window; PROCEDURE handle_button_down(b);INTEGER b; BEGIN EXTERNAL c PROCEDURE xungrabpointer IS PROCEDURE Xungrabpointer;; IF allowed THEN BEGIN Xungrabpointer; Menu.SetDefault(iselect); Menu.Show; END; END; !This button does not change with passage of pointer; PROCEDURE handle_enter_window;; PROCEDURE handle_leave_window;; !Text is LeftCentered ans a triangle is drawn on the right; PROCEDURE WriteLine; BEGIN INTEGER i,hw,wi,de; INTEGER ARRAY x(1:3),y(1:3); hw := height; wi:=width; de:=depthborder; DrawText(0,(height+font_ascent-font_descent)/2,heading_and_key); for i := 1 step 1 until de do begin DrawLine(wi-i, 0, wi-i, hw); DrawLine(0, hw-i , wi, hw-i); end; x(1):=wi-15-de; x(2):=wi-3-de; x(3):=wi-9-de; y(1):=hw/3; y(2):=y(1); y(3):=hw*2/3; FillPolyGon(x,y,3); END; !The height is the height of font. Not 4/3 it; PROCEDURE resize; BEGIN SetSize((max(width, width_of_text(heading_and_key))), max(height, head_height + font_height)); END; PROCEDURE LineChoiceIn(t,li,sw);TEXT t;INTEGER li;REF(SubWindow) sw; !Selection (including no selection) is reported to NoticeWindow; BEGIN TEXT tag,eti; IF t=/=NOTEXT THEN SetHeading(t); resize; IF li>0 THEN BEGIN iselect:=li; tag:-Cle(li); eti:-Etiq(li); END; parent.LineChoice(eti); parent.LineChoiceIn(eti,li,THIS SubWindow); parent.Perform(tag); parent.PerformIn(tag,THIS SubWindow); menu.hide; END; TEXT PROCEDURE CurrentChoice; CurrentChoice:- IF iselect>0 THEN Etiq(iselect) ELSE NOTEXT; SetDepthBorder(1); END;