Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * WINDOW.MOD - Clipping text windows * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*%F _fdata *) 12 (*# call(seg_name => null) *) 13 (*# data(seg_name => null) *) 14 (*%E *) 15 (*# module(implementation=>off) *) 16 (*# call(o_a_copy=>off) *) 17 (*# check(stack=>off, 18 index=>off, 19 range=>off, 20 overflow=>off, 21 nil_ptr=>off) *) 22 23 IMPLEMENTATION MODULE Window; 24 25 (*%F _OS2 *) 26 IMPORT SYSTEM, Str, Lib, IO, CoreSig; 27 (*%E *) 28 (*%T _OS2 *) 29 IMPORT SYSTEM, Str, Lib, Vio, Dos, IO, CoreSig; 30 (*%E *) 31 (*%T _mthread *) 32 IMPORT Process; 33 (*%E *) 34 FROM Storage IMPORT ALLOCATE,DEALLOCATE; 35 36 TYPE 37 UseListPtr = POINTER TO UseListLink; ***** ^ undeclared identifier 38 UseListLink = RECORD 39 Next : UseListPtr; 40 Proc : ADDRESS; ***** ^ undeclared identifier 41 Wind : WinType; ***** ^ undeclared identifier 42 END; ***** ^ not supported yet 43 VAR 44 (*%T _mthread *) 45 Lock,Unlock : LockProc; ***** ^ undeclared identifier 46 (*%E *) 47 48 49 CONST 50 GuardConst = 4A4EH; 51 52 53 PROCEDURE CheckWindow(W:WinType); ***** ^ undeclared identifier 54 BEGIN 55 IF W^.Guard - Seg(W^) # GuardConst THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 56 Lib.RunTimeError(CoreSig._FatalErrorPos(),30H,'Invalid Window'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 57 END; (*IF*) 58 END CheckWindow; ***** ^ not supported yet 59 60 PROCEDURE ClipFrame ( W : WinType ); ***** ^ undeclared identifier 61 VAR 62 i : CARDINAL; 63 BEGIN 64 WITH W^ DO ***** ^ not supported yet 65 IF WDef.FrameOn THEN i := 1 ELSE i := 0 END; ***** ^ undeclared identifier ***** ^ not supported yet 66 IF XA < WDef.X1+i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 67 XA := WDef.X1+i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 68 ELSIF XA > WDef.X2-i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 69 XA := WDef.X2-i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 70 END; 71 IF XB > WDef.X2-i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 72 XB := WDef.X2-i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 73 ELSIF XB < WDef.X1+i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 74 XB := WDef.X1+i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 75 END; 76 IF YA < WDef.Y1+i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 77 YA := WDef.Y1+i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 78 ELSIF YA > WDef.Y2-i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 79 YA := WDef.Y2-i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 80 END; 81 IF YB > WDef.Y2-i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 82 YB := WDef.Y2-i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 83 ELSIF YB < WDef.Y1+i THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 84 YB := WDef.Y1+i ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 85 END; 86 Width := XB-XA+1; Depth := YB-YA+1; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 87 END; ***** ^ not supported yet 88 END ClipFrame; ***** ^ not supported yet 89 90 PROCEDURE ClipXY ( W : WinType; VAR X,Y : RelCoord ); ***** ^ undeclared identifier ***** ^ undeclared identifier 91 VAR 92 mw,md : CARDINAL; 93 BEGIN 94 WITH W^ DO ***** ^ not supported yet 95 mw := Width; md := Depth; ***** ^ undeclared identifier ***** ^ undeclared identifier 96 IF WDef.FrameOn AND NOT WDef.WrapOn THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 97 INC(md); INC(mw) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 98 ELSE 99 IF X=0 THEN X := 1 END; ***** ^ not supported yet ***** ^ not supported yet 100 IF Y=0 THEN Y := 1 END; ***** ^ not supported yet ***** ^ not supported yet 101 END; 102 IF X>mw THEN X := mw END; ***** ^ not supported yet ***** ^ not supported yet 103 IF Y>md THEN Y := md END; ***** ^ not supported yet ***** ^ not supported yet 104 END; ***** ^ not supported yet 105 END ClipXY; ***** ^ not supported yet 106 107 108 PROCEDURE BufferSpaceFill ( W : WinType; pos : CARDINAL; len : CARDINAL ); ***** ^ undeclared identifier 109 BEGIN 110 WITH W^ DO ***** ^ not supported yet 111 IF IsPalette THEN ***** ^ undeclared identifier 112 Lib.WordFill(ADR(Buffer^[pos]),len,32 ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 113 +VAL(CARDINAL,CurPalColor)*256); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 114 ELSE 115 Lib.WordFill(ADR(Buffer^[pos]),len,32+ ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 116 ORD(WDef.Foreground)*256+ORD(WDef.Background)*4096); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 117 END; 118 END; ***** ^ not supported yet 119 END BufferSpaceFill; ***** ^ not supported yet 120 121 122 PROCEDURE CurWin () : WinType; ***** ^ undeclared identifier 123 (* Returns The current window being used for output for this process *) 124 (* If no window assigned by Use then returns Top. *) 125 (* NB Locks window system and leaves locked if _mthread set. *) 126 VAR 127 u : UseListPtr; ***** ^ not supported yet 128 p : ADDRESS; ***** ^ undeclared identifier 129 BEGIN 130 (*%T _mthread *) 131 Lock(); ***** ^ not supported yet ***** ^ not supported yet 132 (*%E *) 133 IF CoreWind._multip THEN ***** ^ undeclared identifier ***** ^ not supported yet 134 (*%T _mthread *) 135 p := SYSTEM.CurrentProcess(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 136 (*%E *) 137 (*%F _mthread *) 138 p := NIL; 139 (*%E *) 140 u := UseListPtr(CoreWind._uselist)^.Next; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 141 LOOP 142 IF u = NIL THEN ***** ^ not supported yet 143 RETURN WinType(CoreWind._windowstack); (* Top() *) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 144 ELSIF p = u^.Proc THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 145 RETURN u^.Wind; ***** ^ not supported yet ***** ^ not supported yet 146 END; (*IF*) 147 u := u^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 148 END; (*LOOP*) 149 END; (*IF*) 150 u := UseListPtr(CoreWind._uselist)^.Next; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 151 IF u = NIL THEN ***** ^ not supported yet 152 RETURN WinType(CoreWind._windowstack); (* Top() *) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 153 END; (*IF*) 154 RETURN u^.Wind; ***** ^ not supported yet ***** ^ not supported yet 155 END CurWin; ***** ^ not supported yet 156 157 (*%F _OS2 *) 158 PROCEDURE ResetCursor; 159 VAR 160 R : SYSTEM.Registers; 161 mode : CARDINAL; 162 BEGIN 163 IF (CoreWind._cursorstack = NIL) OR 164 ObscuredAt(WinType(CoreWind._cursorstack),WinType(CoreWind._cursorstack)^.CurrentX,WinType(CoreWind._cursorstack)^.CurrentY) THEN 165 mode := 2000H; 166 ELSE 167 WITH WinType(CoreWind._cursorstack)^ DO 168 WITH R DO 169 AH := 2; 170 BH := SHORTCARD(CoreWind._activepage()); 171 DL := SHORTCARD(XA+CurrentX-1); 172 DH := SHORTCARD(YA+CurrentY-1); 173 END; 174 Lib.Intr(R,10H); 175 END; 176 mode := CoreWind._cursorlines; 177 END; 178 R.AH := 1; 179 R.CX := mode; 180 Lib.Intr(R,10H); 181 END ResetCursor; 182 (*%E *) 183 184 (*%T _OS2 *) 185 VAR 186 CursorInfo : Vio.CURSORINFO; ***** ^ not supported yet 187 RealMode : BOOLEAN; 188 189 PROCEDURE ResetCursor; 190 VAR r : CARDINAL; 191 BEGIN 192 IF (CoreWind._cursorstack = NIL) OR ***** ^ undeclared identifier ***** ^ not supported yet 193 ObscuredAt(WinType(CoreWind._cursorstack),WinType(CoreWind._cursorstack)^.CurrentX,WinType(CoreWind._cursorstack)^.CurrentY) THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 194 CursorInfo.attr := MAX(CARDINAL); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 195 ELSE 196 WITH WinType(CoreWind._cursorstack)^ DO ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 197 r := Vio.SetCurPos(YA+CurrentY-1,XA+CurrentX-1,0 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 198 END; ***** ^ not supported yet 199 CursorInfo.attr := 0; ***** ^ not supported yet ***** ^ not supported yet 200 END; 201 r := Vio.SetCurType( CursorInfo,0); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 202 END ResetCursor; ***** ^ not supported yet 203 (*%E *) 204 205 PROCEDURE UnlinkCursor ( W : WinType ); ***** ^ undeclared identifier 206 VAR 207 w : WinType; ***** ^ undeclared identifier 208 BEGIN 209 w := WinType(CoreWind._cursorstack); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 210 IF w = W THEN CoreWind._cursorstack := w^.CursorChain END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 211 LOOP 212 IF w = NIL THEN RETURN END; ***** ^ not supported yet 213 IF w^.CursorChain = W THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 214 w^.CursorChain := W^.CursorChain; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 215 RETURN; 216 END; 217 w := w^.CursorChain; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 218 END; 219 END UnlinkCursor; ***** ^ not supported yet 220 221 (* ------------------------- *) 222 (* Cursor Control *) 223 (* ------------------------- *) 224 225 226 227 PROCEDURE CursorOn; 228 VAR 229 w,cw : WinType; ***** ^ undeclared identifier 230 BEGIN 231 cw := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 232 UnlinkCursor(cw); ***** ^ not supported yet ***** ^ not supported yet 233 cw^.WDef.CursorOn := TRUE; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 234 IF NOT cw^.WDef.Hidden THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 235 cw^.CursorChain := WinType(CoreWind._cursorstack); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 236 CoreWind._cursorstack := cw; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 237 END; 238 ResetCursor; ***** ^ not supported yet 239 (*%T _mthread *) 240 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 241 (*%E *) 242 END CursorOn; ***** ^ not supported yet 243 244 PROCEDURE CursorOff; 245 VAR 246 w,cw : WinType; ***** ^ undeclared identifier 247 BEGIN 248 cw := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 249 UnlinkCursor(cw); ***** ^ not supported yet ***** ^ not supported yet 250 cw^.WDef.CursorOn := FALSE; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 251 ResetCursor; ***** ^ not supported yet 252 (*%T _mthread *) 253 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 254 (*%E *) 255 END CursorOff; ***** ^ not supported yet 256 257 (* ------------------------- *) 258 (* Window creation *) 259 (* ------------------------- *) 260 261 262 PROCEDURE MakeWindow ( VAR WD : WinDef ) : WinType; ***** ^ undeclared identifier ***** ^ undeclared identifier 263 264 (* 265 Creates a new Window descriptor 266 The size is Inclusive of frame if needed 267 does not allocate buffer 268 *) 269 VAR W : WinType; min : CARDINAL; ***** ^ undeclared identifier 270 BEGIN 271 NEW(W); ***** ^ undeclared identifier ***** ^ not supported yet 272 WITH W^ DO ***** ^ not supported yet 273 WITH WD DO ***** ^ not supported yet 274 IF X2 >= ScreenWidth THEN X2:=ScreenWidth-1 END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 275 IF Y2 >= CurrentScreenDepth THEN Y2:=CurrentScreenDepth-1 END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 276 IF WD.FrameOn THEN min := 2 ELSE min := 0 END; ***** ^ not supported yet ***** ^ not supported yet 277 IF (X1+min>X2) THEN X2 := X1+min END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 278 IF (Y1+min>Y2) THEN Y2 := Y1+min END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 279 XA := X1; YA := Y1; XB := X2; YB := Y2; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 280 Width := X2-X1+1; Depth := Y2-Y1+1; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 281 END; ***** ^ not supported yet 282 WDef := WD; ***** ^ undeclared identifier ***** ^ undeclared identifier 283 OWidth := Width; ODepth := Depth; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 284 CurrentX := 1; ***** ^ undeclared identifier 285 CurrentY := 1; ***** ^ undeclared identifier 286 Next := NIL; ***** ^ undeclared identifier 287 Buffer := NIL; ***** ^ undeclared identifier 288 UserRecord := NIL; ***** ^ undeclared identifier 289 IsPalette := FALSE; ***** ^ undeclared identifier 290 CurPalColor := NormalPaletteColor; ***** ^ undeclared identifier ***** ^ undeclared identifier 291 TMode := NoTitle; ***** ^ undeclared identifier ***** ^ undeclared identifier 292 Guard := GuardConst+CARDINAL(Seg(W^)); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 293 CursorChain := NIL; ***** ^ undeclared identifier 294 Title := NIL; ***** ^ undeclared identifier 295 END; ***** ^ not supported yet 296 ClipFrame(W); ***** ^ not supported yet ***** ^ undeclared identifier 297 RETURN W; ***** ^ undeclared identifier 298 END MakeWindow; ***** ^ not supported yet 299 300 PROCEDURE Open ( WD : WinDef ) : WinType; ***** ^ undeclared identifier ***** ^ undeclared identifier 301 (* 302 Opens a window on the screen ready for use 303 *) 304 VAR 305 W : WinType; ***** ^ undeclared identifier 306 BEGIN 307 (*%T _mthread *) 308 Lock(); ***** ^ not supported yet ***** ^ not supported yet 309 (*%E *) 310 W := MakeWindow (WD); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 311 WITH W^ DO ***** ^ not supported yet 312 ALLOCATE ( Buffer,OWidth*ODepth*2); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 313 BufferSpaceFill(W,0,OWidth*ODepth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 314 IF WD.FrameOn THEN ***** ^ not supported yet ***** ^ not supported yet 315 SetFrame(W,WDef.FrameDef,WDef.FrameFore,WDef.FrameBack); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 316 END; 317 END; ***** ^ not supported yet 318 IF WD.Hidden THEN ***** ^ undeclared identifier ***** ^ not supported yet 319 Use ( W ) ***** ^ undeclared identifier ***** ^ undeclared identifier 320 ELSE 321 PutOnTop ( W ) ***** ^ undeclared identifier ***** ^ undeclared identifier 322 END; 323 (*%T _mthread *) 324 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 325 (*%E *) 326 RETURN W; ***** ^ undeclared identifier 327 END Open; ***** ^ not supported yet 328 329 330 (* ------------------------- *) 331 (* Window stack manipulation *) 332 (* and screen redraw *) 333 (* ------------------------- *) 334 335 336 337 PROCEDURE Use ( W : WinType ); ***** ^ undeclared identifier 338 (* 339 Causes all subsequent output (by the current process) 340 to appear in the specified Window 341 NB does not have to be Top Window (or in fact on the screen at all) 342 UseListPtr(CoreWind._uselist) is the MRU window 343 *) 344 VAR 345 p : ADDRESS; ***** ^ undeclared identifier 346 u : UseListPtr; ***** ^ not supported yet 347 up : UseListPtr; ***** ^ not supported yet 348 BEGIN 349 (*%T _mthread *) 350 Lock(); ***** ^ not supported yet ***** ^ not supported yet 351 (*%E *) 352 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 353 (*%T _mthread *) 354 p := SYSTEM.CurrentProcess(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 355 (*%E *) 356 (*%F _mthread *) 357 p := NIL; 358 (*%E *) 359 up := UseListPtr(CoreWind._uselist); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 360 u := up^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 361 LOOP 362 IF u = NIL THEN NEW(u); u^.Proc := p; EXIT END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 363 IF p = u^.Proc THEN up^.Next := u^.Next; EXIT END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 364 up := u; u := u^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 365 END; 366 u^.Next := UseListPtr(CoreWind._uselist)^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 367 UseListPtr(CoreWind._uselist)^.Next := u; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 368 u^.Wind := W; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 369 (*%T _mthread *) 370 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 371 (*%E *) 372 END Use; ***** ^ not supported yet 373 374 PROCEDURE TakeOffStack ( W : WinType ); (* Private *) ***** ^ undeclared identifier 375 VAR pw : WinType; ***** ^ undeclared identifier 376 BEGIN 377 IF W = WinType(CoreWind._windowstack) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 378 CoreWind._windowstack := W^.Next; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 379 ELSE 380 pw := WinType(CoreWind._windowstack); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 381 IF W # pw THEN ***** ^ not supported yet ***** ^ not supported yet 382 LOOP 383 IF (pw = NIL) THEN EXIT END; ***** ^ not supported yet 384 IF (pw^.Next = W) THEN pw^.Next := W^.Next; EXIT END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 385 pw := pw^.Next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 386 END; 387 END; 388 END; 389 W^.Next := NIL; ***** ^ not supported yet ***** ^ not supported yet 390 END TakeOffStack; ***** ^ not supported yet 391 392 393 394 PROCEDURE UpdateScreen ( W : WinType; X,Y : AbsCoord; Len : CARDINAL ); ***** ^ undeclared identifier ***** ^ undeclared identifier 395 (* Updates the screen from the window buffer *) 396 VAR 397 NextLen, 398 NextX : AbsCoord; ***** ^ undeclared identifier 399 w : WinType; ***** ^ undeclared identifier 400 oxa,oxb,ax,bx : AbsCoord; ***** ^ undeclared identifier 401 buff : ARRAY[0..ScreenWidth-1] OF CARDINAL; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 402 a : ADDRESS; ***** ^ undeclared identifier 403 BEGIN 404 IF W^.WDef.Hidden THEN RETURN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 405 WHILE Len#0 DO 406 (* adjust co ordinates for crossing windows *) 407 NextLen := 0; ***** ^ not supported yet 408 w := WinType(CoreWind._windowstack); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 409 ax := X; bx := X+Len-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 410 LOOP 411 IF (w = W)OR(w=NIL) THEN EXIT END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 412 WITH w^ DO ***** ^ not supported yet 413 IF (Y>=WDef.Y1) AND (Y<=WDef.Y2) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 414 oxa := WDef.X1; oxb := WDef.X2; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 415 IF (ax>=oxa) AND (bx<=oxb) THEN (* wiped out *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 416 ax := bx+1; EXIT; ***** ^ not supported yet ***** ^ not supported yet 417 ELSIF (ax<=oxb) AND (bx>=oxa) THEN (* some interaction *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 418 IF (axoxb) THEN (* cut into two *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 419 bx := oxa-1; ***** ^ not supported yet ***** ^ not supported yet 420 NextX := oxb+1; ***** ^ not supported yet ***** ^ not supported yet 421 NextLen := X+Len-NextX; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 422 ELSIF (bx>oxb) THEN (* left edge cut off *) ***** ^ not supported yet ***** ^ not supported yet 423 ax := oxb+1; ***** ^ not supported yet ***** ^ not supported yet 424 ELSIF (ax=NW^.WDef.X1)AND(NW^.WDef.X2>=WDef.X1) AND ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 483 (WDef.Y2>=NW^.WDef.Y1)AND(NW^.WDef.Y2>=WDef.Y1)) THEN (* windows cross *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 484 (* calculate Intersection *) 485 IF WDef.X1>NW^.WDef.X1 THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 486 x1 := WDef.X1 ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 487 ELSE 488 x1 := NW^.WDef.X1 ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 489 END; 490 IF WDef.X2NW^.WDef.Y1 THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 496 y1 := WDef.Y1 ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 497 ELSE 498 y1 := NW^.WDef.Y1 ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 499 END; 500 IF WDef.Y2= WDef.Y1) AND (Y <= WDef.Y2) AND ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 740 (X >= WDef.X1) AND (X <= WDef.X2) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 741 EXIT 742 END; 743 W := Next; ***** ^ not supported yet ***** ^ undeclared identifier 744 END; ***** ^ not supported yet 745 END; 746 (*%T _mthread *) 747 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 748 (*%E *) 749 RETURN W; ***** ^ undeclared identifier 750 END At; ***** ^ not supported yet 751 752 PROCEDURE ObscuredAt (W : WinType; X,Y : RelCoord ) : BOOLEAN; ***** ^ undeclared identifier ***** ^ undeclared identifier 753 (* 754 Returns if the specified window is obscured at the specified position 755 *) 756 VAR 757 b : BOOLEAN; 758 w : WinType; ***** ^ undeclared identifier 759 BEGIN 760 (*%T _mthread *) 761 Lock(); ***** ^ not supported yet ***** ^ not supported yet 762 (*%E *) 763 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 764 WITH W^ DO ***** ^ not supported yet 765 IF WDef.Hidden THEN ***** ^ undeclared identifier ***** ^ not supported yet 766 b:= TRUE; 767 ELSE 768 INC(X,XA-1); INC(Y,YA-1); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 769 w := WinType(CoreWind._windowstack); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 770 LOOP 771 IF w = W THEN b := FALSE; EXIT END; ***** ^ not supported yet ***** ^ not supported yet 772 IF w = NIL THEN b := TRUE; EXIT END; ***** ^ not supported yet 773 WITH w^ DO ***** ^ not supported yet 774 IF (Y>=WDef.Y1) AND (Y<=WDef.Y2) AND ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 775 (X>=WDef.X1) AND (X<=WDef.X2) THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 776 b := TRUE; 777 EXIT 778 END; 779 w := Next; ***** ^ not supported yet ***** ^ undeclared identifier 780 END; ***** ^ not supported yet 781 END; 782 END; 783 END; ***** ^ not supported yet 784 (*%T _mthread *) 785 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 786 (*%E *) 787 RETURN b; ***** ^ undeclared identifier 788 END ObscuredAt; ***** ^ not supported yet 789 790 791 792 PROCEDURE WindowWrite ( W : WinType; ***** ^ undeclared identifier 793 x,y : RelCoord; ***** ^ undeclared identifier 794 Len : CARDINAL; 795 str : ADDRESS; ***** ^ undeclared identifier 796 frame : BOOLEAN ); (* Private *) 797 VAR 798 Attr : CARDINAL; 799 X,Y : AbsCoord; ***** ^ undeclared identifier 800 BEGIN 801 IF Len>0 THEN 802 WITH W^ DO ***** ^ not supported yet 803 IF IsPalette THEN ***** ^ undeclared identifier 804 IF frame THEN 805 Attr := VAL(CARDINAL,FramePaletteColor); ***** ^ undeclared identifier ***** ^ undeclared identifier 806 ELSE 807 Attr := VAL(CARDINAL,CurPalColor); ***** ^ undeclared identifier ***** ^ undeclared identifier 808 END; 809 ELSIF frame THEN 810 Attr := ORD(WDef.FrameFore)+ORD(WDef.FrameBack)*16; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 811 ELSE 812 Attr := ORD(WDef.Foreground)+ORD(WDef.Background)*16; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 813 END; 814 X := x+XA-1; Y := y+YA-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 815 IF Len+X-1 > WDef.X2 THEN Len := WDef.X2+1-X END; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 816 CoreWind._bufferwrite (ADR(Buffer^[X-WDef.X1+(Y-WDef.Y1)*OWidth]),str,Len,Attr); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 817 UpdateScreen(W,X,Y,Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 818 END; ***** ^ not supported yet 819 END; 820 END WindowWrite; ***** ^ not supported yet 821 822 PROCEDURE DrawFrame ( W : WinType ); ***** ^ undeclared identifier 823 VAR 824 s : ARRAY[0..81] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 825 w,l,tl : CARDINAL; 826 i : CARDINAL; 827 828 PROCEDURE PutTitle ( mode : CARDINAL; row : CARDINAL ); 829 VAR 830 i,j : CARDINAL; 831 BEGIN 832 WITH W^ DO ***** ^ not supported yet 833 CASE mode OF 834 0 : i := 1 | 835 1 : i := (Width-tl) DIV 2 + 1; | ***** ^ undeclared identifier 836 2 : i := Width+1-tl | ***** ^ undeclared identifier 837 ELSE 838 i := MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 839 END; 840 j := 0; 841 WHILE (i<=Width)AND(jWidth THEN tl := Width END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 863 END; 864 PutTitle(ORD(TMode-LeftUpperTitle),0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 865 (* Sides *) 866 FOR i := 1 TO Depth DO ***** ^ undeclared identifier ***** ^ undeclared identifier 867 WindowWrite(W,0,i,1,ADR(WDef.FrameDef[3]),TRUE); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 868 WindowWrite(W,Width+1,i,1,ADR(WDef.FrameDef[4]),TRUE); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 869 END; 870 s[0] := WDef.FrameDef[5]; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 871 Lib.Fill(ADR(s[1]),Width,WDef.FrameDef[6]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 872 s[Width+1] := WDef.FrameDef[7]; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 873 PutTitle(ORD(TMode-LeftLowerTitle),Depth+1); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 874 END; ***** ^ not supported yet 875 END DrawFrame; ***** ^ not supported yet 876 877 878 879 PROCEDURE SetFrame ( W : WinType; ***** ^ undeclared identifier 880 Frame : FrameStr; ***** ^ undeclared identifier 881 Fore, Back : Color ); ***** ^ undeclared identifier 882 (* 883 Put a frame around the specified window 884 With Title String and border definition (see above) 885 having specified fore/background colours for the border 886 *) 887 BEGIN 888 (*%T _mthread *) 889 Lock(); ***** ^ not supported yet ***** ^ not supported yet 890 (*%E *) 891 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 892 WITH W^ DO ***** ^ not supported yet 893 WDef.FrameDef := Frame; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 894 WDef.FrameFore := Fore; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 895 WDef.FrameBack := Back; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 896 END; ***** ^ not supported yet 897 DrawFrame(W); ***** ^ not supported yet ***** ^ undeclared identifier 898 (*%T _mthread *) 899 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 900 (*%E *) 901 END SetFrame; ***** ^ not supported yet 902 903 904 905 PROCEDURE MergeWindows ( s,d : WinType ); ***** ^ undeclared identifier 906 (* slightly complicated procedure to merge two windows 907 s is new (hidden) window 908 d is old window to be merged into 909 *) 910 VAR 911 w : WinDescriptor; ***** ^ undeclared identifier 912 r,wd : CARDINAL; 913 sw,sd,so,sp : CARDINAL; 914 dw,dd,do,dp : CARDINAL; 915 BEGIN 916 s^.CurrentX := d^.CurrentX; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 917 s^.CurrentY := d^.CurrentY; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 918 s^.CursorChain := d^.CursorChain; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 919 s^.UserRecord := d^.UserRecord; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 920 s^.CurPalColor := d^.CurPalColor; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 921 s^.Title := d^.Title; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 922 s^.TMode := d^.TMode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 923 d^.TMode := NoTitle; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 924 d^.WDef.CursorOn := FALSE; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 925 w := d^; d^ := s^; s^ := w; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 926 WITH s^ DO ***** ^ not supported yet 927 sw := OWidth; sd := ODepth; ***** ^ undeclared identifier ***** ^ undeclared identifier 928 IF WDef.FrameOn THEN ***** ^ undeclared identifier ***** ^ not supported yet 929 DEC(sw,2); DEC(sd,2); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 930 sp := (OWidth+1); ***** ^ undeclared identifier 931 ELSE 932 sp := 0; 933 END; 934 Guard := GuardConst+CARDINAL(Seg(s^)); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 935 END; ***** ^ not supported yet 936 WITH d^ DO ***** ^ undeclared identifier 937 dw := OWidth; dd := ODepth; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 938 IF WDef.FrameOn THEN ***** ^ undeclared identifier ***** ^ not supported yet 939 DEC(dw,2); DEC(dd,2); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 940 dp := OWidth+1; ***** ^ undeclared identifier ***** ^ undeclared identifier 941 ELSE 942 dp := 0; ***** ^ undeclared identifier 943 END; 944 Guard := GuardConst+CARDINAL(Seg(d^)); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 945 END; ***** ^ not supported yet 946 IF sd < dd THEN wd := sd ELSE wd := dd END; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 947 FOR r := 0 TO wd-1 DO ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 948 IF sw>=dw THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 949 Lib.WordMove(ADR(s^.Buffer^[sp]),ADR(d^.Buffer^[dp]),dw); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 950 ELSE 951 Lib.WordMove(ADR(s^.Buffer^[sp]),ADR(d^.Buffer^[dp]),sw); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 952 BufferSpaceFill(d,dp+sw,dw-sw); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 953 END; 954 INC(sp,s^.OWidth); INC(dp,d^.OWidth); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 955 END; 956 (* now fill rest *) 957 IF wd
= m THEN RETURN FALSE END; 1110 IF ODD(p) THEN RETURN TRUE END; ***** ^ undeclared identifier ***** ^ not supported yet 1111 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 1112 END; 1113 END; ***** ^ not supported yet 1114 END PaletteColorUsed; ***** ^ not supported yet 1115 1116 1117 1118 (* ------------------------- *) 1119 (* Move resize procedure *) 1120 (* ------------------------- *) 1121 1122 1123 1124 1125 PROCEDURE Change(W:WinType;X1,Y1,X2,Y2:AbsCoord); ***** ^ undeclared identifier ***** ^ undeclared identifier 1126 (* Changes the size and/or position of the specified window The *) 1127 (* contents of the window will be moved with it *) 1128 VAR 1129 nw : WinType; ***** ^ undeclared identifier 1130 wd : WinDef; ***** ^ undeclared identifier 1131 pal : PaletteDef; ***** ^ undeclared identifier 1132 save : WinType; ***** ^ undeclared identifier 1133 min : CARDINAL; 1134 BEGIN 1135 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 1136 save := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1137 WITH W^ DO ***** ^ not supported yet 1138 IF X2 >= ScreenWidth THEN ***** ^ not supported yet ***** ^ undeclared identifier 1139 X2 := ScreenWidth - 1; ***** ^ not supported yet ***** ^ undeclared identifier 1140 END; (*IF*) 1141 IF Y2 >= CurrentScreenDepth THEN ***** ^ not supported yet ***** ^ undeclared identifier 1142 Y2 := CurrentScreenDepth - 1; ***** ^ not supported yet ***** ^ undeclared identifier 1143 END; (*IF*) 1144 wd := WDef; ***** ^ not supported yet ***** ^ undeclared identifier 1145 IF wd.FrameOn THEN ***** ^ not supported yet ***** ^ not supported yet 1146 min := 2; 1147 ELSE 1148 min := 0; 1149 END; (*IF*) 1150 IF (X1 + min > X2) OR (Y1 + min > Y2) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1151 (*%T _mthread *) 1152 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1153 (*%E *) 1154 RETURN; 1155 END; (*IF*) 1156 wd.X1 := X1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1157 wd.Y1 := Y1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1158 wd.X2 := X2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1159 wd.Y2 := Y2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1160 wd.Hidden := TRUE; ***** ^ not supported yet ***** ^ not supported yet 1161 IF IsPalette THEN ***** ^ undeclared identifier 1162 GetPal(W,pal); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1163 nw := PaletteOpen(wd,pal); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1164 ELSE 1165 nw := Open(wd); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1166 END; (*IF*) 1167 MergeWindows(nw,W); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1168 ClipFrame (W); ***** ^ not supported yet ***** ^ not supported yet 1169 IF CurrentX > Width THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 1170 CurrentX := Width; ***** ^ undeclared identifier ***** ^ undeclared identifier 1171 END; (*IF*) 1172 IF CurrentY > Depth THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 1173 CurrentY := Depth; ***** ^ undeclared identifier ***** ^ undeclared identifier 1174 END; (*IF*) 1175 ResetCursor; ***** ^ not supported yet 1176 END; (*WITH*) ***** ^ not supported yet 1177 Use(save); (* restore used window *) ***** ^ not supported yet ***** ^ undeclared identifier 1178 (*%T _mthread *) 1179 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1180 (*%E *) 1181 END Change; ***** ^ not supported yet 1182 1183 (* ------------------------- *) 1184 (* Multi process support *) 1185 (* ------------------------- *) 1186 1187 PROCEDURE NullProc; 1188 BEGIN 1189 END NullProc; ***** ^ not supported yet 1190 1191 PROCEDURE SetProcessLocks ( LockProc,UnlockProc : LockProc ); ***** ^ not a type name 1192 BEGIN 1193 (*%T _mthread *) 1194 Lock := LockProc; ***** ^ not supported yet ***** ^ not supported yet 1195 Unlock := UnlockProc; ***** ^ not supported yet ***** ^ not supported yet 1196 CoreWind._multip := TRUE; ***** ^ undeclared identifier ***** ^ not supported yet 1197 (*%E *) 1198 END SetProcessLocks; ***** ^ not supported yet 1199 1200 (* ------------------------- *) 1201 (* Window output *) 1202 (* ------------------------- *) 1203 1204 1205 PROCEDURE DeleteLine ( W : WinType; Y : RelCoord ); ***** ^ undeclared identifier ***** ^ undeclared identifier 1206 VAR 1207 r,p : CARDINAL; 1208 BEGIN 1209 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 1210 WITH W^ DO ***** ^ not supported yet 1211 p := XA-WDef.X1+(YA-WDef.Y1+Y-1)*OWidth; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1212 FOR r := Y TO Depth-1 DO ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 1213 Lib.Move(ADR(Buffer^[p+OWidth]),ADR(Buffer^[p]),Width*2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1214 INC(p,OWidth); ***** ^ undeclared identifier ***** ^ undeclared identifier 1215 END; 1216 BufferSpaceFill(W,p,Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1217 RedrawSection ( W,XA,Y+YA-1,XB,YB ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 1218 END; ***** ^ not supported yet 1219 END DeleteLine; ***** ^ not supported yet 1220 1221 1222 1223 PROCEDURE Clear; 1224 (* 1225 clears the current window 1226 *) 1227 VAR 1228 r,p : CARDINAL; 1229 W : WinType; ***** ^ undeclared identifier 1230 BEGIN 1231 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1232 WITH W^ DO ***** ^ not supported yet 1233 p := XA-WDef.X1+(YA-WDef.Y1)*OWidth; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 1234 FOR r := 1 TO Depth DO ***** ^ undeclared identifier 1235 BufferSpaceFill(W,p,Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1236 INC(p,OWidth); ***** ^ undeclared identifier ***** ^ undeclared identifier 1237 END; 1238 RedrawWindowPane(W); ***** ^ not supported yet ***** ^ not supported yet 1239 END; ***** ^ not supported yet 1240 IGotoXY(W,1,1); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1241 (*%T _mthread *) 1242 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1243 (*%E *) 1244 END Clear; ***** ^ not supported yet 1245 1246 PROCEDURE ClrEol; 1247 (* 1248 clears from the cursor to the end of line 1249 *) 1250 VAR 1251 W : WinType; ***** ^ undeclared identifier 1252 BEGIN 1253 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1254 WITH W^ DO ***** ^ not supported yet 1255 BufferSpaceFill(W,XA-WDef.X1+CurrentX-1+(YA-WDef.Y1+CurrentY-1)*OWidth, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 1256 Width-CurrentX+1); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1257 RedrawSection ( W,XA-1+CurrentX,YA-1+CurrentY,XB,YA-1+CurrentY ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 1258 END; ***** ^ not supported yet 1259 (*%T _mthread *) 1260 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1261 (*%E *) 1262 END ClrEol; ***** ^ not supported yet 1263 1264 (*%F _OS2 *) 1265 PROCEDURE Bell; 1266 VAR 1267 R : SYSTEM.Registers; 1268 BEGIN 1269 WITH R DO 1270 AX := 0E07H; 1271 BL := 0; 1272 Lib.Intr(R,10H); 1273 END; 1274 END Bell; 1275 (*%E *) 1276 1277 (*%T _OS2 *) 1278 PROCEDURE Bell; 1279 BEGIN 1280 Dos.Beep(1000,300); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1281 END Bell; ***** ^ not supported yet 1282 (*%E *) 1283 1284 PROCEDURE WriteC ( W : WinType; C : CHAR); ***** ^ undeclared identifier 1285 VAR 1286 nx : CARDINAL; 1287 BEGIN 1288 WITH W^ DO ***** ^ not supported yet 1289 CASE C OF 1290 CHR(12) : Clear; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1291 IGotoXY(W,1,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1292 | CHR(10) : IF CurrentY=Depth THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 1293 DeleteLine ( W, 1 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1294 ELSE 1295 IGotoXY(W,CurrentX,CurrentY+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1296 END; 1297 | CHR(13) : (*ClrEol; change 1/7/88*) IGotoXY(W,1,CurrentY); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1298 | CHR(08) : IF CurrentX>1 THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 1299 IGotoXY(W,CurrentX-1,CurrentY); WriteC(W,' '); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1300 IGotoXY(W,CurrentX-1,CurrentY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 1301 END; 1302 | CHR(7) : Bell; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1303 ELSE 1304 IF CurrentX > Width THEN RETURN END; ***** ^ undeclared identifier ***** ^ undeclared identifier 1305 WindowWrite(W,CurrentX,CurrentY,1,ADR(C),FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1306 IF (CurrentX#Width)OR NOT WDef.WrapOn THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1307 IGotoXY(W,CurrentX+1,CurrentY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 1308 ELSE 1309 IF CurrentY=Depth THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 1310 DeleteLine ( W, 1 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1311 IGotoXY(W,1,CurrentY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1312 ELSE 1313 IGotoXY(W,1,CurrentY+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1314 END; 1315 END; 1316 END; 1317 END; ***** ^ not supported yet 1318 END WriteC; ***** ^ not supported yet 1319 1320 PROCEDURE WriteOut (S : ARRAY OF CHAR); ***** ^ not supported yet 1321 VAR 1322 W : WinType; ***** ^ undeclared identifier 1323 p,q,m : CARDINAL; 1324 ss : CARDINAL; 1325 BEGIN 1326 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1327 WITH W^ DO ***** ^ not supported yet 1328 ss := HIGH(S)+1; ***** ^ undeclared identifier ***** ^ not supported yet 1329 p := 0; 1330 q := 0; 1331 LOOP 1332 (* first accumulate normal chars on same line *) 1333 m := Width+p-CurrentX; ***** ^ undeclared identifier ***** ^ undeclared identifier 1334 IF NOT W^.WDef.WrapOn THEN INC(m) END; (* can fit another char in *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1335 IF m > ss THEN m := ss END; 1336 WHILE (q=' ') DO INC(q) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1337 (* now output the line *) 1338 IF q > p THEN 1339 WindowWrite(W,CurrentX,CurrentY,q-p,ADR(S[p]),FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1340 IGotoXY(W,CurrentX+q-p,CurrentY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 1341 END; 1342 (* now output the special char *) 1343 IF (S[q] = CHR(0)) OR (q > HIGH(S)) THEN EXIT ELSE WriteC(W,S[q]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1344 END; 1345 INC(q); ***** ^ undeclared identifier ***** ^ not supported yet 1346 p := q; 1347 END; 1348 END; ***** ^ not supported yet 1349 (*%T _mthread *) 1350 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1351 (*%E *) 1352 END WriteOut; ***** ^ not supported yet 1353 1354 PROCEDURE DirectWrite ( X,Y : RelCoord; (* start co-ords *) ***** ^ undeclared identifier 1355 A : ADDRESS; (* address of char array *) ***** ^ undeclared identifier 1356 Len : CARDINAL ); (* length to be written *) 1357 (* 1358 writes directly to current window at the specified X,Y coordinates 1359 with no check for special (ie control) chars or eol wrap 1360 *) 1361 VAR 1362 W : WinType; ***** ^ undeclared identifier 1363 BEGIN 1364 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1365 WindowWrite(W,X,Y,Len,A,FALSE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1366 (*%T _mthread *) 1367 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1368 (*%E *) 1369 END DirectWrite; ***** ^ not supported yet 1370 1371 1372 PROCEDURE GotoXY ( X,Y : RelCoord ); ***** ^ undeclared identifier 1373 VAR 1374 W : WinType; ***** ^ undeclared identifier 1375 BEGIN 1376 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1377 ClipXY(W,X,Y); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1378 IGotoXY(W,X,Y); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1379 (*%T _mthread *) 1380 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1381 (*%E *) 1382 END GotoXY; ***** ^ not supported yet 1383 1384 PROCEDURE WhereX ( ) : RelCoord; ***** ^ undeclared identifier 1385 VAR 1386 W : WinType; ***** ^ undeclared identifier 1387 BEGIN 1388 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1389 (*%T _mthread *) 1390 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1391 (*%E *) 1392 RETURN W^.CurrentX; ***** ^ not supported yet ***** ^ not supported yet 1393 END WhereX; ***** ^ not supported yet 1394 1395 PROCEDURE WhereY ( ) : RelCoord; ***** ^ undeclared identifier 1396 VAR 1397 W : WinType; ***** ^ undeclared identifier 1398 BEGIN 1399 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1400 (*%T _mthread *) 1401 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1402 (*%E *) 1403 RETURN W^.CurrentY; ***** ^ not supported yet ***** ^ not supported yet 1404 END WhereY; ***** ^ not supported yet 1405 1406 PROCEDURE ConvertCoords ( W : WinType ; ***** ^ undeclared identifier 1407 X,Y : RelCoord; ***** ^ undeclared identifier 1408 VAR XO,YO : AbsCoord ); ***** ^ undeclared identifier 1409 BEGIN 1410 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 1411 XO := X+W^.XA-1; YO := Y+W^.YA-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1412 END ConvertCoords; ***** ^ not supported yet 1413 1414 1415 PROCEDURE InsLine; 1416 VAR 1417 W : WinType; ***** ^ undeclared identifier 1418 r,p,p1 : CARDINAL; 1419 BEGIN 1420 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1421 WITH W^ DO ***** ^ not supported yet 1422 p := XA-WDef.X1+(YA-WDef.Y1+Depth-1)*OWidth; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 1423 FOR r := CurrentY TO Depth-1 DO ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 1424 DEC(p,OWidth); ***** ^ undeclared identifier ***** ^ undeclared identifier 1425 Lib.Move(ADR(Buffer^[p]),ADR(Buffer^[p+OWidth]),Width*2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1426 END; 1427 BufferSpaceFill(W,p,Width); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1428 RedrawSection ( W,XA,CurrentY+YA-1,XB,YB ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 1429 END; ***** ^ not supported yet 1430 (*%T _mthread *) 1431 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1432 (*%E *) 1433 END InsLine; ***** ^ not supported yet 1434 1435 PROCEDURE DelLine; 1436 VAR 1437 W : WinType; ***** ^ undeclared identifier 1438 BEGIN 1439 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1440 DeleteLine(W,W^.CurrentY); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1441 (*%T _mthread *) 1442 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1443 (*%E *) 1444 END DelLine; ***** ^ not supported yet 1445 1446 PROCEDURE TextColor ( c : Color ); ***** ^ undeclared identifier 1447 VAR 1448 W : WinType; ***** ^ undeclared identifier 1449 BEGIN 1450 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1451 W^.WDef.Foreground := c; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1452 (*%T _mthread *) 1453 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1454 (*%E *) 1455 END TextColor; ***** ^ not supported yet 1456 1457 PROCEDURE TextBackground ( c : Color ); ***** ^ undeclared identifier 1458 VAR 1459 W : WinType; ***** ^ undeclared identifier 1460 BEGIN 1461 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1462 W^.WDef.Background := c; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1463 (*%T _mthread *) 1464 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1465 (*%E *) 1466 END TextBackground; ***** ^ not supported yet 1467 1468 PROCEDURE SetWrap ( on : BOOLEAN ); 1469 VAR 1470 W : WinType; ***** ^ undeclared identifier 1471 BEGIN 1472 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1473 W^.WDef.WrapOn := on; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1474 (*%T _mthread *) 1475 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1476 (*%E *) 1477 END SetWrap; ***** ^ not supported yet 1478 1479 PROCEDURE Info ( W : WinType; VAR WD : WinDef ); ***** ^ undeclared identifier ***** ^ undeclared identifier 1480 (* gets information for specified window *) 1481 BEGIN 1482 (*%T _mthread *) 1483 Lock(); ***** ^ not supported yet ***** ^ not supported yet 1484 (*%E *) 1485 WD := W^.WDef; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1486 (*%T _mthread *) 1487 Unlock(); ***** ^ not supported yet ***** ^ not supported yet 1488 (*%E *) 1489 END Info; ***** ^ not supported yet 1490 1491 1492 (* ------------------------- *) 1493 (* Title procedure *) 1494 (* ------------------------- *) 1495 PROCEDURE SetTitle ( W : WinType; ***** ^ undeclared identifier 1496 NewTitle : ARRAY OF CHAR; ***** ^ not supported yet 1497 Mode : TitleMode ); ***** ^ undeclared identifier 1498 (* 1499 updates the window title within the window frame, 1500 positioning it in the position defined by the title mode 1501 *) 1502 VAR 1503 l : CARDINAL; 1504 BEGIN 1505 CheckWindow(W); ***** ^ not supported yet ***** ^ not supported yet 1506 (*%T _mthread *) 1507 Lock(); ***** ^ not supported yet ***** ^ not supported yet 1508 (*%E *) 1509 DisposeTitle(W); ***** ^ not supported yet ***** ^ not supported yet 1510 WITH W^ DO ***** ^ not supported yet 1511 IF Mode # NoTitle THEN ***** ^ not supported yet ***** ^ undeclared identifier 1512 l := Str.Length(NewTitle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1513 ALLOCATE(Title,l+1); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1514 Lib.Move(ADR(NewTitle),ADR(Title^),l); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1515 Title^[l] := CHR(0); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1516 END; 1517 TMode := Mode; ***** ^ undeclared identifier ***** ^ not supported yet 1518 END; ***** ^ not supported yet 1519 DrawFrame(W); ***** ^ not supported yet ***** ^ undeclared identifier 1520 (*%T _mthread *) 1521 Unlock; ***** ^ not supported yet 1522 (*%E *) 1523 END SetTitle; ***** ^ not supported yet 1524 1525 1526 PROCEDURE ReadString ( VAR string : ARRAY OF CHAR ); ***** ^ not supported yet 1527 VAR 1528 c : CHAR; 1529 line: ARRAY[0..82] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 1530 p,H : CARDINAL; 1531 W : WinType; ***** ^ undeclared identifier 1532 con : BOOLEAN; 1533 BEGIN 1534 W := CurWin(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1535 PutOnTop(W); ***** ^ not supported yet ***** ^ not supported yet 1536 con := W^.WDef.CursorOn; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1537 CursorOn; ***** ^ not supported yet 1538 H := HIGH(string); ***** ^ undeclared identifier ***** ^ not supported yet 1539 IF H>79 THEN H := 79 END; 1540 p := 0; 1541 LOOP 1542 c := IO.RdKey(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1543 IF (c=CHR(8))OR(c=CHR(127)) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1544 IF p>0 THEN DEC(p); IO.WrChar(CHR(8)) END; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1545 ELSIF (c>=' ') THEN 1546 IF p<=H THEN 1547 IO.WrChar(c); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1548 line[p] := c; ***** ^ not supported yet ***** ^ not supported yet 1549 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 1550 END; 1551 ELSIF c=CHR(13) THEN ***** ^ undeclared identifier ***** ^ not supported yet 1552 EXIT; 1553 END; 1554 END; 1555 line[p] := CHR(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1556 Str.Copy(string,line); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1557 IF NOT con THEN CursorOff END; ***** ^ not supported yet 1558 (*%T _mthread *) 1559 Unlock; ***** ^ not supported yet 1560 (*%E *) 1561 IO.WrLn; ***** ^ not supported yet ***** ^ not supported yet 1562 END ReadString; ***** ^ not supported yet 1563 1564 (* Low level routines to read and write to the window buffer direct *) 1565 1566 PROCEDURE RdBufferLn ( W : WinType; (* Source window *) ***** ^ undeclared identifier 1567 X,Y : RelCoord; (* start co-ords *) ***** ^ undeclared identifier 1568 Dest : ADDRESS; (* address of buffer *) ***** ^ undeclared identifier 1569 Len : CARDINAL ); (* length in WORDs *) 1570 VAR 1571 AX,AY : AbsCoord; ***** ^ undeclared identifier 1572 BEGIN 1573 WITH W^ DO ***** ^ not supported yet 1574 AX := X+XA-1; AY := Y+YA-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1575 Lib.WordMove(ADR(Buffer^[AX-WDef.X1+(AY-WDef.Y1)*OWidth]),Dest,Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1576 END; ***** ^ not supported yet 1577 END RdBufferLn; ***** ^ not supported yet 1578 1579 PROCEDURE WrBufferLn ( W : WinType; (* Dest window *) ***** ^ undeclared identifier 1580 X,Y : RelCoord; (* start co-ords *) ***** ^ undeclared identifier 1581 Src : ADDRESS; (* address of buffer *) ***** ^ undeclared identifier 1582 Len : CARDINAL ); (* length in WORDs *) 1583 VAR 1584 AX,AY : AbsCoord; ***** ^ undeclared identifier 1585 BEGIN 1586 WITH W^ DO ***** ^ not supported yet 1587 AX := X+XA-1; AY := Y+YA-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1588 Lib.WordMove(Src,ADR(Buffer^[AX-WDef.X1+(AY-WDef.Y1)*OWidth]),Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1589 UpdateScreen(W,AX,AY,Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1590 END; ***** ^ not supported yet 1591 END WrBufferLn; ***** ^ not supported yet 1592 1593 PROCEDURE InputStr ( VAR S : ARRAY OF CHAR ); ***** ^ not supported yet 1594 VAR 1595 ins : BOOLEAN; 1596 k : CHAR; 1597 x,y,p,l : CARDINAL; 1598 BEGIN 1599 x := WhereX(); y := WhereY(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1600 p := MAX(CARDINAL); ***** ^ undeclared identifier ***** ^ not supported yet 1601 p := 0; 1602 ins := TRUE; (* Insert mode *) 1603 LOOP 1604 l := Str.Length(S); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1605 IF p>l THEN p := l END; 1606 IO.WrStr(S); ClrEol; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1607 GotoXY(x+p,y); ***** ^ not supported yet ***** ^ not supported yet 1608 k := IO.RdCharDirect(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1609 IF k = 0C THEN (* Extended character *) 1610 CASE IO.RdCharDirect() OF ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1611 | CHR(75) : k := CHR(19); (* LeftArr -> ^S *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1612 | CHR(77) : k := CHR(4) ; (* RightArr -> ^D *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1613 | CHR(71) : k := CHR(1) ; (* Home -> ^A *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1614 | CHR(79) : k := CHR(6) ; (* End -> ^F *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1615 | CHR(83) : k := CHR(7) ; (* Del -> ^G *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1616 | CHR(82) : k := CHR(22); (* Ins -> ^V *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1617 END; 1618 END; 1619 CASE k OF 1620 | ' '..'~' : IF ins THEN Str.Insert(S,k,p); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1621 ELSIF p=l THEN Str.Append(S,k); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1622 ELSE S[p] := k; ***** ^ not supported yet ***** ^ not supported yet 1623 END; 1624 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 1625 | CHR(1) : p := 0; (* Home *) ***** ^ undeclared identifier ***** ^ not supported yet 1626 | CHR(6) : p := l; (* End *) ***** ^ undeclared identifier ***** ^ not supported yet 1627 | CHR(19) : IF p>0 THEN DEC(p) END; (* Left *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1628 | CHR(4) : IF p0 THEN (* BackSpace *) ***** ^ undeclared identifier ***** ^ not supported yet 1633 DEC(p); Str.Delete(S,p,1); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1634 END; 1635 | CHR(22) : ins := NOT ins; (* Toggle Ins/Ovr *) ***** ^ undeclared identifier ***** ^ not supported yet 1636 | CHR(13) : RETURN; (* Enter *) ***** ^ undeclared identifier ***** ^ not supported yet 1637 END; 1638 GotoXY(x,y); ***** ^ not supported yet ***** ^ not supported yet 1639 END; 1640 END InputStr; ***** ^ not supported yet 1641 1642 1643 (* ------------------------- *) 1644 (* Main initialization *) 1645 (* ------------------------- *) 1646 1647 CONST 1648 ClearOnEntry = TRUE; (* Change to FALSE if automatic clear *) 1649 1650 (*%F _OS2 *) 1651 VAR 1652 R : SYSTEM.Registers; 1653 WD : WinDef; 1654 1655 BEGIN 1656 (*%T _mthread *) 1657 Lock := NullProc; 1658 Unlock := NullProc; 1659 (*%E *) 1660 CoreWind._multip := FALSE; 1661 IO.WrStrRedirect := WriteOut; 1662 IO.RdStrRedirect := ReadString; 1663 CurrentScreenDepth := AbsCoord(CoreWind._getscreendepth()); 1664 IF NOT CoreWind._winsetup THEN 1665 CoreWind._initscreentype(CGASnow); 1666 R.AH := 3; 1667 R.BH := SHORTCARD(CoreWind._activepage()); 1668 Lib.Intr(R,10H); 1669 IF (R.CH<20H)AND(R.CL>0) THEN 1670 CoreWind._cursorlines := R.CX; 1671 ELSE 1672 CoreWind._cursorlines := 0607H; 1673 END; 1674 CoreWind._windowstack := NIL; 1675 NEW(UseListPtr(CoreWind._uselist)); 1676 UseListPtr(CoreWind._uselist)^.Next := NIL; (* dummy *) 1677 CoreWind._cursorstack := NIL; 1678 WD := FullScreenDef; 1679 WD.Y2 := CurrentScreenDepth; 1680 IF ClearOnEntry THEN 1681 FullScreen := Open(WD); 1682 ELSE 1683 WD.Hidden := TRUE; 1684 FullScreen := Open(WD); 1685 SnapShot; 1686 PutOnTop(FullScreen); 1687 GotoXY(ORD(R.DL)+1,ORD(R.DH)+1); 1688 END; 1689 ELSE 1690 FullScreen:=CoreWind._fullscreen; 1691 END; 1692 1693 (*%E *) 1694 1695 1696 (*%T _OS2 *) 1697 VAR 1698 Row, Col: CARDINAL; 1699 WD: WinDef; ***** ^ undeclared identifier 1700 BEGIN 1701 (*%T _mthread *) 1702 Lock := Process.Lock; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1703 Unlock := Process.Unlock; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1704 (*%E *) 1705 IO.WrStrRedirect := WriteOut; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1706 IO.RdStrRedirect := ReadString; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1707 CurrentScreenDepth := AbsCoord(CoreWind._getscreendepth()); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1708 IF NOT CoreWind._winsetup THEN ***** ^ undeclared identifier ***** ^ not supported yet 1709 RealMode := NOT Lib.ProtectedMode(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1710 IF Vio.GetCurType( CursorInfo, 0 ) = 0 THEN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1711 CoreWind._initscreentype(CGASnow); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 1712 CoreWind._windowstack := NIL; ***** ^ undeclared identifier ***** ^ not supported yet 1713 NEW(UseListPtr(CoreWind._uselist)); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1714 UseListPtr(CoreWind._uselist)^.Next := NIL; (* dummy *) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1715 CoreWind._cursorstack := NIL; ***** ^ undeclared identifier ***** ^ not supported yet 1716 WD := FullScreenDef; ***** ^ not supported yet ***** ^ undeclared identifier 1717 WD.Y2 := CurrentScreenDepth; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 1718 IF ClearOnEntry THEN ***** ^ not supported yet 1719 FullScreen := Open(WD); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1720 ELSE 1721 WD.Hidden := TRUE; ***** ^ not supported yet ***** ^ not supported yet 1722 FullScreen := Open(WD); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1723 SnapShot; ***** ^ not supported yet 1724 PutOnTop(FullScreen); ***** ^ not supported yet ***** ^ undeclared identifier 1725 Vio.GetCurPos(Row, Col, 0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1726 GotoXY(Col+1, Row+1); ***** ^ not supported yet ***** ^ not supported yet 1727 END; 1728 ELSE 1729 FullScreen := CoreWind._fullscreen; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 1730 END; 1731 (*%E *) 1732 1733 END Window. ***** ^ not supported yet 2239 errors