(* Release 3.10 *) (*-------------------------------------------------------------------------* * * * WINDOW.MOD - Clipping text windows * * * * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * * All Rights Reserved * * * *--------------------------------------------------------------------------*) (*%F _fdata *) (*# call(seg_name => null) *) (*# data(seg_name => null) *) (*%E *) (*# module(implementation=>off) *) (*# call(o_a_copy=>off) *) (*# check(stack=>off, index=>off, range=>off, overflow=>off, nil_ptr=>off) *) IMPLEMENTATION MODULE Window; (*%F _OS2 *) IMPORT SYSTEM, Str, Lib, IO, CoreSig; (*%E *) (*%T _OS2 *) IMPORT SYSTEM, Str, Lib, Vio, Dos, IO, CoreSig; (*%E *) (*%T _mthread *) IMPORT Process; (*%E *) FROM Storage IMPORT ALLOCATE,DEALLOCATE; TYPE UseListPtr = POINTER TO UseListLink; UseListLink = RECORD Next : UseListPtr; Proc : ADDRESS; Wind : WinType; END; VAR (*%T _mthread *) Lock,Unlock : LockProc; (*%E *) CONST GuardConst = 4A4EH; PROCEDURE CheckWindow(W:WinType); BEGIN IF W^.Guard - Seg(W^) # GuardConst THEN Lib.RunTimeError(CoreSig._FatalErrorPos(),30H,'Invalid Window'); END; (*IF*) END CheckWindow; PROCEDURE ClipFrame ( W : WinType ); VAR i : CARDINAL; BEGIN WITH W^ DO IF WDef.FrameOn THEN i := 1 ELSE i := 0 END; IF XA < WDef.X1+i THEN XA := WDef.X1+i ELSIF XA > WDef.X2-i THEN XA := WDef.X2-i END; IF XB > WDef.X2-i THEN XB := WDef.X2-i ELSIF XB < WDef.X1+i THEN XB := WDef.X1+i END; IF YA < WDef.Y1+i THEN YA := WDef.Y1+i ELSIF YA > WDef.Y2-i THEN YA := WDef.Y2-i END; IF YB > WDef.Y2-i THEN YB := WDef.Y2-i ELSIF YB < WDef.Y1+i THEN YB := WDef.Y1+i END; Width := XB-XA+1; Depth := YB-YA+1; END; END ClipFrame; PROCEDURE ClipXY ( W : WinType; VAR X,Y : RelCoord ); VAR mw,md : CARDINAL; BEGIN WITH W^ DO mw := Width; md := Depth; IF WDef.FrameOn AND NOT WDef.WrapOn THEN INC(md); INC(mw) ELSE IF X=0 THEN X := 1 END; IF Y=0 THEN Y := 1 END; END; IF X>mw THEN X := mw END; IF Y>md THEN Y := md END; END; END ClipXY; PROCEDURE BufferSpaceFill ( W : WinType; pos : CARDINAL; len : CARDINAL ); BEGIN WITH W^ DO IF IsPalette THEN Lib.WordFill(ADR(Buffer^[pos]),len,32 +VAL(CARDINAL,CurPalColor)*256); ELSE Lib.WordFill(ADR(Buffer^[pos]),len,32+ ORD(WDef.Foreground)*256+ORD(WDef.Background)*4096); END; END; END BufferSpaceFill; PROCEDURE CurWin () : WinType; (* Returns The current window being used for output for this process *) (* If no window assigned by Use then returns Top. *) (* NB Locks window system and leaves locked if _mthread set. *) VAR u : UseListPtr; p : ADDRESS; BEGIN (*%T _mthread *) Lock(); (*%E *) IF CoreWind._multip THEN (*%T _mthread *) p := SYSTEM.CurrentProcess(); (*%E *) (*%F _mthread *) p := NIL; (*%E *) u := UseListPtr(CoreWind._uselist)^.Next; LOOP IF u = NIL THEN RETURN WinType(CoreWind._windowstack); (* Top() *) ELSIF p = u^.Proc THEN RETURN u^.Wind; END; (*IF*) u := u^.Next; END; (*LOOP*) END; (*IF*) u := UseListPtr(CoreWind._uselist)^.Next; IF u = NIL THEN RETURN WinType(CoreWind._windowstack); (* Top() *) END; (*IF*) RETURN u^.Wind; END CurWin; (*%F _OS2 *) PROCEDURE ResetCursor; VAR R : SYSTEM.Registers; mode : CARDINAL; BEGIN IF (CoreWind._cursorstack = NIL) OR ObscuredAt(WinType(CoreWind._cursorstack),WinType(CoreWind._cursorstack)^.CurrentX,WinType(CoreWind._cursorstack)^.CurrentY) THEN mode := 2000H; ELSE WITH WinType(CoreWind._cursorstack)^ DO WITH R DO AH := 2; BH := SHORTCARD(CoreWind._activepage()); DL := SHORTCARD(XA+CurrentX-1); DH := SHORTCARD(YA+CurrentY-1); END; Lib.Intr(R,10H); END; mode := CoreWind._cursorlines; END; R.AH := 1; R.CX := mode; Lib.Intr(R,10H); END ResetCursor; (*%E *) (*%T _OS2 *) VAR CursorInfo : Vio.CURSORINFO; RealMode : BOOLEAN; PROCEDURE ResetCursor; VAR r : CARDINAL; BEGIN IF (CoreWind._cursorstack = NIL) OR ObscuredAt(WinType(CoreWind._cursorstack),WinType(CoreWind._cursorstack)^.CurrentX,WinType(CoreWind._cursorstack)^.CurrentY) THEN CursorInfo.attr := MAX(CARDINAL); ELSE WITH WinType(CoreWind._cursorstack)^ DO r := Vio.SetCurPos(YA+CurrentY-1,XA+CurrentX-1,0 ); END; CursorInfo.attr := 0; END; r := Vio.SetCurType( CursorInfo,0); END ResetCursor; (*%E *) PROCEDURE UnlinkCursor ( W : WinType ); VAR w : WinType; BEGIN w := WinType(CoreWind._cursorstack); IF w = W THEN CoreWind._cursorstack := w^.CursorChain END; LOOP IF w = NIL THEN RETURN END; IF w^.CursorChain = W THEN w^.CursorChain := W^.CursorChain; RETURN; END; w := w^.CursorChain; END; END UnlinkCursor; (* ------------------------- *) (* Cursor Control *) (* ------------------------- *) PROCEDURE CursorOn; VAR w,cw : WinType; BEGIN cw := CurWin(); UnlinkCursor(cw); cw^.WDef.CursorOn := TRUE; IF NOT cw^.WDef.Hidden THEN cw^.CursorChain := WinType(CoreWind._cursorstack); CoreWind._cursorstack := cw; END; ResetCursor; (*%T _mthread *) Unlock(); (*%E *) END CursorOn; PROCEDURE CursorOff; VAR w,cw : WinType; BEGIN cw := CurWin(); UnlinkCursor(cw); cw^.WDef.CursorOn := FALSE; ResetCursor; (*%T _mthread *) Unlock(); (*%E *) END CursorOff; (* ------------------------- *) (* Window creation *) (* ------------------------- *) PROCEDURE MakeWindow ( VAR WD : WinDef ) : WinType; (* Creates a new Window descriptor The size is Inclusive of frame if needed does not allocate buffer *) VAR W : WinType; min : CARDINAL; BEGIN NEW(W); WITH W^ DO WITH WD DO IF X2 >= ScreenWidth THEN X2:=ScreenWidth-1 END; IF Y2 >= CurrentScreenDepth THEN Y2:=CurrentScreenDepth-1 END; IF WD.FrameOn THEN min := 2 ELSE min := 0 END; IF (X1+min>X2) THEN X2 := X1+min END; IF (Y1+min>Y2) THEN Y2 := Y1+min END; XA := X1; YA := Y1; XB := X2; YB := Y2; Width := X2-X1+1; Depth := Y2-Y1+1; END; WDef := WD; OWidth := Width; ODepth := Depth; CurrentX := 1; CurrentY := 1; Next := NIL; Buffer := NIL; UserRecord := NIL; IsPalette := FALSE; CurPalColor := NormalPaletteColor; TMode := NoTitle; Guard := GuardConst+CARDINAL(Seg(W^)); CursorChain := NIL; Title := NIL; END; ClipFrame(W); RETURN W; END MakeWindow; PROCEDURE Open ( WD : WinDef ) : WinType; (* Opens a window on the screen ready for use *) VAR W : WinType; BEGIN (*%T _mthread *) Lock(); (*%E *) W := MakeWindow (WD); WITH W^ DO ALLOCATE ( Buffer,OWidth*ODepth*2); BufferSpaceFill(W,0,OWidth*ODepth); IF WD.FrameOn THEN SetFrame(W,WDef.FrameDef,WDef.FrameFore,WDef.FrameBack); END; END; IF WD.Hidden THEN Use ( W ) ELSE PutOnTop ( W ) END; (*%T _mthread *) Unlock(); (*%E *) RETURN W; END Open; (* ------------------------- *) (* Window stack manipulation *) (* and screen redraw *) (* ------------------------- *) PROCEDURE Use ( W : WinType ); (* Causes all subsequent output (by the current process) to appear in the specified Window NB does not have to be Top Window (or in fact on the screen at all) UseListPtr(CoreWind._uselist) is the MRU window *) VAR p : ADDRESS; u : UseListPtr; up : UseListPtr; BEGIN (*%T _mthread *) Lock(); (*%E *) CheckWindow(W); (*%T _mthread *) p := SYSTEM.CurrentProcess(); (*%E *) (*%F _mthread *) p := NIL; (*%E *) up := UseListPtr(CoreWind._uselist); u := up^.Next; LOOP IF u = NIL THEN NEW(u); u^.Proc := p; EXIT END; IF p = u^.Proc THEN up^.Next := u^.Next; EXIT END; up := u; u := u^.Next; END; u^.Next := UseListPtr(CoreWind._uselist)^.Next; UseListPtr(CoreWind._uselist)^.Next := u; u^.Wind := W; (*%T _mthread *) Unlock(); (*%E *) END Use; PROCEDURE TakeOffStack ( W : WinType ); (* Private *) VAR pw : WinType; BEGIN IF W = WinType(CoreWind._windowstack) THEN CoreWind._windowstack := W^.Next; ELSE pw := WinType(CoreWind._windowstack); IF W # pw THEN LOOP IF (pw = NIL) THEN EXIT END; IF (pw^.Next = W) THEN pw^.Next := W^.Next; EXIT END; pw := pw^.Next; END; END; END; W^.Next := NIL; END TakeOffStack; PROCEDURE UpdateScreen ( W : WinType; X,Y : AbsCoord; Len : CARDINAL ); (* Updates the screen from the window buffer *) VAR NextLen, NextX : AbsCoord; w : WinType; oxa,oxb,ax,bx : AbsCoord; buff : ARRAY[0..ScreenWidth-1] OF CARDINAL; a : ADDRESS; BEGIN IF W^.WDef.Hidden THEN RETURN END; WHILE Len#0 DO (* adjust co ordinates for crossing windows *) NextLen := 0; w := WinType(CoreWind._windowstack); ax := X; bx := X+Len-1; LOOP IF (w = W)OR(w=NIL) THEN EXIT END; WITH w^ DO IF (Y>=WDef.Y1) AND (Y<=WDef.Y2) THEN oxa := WDef.X1; oxb := WDef.X2; IF (ax>=oxa) AND (bx<=oxb) THEN (* wiped out *) ax := bx+1; EXIT; ELSIF (ax<=oxb) AND (bx>=oxa) THEN (* some interaction *) IF (axoxb) THEN (* cut into two *) bx := oxa-1; NextX := oxb+1; NextLen := X+Len-NextX; ELSIF (bx>oxb) THEN (* left edge cut off *) ax := oxb+1; ELSIF (ax=NW^.WDef.X1)AND(NW^.WDef.X2>=WDef.X1) AND (WDef.Y2>=NW^.WDef.Y1)AND(NW^.WDef.Y2>=WDef.Y1)) THEN (* windows cross *) (* calculate Intersection *) IF WDef.X1>NW^.WDef.X1 THEN x1 := WDef.X1 ELSE x1 := NW^.WDef.X1 END; IF WDef.X2NW^.WDef.Y1 THEN y1 := WDef.Y1 ELSE y1 := NW^.WDef.Y1 END; IF WDef.Y2= WDef.Y1) AND (Y <= WDef.Y2) AND (X >= WDef.X1) AND (X <= WDef.X2) THEN EXIT END; W := Next; END; END; (*%T _mthread *) Unlock(); (*%E *) RETURN W; END At; PROCEDURE ObscuredAt (W : WinType; X,Y : RelCoord ) : BOOLEAN; (* Returns if the specified window is obscured at the specified position *) VAR b : BOOLEAN; w : WinType; BEGIN (*%T _mthread *) Lock(); (*%E *) CheckWindow(W); WITH W^ DO IF WDef.Hidden THEN b:= TRUE; ELSE INC(X,XA-1); INC(Y,YA-1); w := WinType(CoreWind._windowstack); LOOP IF w = W THEN b := FALSE; EXIT END; IF w = NIL THEN b := TRUE; EXIT END; WITH w^ DO IF (Y>=WDef.Y1) AND (Y<=WDef.Y2) AND (X>=WDef.X1) AND (X<=WDef.X2) THEN b := TRUE; EXIT END; w := Next; END; END; END; END; (*%T _mthread *) Unlock(); (*%E *) RETURN b; END ObscuredAt; PROCEDURE WindowWrite ( W : WinType; x,y : RelCoord; Len : CARDINAL; str : ADDRESS; frame : BOOLEAN ); (* Private *) VAR Attr : CARDINAL; X,Y : AbsCoord; BEGIN IF Len>0 THEN WITH W^ DO IF IsPalette THEN IF frame THEN Attr := VAL(CARDINAL,FramePaletteColor); ELSE Attr := VAL(CARDINAL,CurPalColor); END; ELSIF frame THEN Attr := ORD(WDef.FrameFore)+ORD(WDef.FrameBack)*16; ELSE Attr := ORD(WDef.Foreground)+ORD(WDef.Background)*16; END; X := x+XA-1; Y := y+YA-1; IF Len+X-1 > WDef.X2 THEN Len := WDef.X2+1-X END; CoreWind._bufferwrite (ADR(Buffer^[X-WDef.X1+(Y-WDef.Y1)*OWidth]),str,Len,Attr); UpdateScreen(W,X,Y,Len); END; END; END WindowWrite; PROCEDURE DrawFrame ( W : WinType ); VAR s : ARRAY[0..81] OF CHAR; w,l,tl : CARDINAL; i : CARDINAL; PROCEDURE PutTitle ( mode : CARDINAL; row : CARDINAL ); VAR i,j : CARDINAL; BEGIN WITH W^ DO CASE mode OF 0 : i := 1 | 1 : i := (Width-tl) DIV 2 + 1; | 2 : i := Width+1-tl | ELSE i := MAX(CARDINAL); END; j := 0; WHILE (i<=Width)AND(jWidth THEN tl := Width END; END; PutTitle(ORD(TMode-LeftUpperTitle),0); (* Sides *) FOR i := 1 TO Depth DO WindowWrite(W,0,i,1,ADR(WDef.FrameDef[3]),TRUE); WindowWrite(W,Width+1,i,1,ADR(WDef.FrameDef[4]),TRUE); END; s[0] := WDef.FrameDef[5]; Lib.Fill(ADR(s[1]),Width,WDef.FrameDef[6]); s[Width+1] := WDef.FrameDef[7]; PutTitle(ORD(TMode-LeftLowerTitle),Depth+1); END; END DrawFrame; PROCEDURE SetFrame ( W : WinType; Frame : FrameStr; Fore, Back : Color ); (* Put a frame around the specified window With Title String and border definition (see above) having specified fore/background colours for the border *) BEGIN (*%T _mthread *) Lock(); (*%E *) CheckWindow(W); WITH W^ DO WDef.FrameDef := Frame; WDef.FrameFore := Fore; WDef.FrameBack := Back; END; DrawFrame(W); (*%T _mthread *) Unlock(); (*%E *) END SetFrame; PROCEDURE MergeWindows ( s,d : WinType ); (* slightly complicated procedure to merge two windows s is new (hidden) window d is old window to be merged into *) VAR w : WinDescriptor; r,wd : CARDINAL; sw,sd,so,sp : CARDINAL; dw,dd,do,dp : CARDINAL; BEGIN s^.CurrentX := d^.CurrentX; s^.CurrentY := d^.CurrentY; s^.CursorChain := d^.CursorChain; s^.UserRecord := d^.UserRecord; s^.CurPalColor := d^.CurPalColor; s^.Title := d^.Title; s^.TMode := d^.TMode; d^.TMode := NoTitle; d^.WDef.CursorOn := FALSE; w := d^; d^ := s^; s^ := w; WITH s^ DO sw := OWidth; sd := ODepth; IF WDef.FrameOn THEN DEC(sw,2); DEC(sd,2); sp := (OWidth+1); ELSE sp := 0; END; Guard := GuardConst+CARDINAL(Seg(s^)); END; WITH d^ DO dw := OWidth; dd := ODepth; IF WDef.FrameOn THEN DEC(dw,2); DEC(dd,2); dp := OWidth+1; ELSE dp := 0; END; Guard := GuardConst+CARDINAL(Seg(d^)); END; IF sd < dd THEN wd := sd ELSE wd := dd END; FOR r := 0 TO wd-1 DO IF sw>=dw THEN Lib.WordMove(ADR(s^.Buffer^[sp]),ADR(d^.Buffer^[dp]),dw); ELSE Lib.WordMove(ADR(s^.Buffer^[sp]),ADR(d^.Buffer^[dp]),sw); BufferSpaceFill(d,dp+sw,dw-sw); END; INC(sp,s^.OWidth); INC(dp,d^.OWidth); END; (* now fill rest *) IF wd
= m THEN RETURN FALSE END; IF ODD(p) THEN RETURN TRUE END; INC(p); END; END; END PaletteColorUsed; (* ------------------------- *) (* Move resize procedure *) (* ------------------------- *) PROCEDURE Change(W:WinType;X1,Y1,X2,Y2:AbsCoord); (* Changes the size and/or position of the specified window The *) (* contents of the window will be moved with it *) VAR nw : WinType; wd : WinDef; pal : PaletteDef; save : WinType; min : CARDINAL; BEGIN CheckWindow(W); save := CurWin(); WITH W^ DO IF X2 >= ScreenWidth THEN X2 := ScreenWidth - 1; END; (*IF*) IF Y2 >= CurrentScreenDepth THEN Y2 := CurrentScreenDepth - 1; END; (*IF*) wd := WDef; IF wd.FrameOn THEN min := 2; ELSE min := 0; END; (*IF*) IF (X1 + min > X2) OR (Y1 + min > Y2) THEN (*%T _mthread *) Unlock(); (*%E *) RETURN; END; (*IF*) wd.X1 := X1; wd.Y1 := Y1; wd.X2 := X2; wd.Y2 := Y2; wd.Hidden := TRUE; IF IsPalette THEN GetPal(W,pal); nw := PaletteOpen(wd,pal); ELSE nw := Open(wd); END; (*IF*) MergeWindows(nw,W); ClipFrame (W); IF CurrentX > Width THEN CurrentX := Width; END; (*IF*) IF CurrentY > Depth THEN CurrentY := Depth; END; (*IF*) ResetCursor; END; (*WITH*) Use(save); (* restore used window *) (*%T _mthread *) Unlock(); (*%E *) END Change; (* ------------------------- *) (* Multi process support *) (* ------------------------- *) PROCEDURE NullProc; BEGIN END NullProc; PROCEDURE SetProcessLocks ( LockProc,UnlockProc : LockProc ); BEGIN (*%T _mthread *) Lock := LockProc; Unlock := UnlockProc; CoreWind._multip := TRUE; (*%E *) END SetProcessLocks; (* ------------------------- *) (* Window output *) (* ------------------------- *) PROCEDURE DeleteLine ( W : WinType; Y : RelCoord ); VAR r,p : CARDINAL; BEGIN CheckWindow(W); WITH W^ DO p := XA-WDef.X1+(YA-WDef.Y1+Y-1)*OWidth; FOR r := Y TO Depth-1 DO Lib.Move(ADR(Buffer^[p+OWidth]),ADR(Buffer^[p]),Width*2); INC(p,OWidth); END; BufferSpaceFill(W,p,Width); RedrawSection ( W,XA,Y+YA-1,XB,YB ); END; END DeleteLine; PROCEDURE Clear; (* clears the current window *) VAR r,p : CARDINAL; W : WinType; BEGIN W := CurWin(); WITH W^ DO p := XA-WDef.X1+(YA-WDef.Y1)*OWidth; FOR r := 1 TO Depth DO BufferSpaceFill(W,p,Width); INC(p,OWidth); END; RedrawWindowPane(W); END; IGotoXY(W,1,1); (*%T _mthread *) Unlock(); (*%E *) END Clear; PROCEDURE ClrEol; (* clears from the cursor to the end of line *) VAR W : WinType; BEGIN W := CurWin(); WITH W^ DO BufferSpaceFill(W,XA-WDef.X1+CurrentX-1+(YA-WDef.Y1+CurrentY-1)*OWidth, Width-CurrentX+1); RedrawSection ( W,XA-1+CurrentX,YA-1+CurrentY,XB,YA-1+CurrentY ); END; (*%T _mthread *) Unlock(); (*%E *) END ClrEol; (*%F _OS2 *) PROCEDURE Bell; VAR R : SYSTEM.Registers; BEGIN WITH R DO AX := 0E07H; BL := 0; Lib.Intr(R,10H); END; END Bell; (*%E *) (*%T _OS2 *) PROCEDURE Bell; BEGIN Dos.Beep(1000,300); END Bell; (*%E *) PROCEDURE WriteC ( W : WinType; C : CHAR); VAR nx : CARDINAL; BEGIN WITH W^ DO CASE C OF CHR(12) : Clear; IGotoXY(W,1,1); | CHR(10) : IF CurrentY=Depth THEN DeleteLine ( W, 1 ); ELSE IGotoXY(W,CurrentX,CurrentY+1); END; | CHR(13) : (*ClrEol; change 1/7/88*) IGotoXY(W,1,CurrentY); | CHR(08) : IF CurrentX>1 THEN IGotoXY(W,CurrentX-1,CurrentY); WriteC(W,' '); IGotoXY(W,CurrentX-1,CurrentY); END; | CHR(7) : Bell; ELSE IF CurrentX > Width THEN RETURN END; WindowWrite(W,CurrentX,CurrentY,1,ADR(C),FALSE); IF (CurrentX#Width)OR NOT WDef.WrapOn THEN IGotoXY(W,CurrentX+1,CurrentY); ELSE IF CurrentY=Depth THEN DeleteLine ( W, 1 ); IGotoXY(W,1,CurrentY); ELSE IGotoXY(W,1,CurrentY+1); END; END; END; END; END WriteC; PROCEDURE WriteOut (S : ARRAY OF CHAR); VAR W : WinType; p,q,m : CARDINAL; ss : CARDINAL; BEGIN W := CurWin(); WITH W^ DO ss := HIGH(S)+1; p := 0; q := 0; LOOP (* first accumulate normal chars on same line *) m := Width+p-CurrentX; IF NOT W^.WDef.WrapOn THEN INC(m) END; (* can fit another char in *) IF m > ss THEN m := ss END; WHILE (q=' ') DO INC(q) END; (* now output the line *) IF q > p THEN WindowWrite(W,CurrentX,CurrentY,q-p,ADR(S[p]),FALSE); IGotoXY(W,CurrentX+q-p,CurrentY); END; (* now output the special char *) IF (S[q] = CHR(0)) OR (q > HIGH(S)) THEN EXIT ELSE WriteC(W,S[q]); END; INC(q); p := q; END; END; (*%T _mthread *) Unlock(); (*%E *) END WriteOut; PROCEDURE DirectWrite ( X,Y : RelCoord; (* start co-ords *) A : ADDRESS; (* address of char array *) Len : CARDINAL ); (* length to be written *) (* writes directly to current window at the specified X,Y coordinates with no check for special (ie control) chars or eol wrap *) VAR W : WinType; BEGIN W := CurWin(); WindowWrite(W,X,Y,Len,A,FALSE); (*%T _mthread *) Unlock(); (*%E *) END DirectWrite; PROCEDURE GotoXY ( X,Y : RelCoord ); VAR W : WinType; BEGIN W := CurWin(); ClipXY(W,X,Y); IGotoXY(W,X,Y); (*%T _mthread *) Unlock(); (*%E *) END GotoXY; PROCEDURE WhereX ( ) : RelCoord; VAR W : WinType; BEGIN W := CurWin(); (*%T _mthread *) Unlock(); (*%E *) RETURN W^.CurrentX; END WhereX; PROCEDURE WhereY ( ) : RelCoord; VAR W : WinType; BEGIN W := CurWin(); (*%T _mthread *) Unlock(); (*%E *) RETURN W^.CurrentY; END WhereY; PROCEDURE ConvertCoords ( W : WinType ; X,Y : RelCoord; VAR XO,YO : AbsCoord ); BEGIN CheckWindow(W); XO := X+W^.XA-1; YO := Y+W^.YA-1; END ConvertCoords; PROCEDURE InsLine; VAR W : WinType; r,p,p1 : CARDINAL; BEGIN W := CurWin(); WITH W^ DO p := XA-WDef.X1+(YA-WDef.Y1+Depth-1)*OWidth; FOR r := CurrentY TO Depth-1 DO DEC(p,OWidth); Lib.Move(ADR(Buffer^[p]),ADR(Buffer^[p+OWidth]),Width*2); END; BufferSpaceFill(W,p,Width); RedrawSection ( W,XA,CurrentY+YA-1,XB,YB ); END; (*%T _mthread *) Unlock(); (*%E *) END InsLine; PROCEDURE DelLine; VAR W : WinType; BEGIN W := CurWin(); DeleteLine(W,W^.CurrentY); (*%T _mthread *) Unlock(); (*%E *) END DelLine; PROCEDURE TextColor ( c : Color ); VAR W : WinType; BEGIN W := CurWin(); W^.WDef.Foreground := c; (*%T _mthread *) Unlock(); (*%E *) END TextColor; PROCEDURE TextBackground ( c : Color ); VAR W : WinType; BEGIN W := CurWin(); W^.WDef.Background := c; (*%T _mthread *) Unlock(); (*%E *) END TextBackground; PROCEDURE SetWrap ( on : BOOLEAN ); VAR W : WinType; BEGIN W := CurWin(); W^.WDef.WrapOn := on; (*%T _mthread *) Unlock(); (*%E *) END SetWrap; PROCEDURE Info ( W : WinType; VAR WD : WinDef ); (* gets information for specified window *) BEGIN (*%T _mthread *) Lock(); (*%E *) WD := W^.WDef; (*%T _mthread *) Unlock(); (*%E *) END Info; (* ------------------------- *) (* Title procedure *) (* ------------------------- *) PROCEDURE SetTitle ( W : WinType; NewTitle : ARRAY OF CHAR; Mode : TitleMode ); (* updates the window title within the window frame, positioning it in the position defined by the title mode *) VAR l : CARDINAL; BEGIN CheckWindow(W); (*%T _mthread *) Lock(); (*%E *) DisposeTitle(W); WITH W^ DO IF Mode # NoTitle THEN l := Str.Length(NewTitle); ALLOCATE(Title,l+1); Lib.Move(ADR(NewTitle),ADR(Title^),l); Title^[l] := CHR(0); END; TMode := Mode; END; DrawFrame(W); (*%T _mthread *) Unlock; (*%E *) END SetTitle; PROCEDURE ReadString ( VAR string : ARRAY OF CHAR ); VAR c : CHAR; line: ARRAY[0..82] OF CHAR; p,H : CARDINAL; W : WinType; con : BOOLEAN; BEGIN W := CurWin(); PutOnTop(W); con := W^.WDef.CursorOn; CursorOn; H := HIGH(string); IF H>79 THEN H := 79 END; p := 0; LOOP c := IO.RdKey(); IF (c=CHR(8))OR(c=CHR(127)) THEN IF p>0 THEN DEC(p); IO.WrChar(CHR(8)) END; ELSIF (c>=' ') THEN IF p<=H THEN IO.WrChar(c); line[p] := c; INC(p); END; ELSIF c=CHR(13) THEN EXIT; END; END; line[p] := CHR(0); Str.Copy(string,line); IF NOT con THEN CursorOff END; (*%T _mthread *) Unlock; (*%E *) IO.WrLn; END ReadString; (* Low level routines to read and write to the window buffer direct *) PROCEDURE RdBufferLn ( W : WinType; (* Source window *) X,Y : RelCoord; (* start co-ords *) Dest : ADDRESS; (* address of buffer *) Len : CARDINAL ); (* length in WORDs *) VAR AX,AY : AbsCoord; BEGIN WITH W^ DO AX := X+XA-1; AY := Y+YA-1; Lib.WordMove(ADR(Buffer^[AX-WDef.X1+(AY-WDef.Y1)*OWidth]),Dest,Len); END; END RdBufferLn; PROCEDURE WrBufferLn ( W : WinType; (* Dest window *) X,Y : RelCoord; (* start co-ords *) Src : ADDRESS; (* address of buffer *) Len : CARDINAL ); (* length in WORDs *) VAR AX,AY : AbsCoord; BEGIN WITH W^ DO AX := X+XA-1; AY := Y+YA-1; Lib.WordMove(Src,ADR(Buffer^[AX-WDef.X1+(AY-WDef.Y1)*OWidth]),Len); UpdateScreen(W,AX,AY,Len); END; END WrBufferLn; PROCEDURE InputStr ( VAR S : ARRAY OF CHAR ); VAR ins : BOOLEAN; k : CHAR; x,y,p,l : CARDINAL; BEGIN x := WhereX(); y := WhereY(); p := MAX(CARDINAL); p := 0; ins := TRUE; (* Insert mode *) LOOP l := Str.Length(S); IF p>l THEN p := l END; IO.WrStr(S); ClrEol; GotoXY(x+p,y); k := IO.RdCharDirect(); IF k = 0C THEN (* Extended character *) CASE IO.RdCharDirect() OF | CHR(75) : k := CHR(19); (* LeftArr -> ^S *) | CHR(77) : k := CHR(4) ; (* RightArr -> ^D *) | CHR(71) : k := CHR(1) ; (* Home -> ^A *) | CHR(79) : k := CHR(6) ; (* End -> ^F *) | CHR(83) : k := CHR(7) ; (* Del -> ^G *) | CHR(82) : k := CHR(22); (* Ins -> ^V *) END; END; CASE k OF | ' '..'~' : IF ins THEN Str.Insert(S,k,p); ELSIF p=l THEN Str.Append(S,k); ELSE S[p] := k; END; INC(p); | CHR(1) : p := 0; (* Home *) | CHR(6) : p := l; (* End *) | CHR(19) : IF p>0 THEN DEC(p) END; (* Left *) | CHR(4) : IF p0 THEN (* BackSpace *) DEC(p); Str.Delete(S,p,1); END; | CHR(22) : ins := NOT ins; (* Toggle Ins/Ovr *) | CHR(13) : RETURN; (* Enter *) END; GotoXY(x,y); END; END InputStr; (* ------------------------- *) (* Main initialization *) (* ------------------------- *) CONST ClearOnEntry = TRUE; (* Change to FALSE if automatic clear *) (*%F _OS2 *) VAR R : SYSTEM.Registers; WD : WinDef; BEGIN (*%T _mthread *) Lock := NullProc; Unlock := NullProc; (*%E *) CoreWind._multip := FALSE; IO.WrStrRedirect := WriteOut; IO.RdStrRedirect := ReadString; CurrentScreenDepth := AbsCoord(CoreWind._getscreendepth()); IF NOT CoreWind._winsetup THEN CoreWind._initscreentype(CGASnow); R.AH := 3; R.BH := SHORTCARD(CoreWind._activepage()); Lib.Intr(R,10H); IF (R.CH<20H)AND(R.CL>0) THEN CoreWind._cursorlines := R.CX; ELSE CoreWind._cursorlines := 0607H; END; CoreWind._windowstack := NIL; NEW(UseListPtr(CoreWind._uselist)); UseListPtr(CoreWind._uselist)^.Next := NIL; (* dummy *) CoreWind._cursorstack := NIL; WD := FullScreenDef; WD.Y2 := CurrentScreenDepth; IF ClearOnEntry THEN FullScreen := Open(WD); ELSE WD.Hidden := TRUE; FullScreen := Open(WD); SnapShot; PutOnTop(FullScreen); GotoXY(ORD(R.DL)+1,ORD(R.DH)+1); END; ELSE FullScreen:=CoreWind._fullscreen; END; (*%E *) (*%T _OS2 *) VAR Row, Col: CARDINAL; WD: WinDef; BEGIN (*%T _mthread *) Lock := Process.Lock; Unlock := Process.Unlock; (*%E *) IO.WrStrRedirect := WriteOut; IO.RdStrRedirect := ReadString; CurrentScreenDepth := AbsCoord(CoreWind._getscreendepth()); IF NOT CoreWind._winsetup THEN RealMode := NOT Lib.ProtectedMode(); IF Vio.GetCurType( CursorInfo, 0 ) = 0 THEN END; CoreWind._initscreentype(CGASnow); CoreWind._windowstack := NIL; NEW(UseListPtr(CoreWind._uselist)); UseListPtr(CoreWind._uselist)^.Next := NIL; (* dummy *) CoreWind._cursorstack := NIL; WD := FullScreenDef; WD.Y2 := CurrentScreenDepth; IF ClearOnEntry THEN FullScreen := Open(WD); ELSE WD.Hidden := TRUE; FullScreen := Open(WD); SnapShot; PutOnTop(FullScreen); Vio.GetCurPos(Row, Col, 0); GotoXY(Col+1, Row+1); END; ELSE FullScreen := CoreWind._fullscreen; END; (*%E *) END Window.