Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * MENULIB.MOD - COMMS Toolkit menu support * 5 * * 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 IMPLEMENTATION MODULE MenuLib; 12 IMPORT IO,Lib,Window; 13 FROM Window IMPORT Color; ***** ^ duplicate identifier 14 15 CONST 16 MenuFrame = Window.FrameStr('Õ͸³³Ô;'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 17 MenuTemplate = Window.WinDef(0,0,0,0,White,Black,FALSE,FALSE,FALSE,TRUE,MenuFrame,LightGray,Black); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 18 19 TYPE 20 switch = (on,off); 21 FuncKeys = (NotRecognised,Escape,Cup,Cdown,Cleft,Cright,PageUp,PageDown,FKey1,AltKey); 22 23 VAR 24 gotcha : BOOLEAN; 25 FuncKeyTyped : FuncKeys; ***** ^ not supported yet 26 27 (*......................................*) 28 29 PROCEDURE SetColor(NewColor:SHORTCARD); 30 BEGIN 31 Window.TextColor(VAL(Window.Color,NewColor MOD 16)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 32 Window.TextBackground(VAL(Window.Color,NewColor DIV 16)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 33 END SetColor; ***** ^ not supported yet 34 35 (*.............................................*) 36 37 PROCEDURE Read(VAR c:CHAR); 38 BEGIN 39 FuncKeyTyped := NotRecognised; ***** ^ not supported yet ***** ^ not supported yet 40 c := IO.RdKey(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 41 IF (c=CHR(27)) OR (c=0C) THEN ***** ^ undeclared identifier ***** ^ not supported yet 42 IF c=0C THEN 43 c := IO.RdKey(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 CASE ORD(c) OF ***** ^ undeclared identifier ***** ^ not supported yet 45 72 : FuncKeyTyped:=Cup; | ***** ^ not supported yet ***** ^ not supported yet 46 80 : FuncKeyTyped:=Cdown; | ***** ^ not supported yet ***** ^ not supported yet 47 75 : FuncKeyTyped:=Cleft; | ***** ^ not supported yet ***** ^ not supported yet 48 77 : FuncKeyTyped:=Cright; | ***** ^ not supported yet ***** ^ not supported yet 49 73 : FuncKeyTyped:=PageUp; | ***** ^ not supported yet ***** ^ not supported yet 50 81 : FuncKeyTyped:=PageDown;| ***** ^ not supported yet ***** ^ not supported yet 51 59 : FuncKeyTyped:=FKey1; | ***** ^ not supported yet ***** ^ not supported yet 52 ELSE 53 FuncKeyTyped := AltKey; ***** ^ not supported yet ***** ^ not supported yet 54 END 55 ELSE 56 FuncKeyTyped := Escape ***** ^ not supported yet ***** ^ not supported yet 57 END; 58 END; 59 END Read; ***** ^ not supported yet 60 61 (*........................................*) 62 63 PROCEDURE DeAltify(VAR Ch:CHAR); 64 VAR 65 c : CARDINAL; 66 Numrow,Qrow,Arow, 67 Zrow : ARRAY[0..11] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 68 BEGIN 69 Numrow:='1234567890-='; ***** ^ not supported yet ***** ^ not supported yet 70 Qrow:='QWERTYUIOP'; ***** ^ not supported yet ***** ^ not supported yet 71 Arow:='ASDFGHJKL'; ***** ^ not supported yet ***** ^ not supported yet 72 Zrow:='ZXCVBNM'; ***** ^ not supported yet ***** ^ not supported yet 73 IF FuncKeyTyped=AltKey THEN ***** ^ not supported yet ***** ^ not supported yet 74 c := ORD(Ch); ***** ^ undeclared identifier ***** ^ not supported yet 75 IF (c>=120) AND (c<=131) THEN 76 Ch := Numrow[c-120] ***** ^ not supported yet ***** ^ not supported yet 77 ELSIF (c>=16) AND (c<=25) THEN 78 Ch := Qrow[c-16] ***** ^ not supported yet ***** ^ not supported yet 79 ELSIF (c>=30) AND (c<=38) THEN 80 Ch := Arow[c-30] ***** ^ not supported yet ***** ^ not supported yet 81 ELSIF (c>=44) AND (c<=50) THEN 82 Ch := Zrow[c-44] ***** ^ not supported yet ***** ^ not supported yet 83 END; 84 FuncKeyTyped := NotRecognised; ***** ^ not supported yet ***** ^ not supported yet 85 ELSE 86 Ch := CAP(Ch) ***** ^ undeclared identifier ***** ^ not supported yet 87 END; 88 END DeAltify; ***** ^ not supported yet 89 90 (*..................................................*) 91 92 PROCEDURE InitMenu(VAR menu:MenuRec;menutitle:ARRAY OF CHAR;MenuX,MenuY,menuwidth:CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 93 VAR 94 i,Lnth : CARDINAL; 95 BEGIN 96 menu.MenuX:=MenuX; ***** ^ not supported yet ***** ^ not supported yet 97 menu.MenuY:=MenuY; ***** ^ not supported yet ***** ^ not supported yet 98 WITH menu DO ***** ^ not supported yet 99 Lnth := Lib.ScanR(ADR(menutitle),HIGH(menutitle)+1,0C); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 100 IF Lnth>menuwidth THEN 101 Lnth:=menuwidth; 102 END; 103 Lib.Move(ADR(menutitle),ADR(Title),Lnth+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 104 Width:=menuwidth; ***** ^ undeclared identifier 105 Normal := SHORTCARD(MenuColors.NormFore)+SHORTCARD(MenuColors.NormBack)*16; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 106 Selected := SHORTCARD(MenuColors.SelFore)+SHORTCARD(MenuColors.SelBack)*16; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 107 Highlite := SHORTCARD(MenuColors.HighFore)+SHORTCARD(MenuColors.HighBack)*16; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 108 SHighlite := SHORTCARD(MenuColors.HSelFore)+SHORTCARD(MenuColors.HSelBack)*16; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 109 EscapeOK := FALSE; ***** ^ undeclared identifier 110 ExitOnChar := FALSE; ***** ^ undeclared identifier 111 HelpOK := FALSE; ***** ^ undeclared identifier 112 PageKeysOK := FALSE; ***** ^ undeclared identifier 113 ExitSideWays := FALSE; ***** ^ undeclared identifier 114 IF Width>30 THEN ***** ^ undeclared identifier 115 Width:=30; ***** ^ undeclared identifier 116 END; 117 Selection:=0; ***** ^ undeclared identifier 118 NumUsed:=0; ***** ^ undeclared identifier 119 winptr:=NIL; ***** ^ undeclared identifier 120 END; ***** ^ not supported yet 121 END InitMenu; ***** ^ not supported yet 122 123 (*......................................*) 124 125 PROCEDURE AddOption(VAR menu:MenuRec; menutext:ARRAY OF CHAR); ***** ^ undeclared identifier ***** ^ not supported yet 126 VAR 127 curlen : CARDINAL; 128 BEGIN 129 WITH menu DO ***** ^ not supported yet 130 IF NumUsed<=MaxOption THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 131 WITH Option[NumUsed] DO ***** ^ undeclared identifier ***** ^ undeclared identifier 132 curlen := Lib.ScanR(ADR(menutext),HIGH(menutext)+1,0C); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 133 IF curlen>Width THEN ***** ^ undeclared identifier 134 curlen:=Width; ***** ^ undeclared identifier 135 END; 136 Lib.Move(ADR(menutext),ADR(Name),curlen+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 137 Lib.Fill(ADR(Name[curlen]),Width-curlen,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 138 FirstNonSpace := Lib.ScanNeR(ADR(Name),Width,' '); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 139 IF FirstNonSpace # Width THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 140 Name[FirstNonSpace] := CAP(Name[FirstNonSpace]); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 141 END; 142 END; ***** ^ not supported yet 143 INC(NumUsed); ***** ^ undeclared identifier ***** ^ undeclared identifier 144 END 145 END; ***** ^ not supported yet 146 END AddOption; ***** ^ not supported yet 147 148 (*......................................*) 149 150 PROCEDURE KillMenu(VAR menu:MenuRec); ***** ^ undeclared identifier 151 BEGIN 152 IF menu.winptr <> NIL THEN ***** ^ not supported yet ***** ^ not supported yet 153 Window.Close(menu.winptr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 menu.winptr:=NIL; ***** ^ not supported yet ***** ^ not supported yet 155 END; 156 END KillMenu; ***** ^ not supported yet 157 158 (*......................................*) 159 160 PROCEDURE ShowSelectChars(VAR menu:MenuRec; onoff:switch); ***** ^ undeclared identifier 161 VAR 162 i : CARDINAL; 163 c : CHAR; 164 BEGIN 165 IF NOT menu.ExitOnChar THEN ***** ^ not supported yet ***** ^ not supported yet 166 RETURN; 167 END; 168 i:=0; 169 WHILE istart THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 248 HighLight(menu,off,start); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 249 HighLight(menu,on,Selection); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 250 END; 251 gotcha := ExitOnChar AND found; ***** ^ undeclared identifier ***** ^ undeclared identifier 252 END; ***** ^ not supported yet 253 END ChCheck; ***** ^ not supported yet 254 255 (*......................................*) 256 257 PROCEDURE DisplayPopUp(VAR menu:MenuRec; MenuX,MenuY:CARDINAL); ***** ^ undeclared identifier 258 VAR 259 i : CARDINAL; 260 Def : Window.WinDef; ***** ^ not supported yet 261 BEGIN 262 WITH menu DO ***** ^ not supported yet 263 IF winptr=NIL THEN ***** ^ undeclared identifier 264 Def := MenuTemplate; ***** ^ not supported yet 265 WITH Def DO ***** ^ not supported yet 266 X1:=MenuX; ***** ^ undeclared identifier 267 Y1:=MenuY; ***** ^ undeclared identifier 268 X2:=X1+Width+1; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 269 Y2:=Y1+NumUsed+1; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 270 Foreground := MenuColors.NormFore; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 271 Background := MenuColors.NormBack; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 272 FrameFore := MenuColors.FrameFore; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 273 FrameBack := MenuColors.FrameBack; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 274 END; ***** ^ not supported yet 275 winptr := Window.Open(Def); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 276 IF Title[0]<>0C THEN ***** ^ undeclared identifier ***** ^ not supported yet 277 Window.SetTitle(winptr,Title,Window.LeftUpperTitle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 278 END 279 END; 280 SetColor(Normal); ***** ^ not supported yet ***** ^ undeclared identifier 281 FOR i:=0 TO NumUsed-1 DO ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 282 WITH menu.Option[i] DO ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 283 XPos:=0; ***** ^ undeclared identifier 284 YPos:=i; ***** ^ undeclared identifier ***** ^ undeclared identifier 285 Window.DirectWrite(XPos+1,YPos+1,ADR(Name),Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 286 END; ***** ^ not supported yet 287 END; 288 Window.PutOnTop(winptr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 289 END; ***** ^ not supported yet 290 END DisplayPopUp; ***** ^ not supported yet 291 292 (*......................................*) 293 294 PROCEDURE PopUpMenu(VAR menu:MenuRec):INTEGER; ***** ^ undeclared identifier 295 VAR 296 ch : CHAR; 297 BEGIN 298 WITH menu DO ***** ^ not supported yet 299 Window.Use(winptr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 300 ShowSelectChars(menu,on); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 301 HighLight(menu,on,Selection); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 302 REPEAT 303 Read(ch); ***** ^ not supported yet ***** ^ not supported yet 304 DeAltify(ch); ***** ^ not supported yet ***** ^ not supported yet 305 CASE FuncKeyTyped OF ***** ^ not supported yet 306 Escape : IF EscapeOK THEN ***** ^ not supported yet ***** ^ undeclared identifier 307 RETURN(-1); 308 END; | 309 PageUp : IF PageKeysOK THEN ***** ^ not supported yet ***** ^ undeclared identifier 310 RETURN(-2); 311 END; | 312 PageDown : IF PageKeysOK THEN ***** ^ not supported yet ***** ^ undeclared identifier 313 RETURN(-3); 314 END; | 315 FKey1 : IF HelpOK THEN ***** ^ not supported yet ***** ^ undeclared identifier 316 RETURN(-4); 317 END; | 318 Cright,Cdown: IF (FuncKeyTyped=Cright) AND (ExitSideWays) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 319 RETURN(-5); 320 ELSE 321 HighLight(menu,off,Selection); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 322 Selection:=(Selection+1) MOD NumUsed; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 323 HighLight(menu,on,Selection); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 324 END; | 325 Cleft,Cup : IF (FuncKeyTyped=Cleft) AND (ExitSideWays) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 326 RETURN(-6); 327 ELSE 328 HighLight(menu,off,Selection); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 329 IF Selection=0 THEN ***** ^ undeclared identifier 330 Selection:=NumUsed; ***** ^ undeclared identifier ***** ^ undeclared identifier 331 END; 332 DEC(Selection); ***** ^ undeclared identifier ***** ^ undeclared identifier 333 HighLight(menu,on,Selection); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 334 END; | 335 ELSE 336 ChCheck(menu,ch) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 337 END; 338 UNTIL (ch=CHR(13)) OR (gotcha); ***** ^ undeclared identifier ***** ^ not supported yet 339 ShowSelectChars(menu,off); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 340 RETURN Selection; ***** ^ undeclared identifier 341 END; ***** ^ not supported yet 342 END PopUpMenu; ***** ^ not supported yet 343 344 (*......................................*) 345 346 PROCEDURE DispMenu(VAR menu:MenuRec); ***** ^ undeclared identifier 347 BEGIN 348 WITH menu DO ***** ^ not supported yet 349 DisplayPopUp(menu,MenuX,MenuY) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 350 END; 351 END DispMenu; ***** ^ not supported yet 352 353 (*......................................*) 354 355 PROCEDURE RepaintMenu(VAR menu:MenuRec); ***** ^ undeclared identifier 356 VAR 357 i : CARDINAL; 358 onoff : switch; ***** ^ not supported yet 359 BEGIN 360 menu.Selection := 0; ***** ^ not supported yet ***** ^ not supported yet 361 i:=0; 362 WHILE i