Topspeed_JPI/TS/MODBASE/WINDOWPR.MOD

IMPLEMENTATION MODULE WindowPrims;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/windowpr.mov   1.9   17 Mar 1991 18:01:28   coleb  $
 *
 *)

(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)

IMPORT ErrorManager;
IMPORT KbdInput;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT Numbers;
IMPORT PosUtils;
IMPORT SmartScreen;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT StringIO;
IMPORT VStorage;
IMPORT VWindows;

IMPORT SYSTEM;
IMPORT FAPI;

VAR
  Initialized : BOOLEAN;


  CONST
    blank = ' ';
    null = '';
    InsufficientMemory = 'WindowPr -- Too little memory';
    StackError = 'Misuse of Push/Pop routines in WindowPrims';
    OS2Error =' os/2 returned error from Video subsystem';
    backspace = 10C;
    CarriageReturn = 15C;

    lftcol =  4;
    toprow =  3;
    rtcol  = 44;
    btmrow = 14;
    midcol = 24;
    midrow =  9;
      (* These define the starting points for the 4 msg box areas *)

   TYPE
     Cell =
       RECORD
         Char, Attribute: CHAR;
       END;

  VAR
    StartingCursorHt : CARDINAL;
    NilValue : VStorage.MemHandle;


  PROCEDURE GetCursorCoords(VAR column, row : CARDINAL);
    BEGIN
      IF FAPI.VIOGETCURPOS(SYSTEM.ADR(row), SYSTEM.ADR(column), 0) # 0 THEN
        ErrorManager.WARN("VioGetCurPos");
      END;
        (* Remember that the Repertoire convention is to number
           the top left corner 1,1; OS/2 numbers it 0,0.  We ought
           to follow the OS/2 convention, probably, but changing
           now would be difficult. *)
      INC(column);
      INC(row);
    END GetCursorCoords;


  PROCEDURE left();
  (*Moves the cursor one space left.*)
    VAR
      col, row : CARDINAL;
    BEGIN
      GetCursorCoords(col, row);
      col := col-1;
      SmartScreen.GotoXY(col, row);
    END left;

  PROCEDURE right();
  (*Moves the cursor one space right.*)
    VAR
      col, row : CARDINAL;
    BEGIN
      GetCursorCoords(col, row);
      col := col+1;
      SmartScreen.GotoXY(col, row);
    END right;

  PROCEDURE up();
  (*Moves the cursor one row up.*)
    VAR
      col, row : CARDINAL;
    BEGIN
      GetCursorCoords(col, row);
      row := row-1;
      SmartScreen.GotoXY(col, row);
    END up;

  PROCEDURE down();
  (*Moves the cursor one row down.*)
    VAR
      col, row : CARDINAL;
    BEGIN
      GetCursorCoords(col, row);
      row := row+1;
      SmartScreen.GotoXY(col, row);
    END down;

  PROCEDURE coord(ColNum, RowNum : CARDINAL) : CARDINAL;
   (*Makes it easier to work WITH the routines below, which
         treat the screen as a linear sequence OF 4000 bytes.*)
    BEGIN
      RETURN (Numbers.Between(0,RowNum-1,SmartScreen.MaxRow-1) *
          SmartScreen.MaxCol+ Numbers.Between(1,ColNum,
          SmartScreen.MaxCol));
    END coord;

  PROCEDURE WriteVidCh(spot : CARDINAL; TheChar : SmartScreen.VideoMemChar);
    BEGIN
      SmartScreen.NominalCol := spot MOD SmartScreen.MaxCol;
      SmartScreen.NominalRow := (spot DIV SmartScreen.MaxCol)+1;
      CASE SmartScreen.VideoMethod OF
        SmartScreen.DMA, SmartScreen.ROM :
        IF FAPI.VIOWRTCELLSTR( SYSTEM.ADR(TheChar), 1,
            SmartScreen.NominalRow, SmartScreen.NominalCol, 0) # 0 THEN
          ErrorManager.WARN(OS2Error);
        END;
      ELSE
        SmartScreen.GotoXY(SmartScreen.NominalCol, SmartScreen.NominalRow);
        StringIO.WriteStr(StringIO.outp, TheChar.ch);
      END;
    END WriteVidCh;


  TYPE
    CoordStackPtr = POINTER TO CoordStackElem;
    CoordStackElem =
      RECORD
        col, row: CARDINAL;
        prv: CoordStackPtr;
      END;
  VAR
    CoordStackTop: CoordStackPtr;

  PROCEDURE PushCursorCoords();
    (*For temporary storage of a cursor position.*)
    VAR
      tmp: CoordStackPtr;
    BEGIN
      VStorage.DosAlloc( tmp, SYSTEM.TSIZE(CoordStackElem) );
      tmp^.prv := CoordStackTop;
      WITH tmp^ DO
        GetCursorCoords( col, row );
      END;
      CoordStackTop := tmp;
    END PushCursorCoords;

  PROCEDURE PopCursorCoords();
    VAR
      tmp: CoordStackPtr;
    BEGIN
      tmp := CoordStackTop;
      IF tmp = NIL THEN
        ErrorManager.WARN( StackError );
      END;
      WITH tmp^ DO
        SmartScreen.GotoXY( col, row );
        SmartScreen.NominalCol := col;
        SmartScreen.NominalRow := row;
      END;
      CoordStackTop := CoordStackTop^.prv;
      VStorage.DosDealloc( tmp, SYSTEM.TSIZE(CoordStackElem) );
    END PopCursorCoords;

  PROCEDURE GetCursorHeight(): CARDINAL;
    VAR
      CursorData: FAPI.VIOCURSORINFO;
      ErrorNum, height: CARDINAL;
    BEGIN
      ErrorNum := FAPI.VIOGETCURTYPE( SYSTEM.ADR(CursorData), 0 );
      IF ErrorNum # 0 THEN
        ErrorManager.WarnNumber("VIOGETCURTYPE error", ErrorNum);
      END;
      IF (CursorData.cEnd<CursorData.yStart) OR
        (CursorData.attr=CARDINAL(-1)) THEN
        height := 0;
      ELSE
        height := (CursorData.cEnd - CursorData.yStart) + 1;
      END;
      RETURN height;
    END GetCursorHeight;


  TYPE
    HtStackPtr = POINTER TO HtStackElem;
    HtStackElem =
      RECORD
        ht: CARDINAL;
        prv: HtStackPtr;
      END;
  VAR
    HtStackTop: HtStackPtr;

  PROCEDURE PushCursorHeight();
    VAR
      tmp: HtStackPtr;
    BEGIN
      VStorage.DosAlloc( tmp, SYSTEM.TSIZE(HtStackElem) );
      tmp^.prv := HtStackTop;
      tmp^.ht := GetCursorHeight();
      HtStackTop := tmp;
    END PushCursorHeight;

  PROCEDURE PopCursorHeight();
    VAR
      tmp: HtStackPtr;
    BEGIN
      tmp := HtStackTop;
      IF tmp = NIL THEN
        ErrorManager.WARN( StackError );
      END;
      SmartScreen.SetCursorHeight( tmp^.ht );
      HtStackTop := tmp^.prv;
      VStorage.DosDealloc( tmp, SYSTEM.TSIZE(HtStackElem) );
    END PopCursorHeight;


  TYPE
    (* Type used for Global Color Stack *)
    CStackP = POINTER TO CStack;
    CStack =
      RECORD
        forec, backc: SmartScreen.Colors;
        prv: CStackP;
      END;
  VAR
    ColorStack: CStackP;     (* Global Color Stack *)

  PROCEDURE PushColors();
  (* Pushes fore and back ground on color stack *)
  VAR
    TmpStack: CStackP;
  BEGIN
    VStorage.DosAlloc( TmpStack, SYSTEM.TSIZE(CStack) );
    TmpStack^.prv := ColorStack;
    ColorStack := TmpStack;
    ColorStack^.forec := SmartScreen.ForeGround;
    ColorStack^.backc := SmartScreen.BackGround;
  END PushColors;

  PROCEDURE PopColors();
  (* Pops fore and back ground from color stack *)
  VAR
    TmpStack: CStackP;
  BEGIN
    IF ColorStack = NIL THEN
      ErrorManager.WARN( StackError );
    END;
    SmartScreen.TextColor( ColorStack^.forec, ColorStack^.backc);
    TmpStack := ColorStack;
    ColorStack := ColorStack^.prv;
    VStorage.DosDealloc( TmpStack, SYSTEM.TSIZE(CStack) );
  END PopColors;


  PROCEDURE ScrollWindow(col1, row1, col2, row2, lines : INTEGER);
    VAR
      BackGroundCell:Cell;
      vertdist : INTEGER;
      row, backg, StartingSpot, horizdist,
          widmem : CARDINAL;
    BEGIN
      col1 := Numbers.Min( col1, SmartScreen.MaxCol );
      col2 := Numbers.Min( col2, SmartScreen.MaxCol );
      row1 := Numbers.Min( row1, SmartScreen.MaxRow );
      row2 := Numbers.Min( row2, SmartScreen.MaxRow );
      vertdist := (row2 - row1) + 1;
      IF lines > 0 THEN
        lines := Numbers.Min( vertdist, lines );
      ELSE
        lines := - INTEGER(Numbers.Min( vertdist, ABS(lines) ));
      END;
      IF (lines = 0) OR (ABS(lines) = vertdist) THEN
        (* clear the entire window *)
        SmartScreen.ClearPart( col1, row1, col2, row2);
      ELSE
        BackGroundCell.Char := ' ';
        backg := ORD(SmartScreen.BackGround);
        LowLevel.ShiftLeft(backg, 4);
        BackGroundCell.Attribute := CHR(ORD(SmartScreen.ForeGround)+backg);
        IF lines < 0 THEN
          IF FAPI.VIOSCROLLDN(row1-1,col1-1,row2-1,col2-1,ABS(lines),
              SYSTEM.ADR(BackGroundCell.Char),0) # 0  THEN
            ErrorManager.WARN('scrolldn error');
          END;
        ELSE
          IF FAPI.VIOSCROLLUP(row1-1,col1-1,row2-1,col2-1,ABS(lines),
              SYSTEM.ADR(BackGroundCell.Char),0) #0 THEN
            ErrorManager.WARN('scrollup error');
          END;
        END;
      END;
    END ScrollWindow;


  PROCEDURE ScreenSave(VAR scrn : ScreenType; col1, row1, col2,
        row2 : CARDINAL);
    VAR
      row, widmem : CARDINAL;
      MemPtr: LowLevel.Address8086;
    BEGIN
      WITH scrn DO
        width := Numbers.Between(1,col2-col1+1,SmartScreen.MaxCol);
        size := width * Numbers.Between(1,row2-row1+1,SmartScreen.MaxRow)*2;
          (*It's *2 to make room for attribute bytes.*)
        IF NOT VStorage.AllocMem( handle, size ) THEN
          StringIO.WriteEol( StringIO.outp, InsufficientMemory );
          IF 0 = KbdInput.KeyHit( KbdInput.AnyKeyNum ) THEN END;
          HALT;
        END;
        MemPtr.a := VStorage.LockMem( handle );
        IF (col1 = 1) AND (col2 = SmartScreen.MaxCol) AND
           (row1 = 1) AND (row2 = SmartScreen.MaxRow) THEN
          (* to save entire screen *)
          IF FAPI.VIOREADCELLSTR(
                MemPtr.a,
                SYSTEM.ADR(size),
                row1 - 1, col1 - 1, 0 ) # 0 THEN
            ErrorManager.WARN( 'VioReadCellStr error' );
          END;
        ELSE
          (* to save only part of screen *)
          widmem := 2*width;
          FOR row := row1 TO row2 DO
            IF FAPI.VIOREADCELLSTR(
                LowLevel.AddAddr(MemPtr.a, widmem*(row-row1)),
                SYSTEM.ADR(widmem),
                row - 1, col1 - 1, 0 ) # 0 THEN
              ErrorManager.WARN( 'VioReadCellStr error' );
            END;
          END;
        END;
        VStorage.UnLockMem( handle );
      END;
    END ScreenSave;


  PROCEDURE ScreenRestore(scrn : ScreenType; col, row : CARDINAL);
    VAR
      cnt, offset, widmem: CARDINAL;
      MemPtr: LowLevel.Address8086;
      RowRestored, NumOfRowsToRestore:CARDINAL;
    BEGIN
      MemPtr.a := VStorage.LockMem( scrn.handle );
      widmem := 2 * scrn.width;
      NumOfRowsToRestore := (scrn.size DIV scrn.width) DIV 2;
      RowRestored := row-1;
      cnt := 0;
      REPEAT
        offset := cnt * widmem;
        IF FAPI.VIOWRTCELLSTR( LowLevel.AddAddr(MemPtr.a, offset),
            widmem, RowRestored, col-1, 0 ) # 0 THEN
          ErrorManager.WARN("VioWrtCellStr error");
        END;
        INC(RowRestored);
        INC(cnt);
      UNTIL cnt >= NumOfRowsToRestore;
      VStorage.UnLockMem( scrn.handle );
      VStorage.DeallocMem( scrn.handle, scrn.size );
    END ScreenRestore;


  PROCEDURE DrawLine( col1, row1, col2, row2: CARDINAL; TheChar:
      CHAR );
    VAR
      row : CARDINAL;
      linestr : ARRAY [0..80] OF CHAR;
    BEGIN
      IF col1 < col2 THEN
        (*We're drawing a horizontal line.*)
        LowLevel.Fill( SYSTEM.ADR(linestr), 1+HIGH(linestr), TheChar);
        StrEdit.SetLength( linestr, col2 - col1 +1);
        SmartScreen.WriteAt( col1, row1, linestr);
      ELSE
        (*We're drawing a vertical line.*)
        FOR row := row1 TO row2 DO
          SmartScreen.WriteAt( col1, row, TheChar );
        END;
      END;
    END DrawLine;

  PROCEDURE DrawBox(col1, row1, col2, row2 : CARDINAL);
    BEGIN
      DrawThisBox( SingleBox, col1, row1, col2, row2 );
    END DrawBox;

  PROCEDURE DrawDblBox(col1, row1, col2, row2 : CARDINAL);
    BEGIN
      DrawThisBox( DoubleBox, col1, row1, col2, row2 );
    END DrawDblBox;


  PROCEDURE DrawThisBox( BoxChars: VWindows.BoxStr; col1,
      row1, col2, row2 : CARDINAL);
    VAR
      row, lngth : CARDINAL;
      UpperBound, LowerBound: CARDINAL;
      linestr : ARRAY [0..127] OF CHAR;
    BEGIN
      LowLevel.Fill(SYSTEM.ADR(linestr), 1+HIGH(linestr), BoxChars[1] );
      linestr[0] := BoxChars[0];
      lngth := col2-col1+1;
      StrEdit.SetLength( linestr, lngth );
      linestr[lngth-1] := BoxChars[2];
      SmartScreen.AdrWriteAt(col1, row1, SYSTEM.ADR(linestr), lngth);
      LowerBound := row1 + 1;
      UpperBound := row2 - 1;
      FOR row := LowerBound TO UpperBound DO
        SmartScreen.AdrWriteAt(col1, row, SYSTEM.ADR(BoxChars[3]), 1);
        SmartScreen.AdrWriteAt(col2, row, SYSTEM.ADR(BoxChars[4]), 1);
      END;
      LowLevel.Fill(SYSTEM.ADR(linestr), 1+HIGH(linestr), BoxChars[6] );
      linestr[0] := BoxChars[5];
      linestr[lngth-1] := BoxChars[7];
      SmartScreen.AdrWriteAt(col1, row2, SYSTEM.ADR(linestr), lngth);
    END DrawThisBox;


  PROCEDURE MsgBox(locatn : VWindows.Compass; TheStr : ARRAY OF
      CHAR; LegalKeys: KbdInput.KeyNumSet; VAR KeyPressed : CARDINAL);
    CONST
      width = 30;
      LastRow = 17;
    VAR
      leng, breakspot, lastbreak : INTEGER;
      indx, maxleng, newleng, i, col1, row1, rowspot, colspot : CARDINAL;
      screen : ScreenType;
      msgary : ARRAY [0..LastRow] OF ARRAY [0..width] OF CHAR;
    BEGIN
      PushColors();
      PushCursorCoords();
      PushCursorHeight();
      SmartScreen.SetCursorHeight(0);
      SmartScreen.SetAttribOrColor(MsgForeColor, MsgBackColor, MsgMonoAtrib);
      CASE locatn OF
        VWindows.West, VWindows.NW, VWindows.SW :
        col1 := lftcol;
      | VWindows.North, VWindows.South :
        col1 := midcol;
      | VWindows.East, VWindows.NE, VWindows.SE :
        col1 := rtcol;
      END;
      CASE locatn OF
        VWindows.North, VWindows.NW, VWindows.NE :
        row1 := toprow;
      | VWindows.East, VWindows.West :
        row1 := midrow;
      | VWindows.South, VWindows.SE, VWindows.SW :
        row1 := btmrow;
      END;
      (* now break the text into rows and put it into msgary *)
      leng := M2Strings.Length(TheStr);
      lastbreak := -1;
      maxleng := 23;
      indx := 0;
      REPEAT
          (*If the width of the window is less than the number of chars
            yet to be written.*)
        IF (width < (leng - lastbreak)) THEN
          breakspot := PosUtils.BreakPoint( TheStr, lastbreak + width,
              " -;,\/)]}" );
          IF breakspot <= lastbreak THEN
            (*We didn't find any better place to break than we did last
              time through, so we have to cut the string in the middle
              of something.*)
            breakspot := (lastbreak + width) - 1;
          END;
        ELSE
          breakspot := leng;
        END;
        newleng := INTEGER(breakspot - lastbreak);
          (*INTEGER type cast necessary for JPI compiler.*)
        M2Strings.Copy(TheStr, lastbreak+1, newleng, msgary[indx]);
        IF newleng>maxleng THEN
          maxleng := newleng;
        END;
        INC(indx);
        lastbreak := breakspot;
      UNTIL (lastbreak = leng) OR (indx > LastRow);
      ScreenSave(screen, col1, row1, col1+maxleng+3, row1+indx+3);
      SmartScreen.ClearPart(col1, row1, col1+maxleng+3, row1+indx+3);
      (* save & clear an area of the required size *)
      DrawThisBox( SingleBox,col1, row1, col1+maxleng+3, row1+indx+3);
      (* draw a box of the required size *)
      colspot := col1+2;
      rowspot := row1+1;
      FOR i := 1 TO indx DO
        (* write text in window *)
        SmartScreen.WriteAt(colspot, rowspot+i, msgary[i-1]);
      END;
      KeyPressed := KbdInput.KeyHit( LegalKeys );
      ScreenRestore(screen, col1, row1);
      PopCursorCoords();
      PopCursorHeight();
      PopColors();
      (* restore screen, cursor, and mode *)
    END MsgBox;


PROCEDURE ErrorBox( TheMessage: ARRAY OF CHAR ): BOOLEAN;
  VAR
    dumkey: CARDINAL;
    dummy: ARRAY [0..255] OF CHAR;
  BEGIN
    StrEdit.AssignStr( TheMessage, dummy );
    StrEdit.Append( dummy, '. Press C to continue, anything else to abort.' );
    MsgBox( VWindows.NE, dummy, KbdInput.AnyKeyNum, dumkey );
    RETURN KbdInput.CAPkey( dumkey ) # ORD('C');
  END ErrorBox;

PROCEDURE RestoreCursor();
  (*We add this procedure to ErrorManager's TermProcList below.*)
  BEGIN
    SmartScreen.SetCursorHeight( StartingCursorHt );
  END RestoreCursor;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      (*EntryDiag:
      Diagnostics.Init();
      :EntryDiag*)
      ErrorManager.Init();
      KbdInput.Init();
      LowLevel.Init();
      M2Strings.Init();
      Numbers.Init();
      PosUtils.Init();
      SmartScreen.Init();
      StrConv.Init();
      StrEdit.Init();
      StringIO.Init();
      VStorage.Init();
      VWindows.Init();

      (*EntryDiag:
        Diagnostics.diagS( 'Entering WindowPrims', '' );
      :EntryDiag*)

      SingleBox[0] := CHR(218);
      SingleBox[1] := CHR(196);
      SingleBox[2] := CHR(191);
      SingleBox[3] := CHR(179);
      SingleBox[4] := CHR(179);
      SingleBox[5] := CHR(192);
      SingleBox[6] := CHR(196);
      SingleBox[7] := CHR(217);
      SingleBox[8] := 0C;
      DoubleBox[0] := CHR(201);
      DoubleBox[1] := CHR(205);
      DoubleBox[2] := CHR(187);
      DoubleBox[3] := CHR(186);
      DoubleBox[4] := CHR(186);
      DoubleBox[5] := CHR(200);
      DoubleBox[6] := CHR(205);
      DoubleBox[7] := CHR(188);
      DoubleBox[8] := 0C;
      VStorage.NilHandle( NilValue );

      StartingCursorHt := GetCursorHeight();

      ErrorManager.AbortConfirmed := ErrorBox;
        (*This makes ErrorManager display its messages in a window
          so as not to disturb the rest of the screen.*)

      ErrorManager.AddTermProc( RestoreCursor );
        (*This prevents us from losing the cursor if we terminate
          abnormally.*)
      ColorStack := NIL;
      CoordStackTop := NIL;
      HtStackTop := NIL;
      MsgForeColor := SmartScreen.lightgrey;
      MsgBackColor := SmartScreen.black;
      MsgMonoAtrib := SmartScreen.plain;

      (*EntryDiag:
      Diagnostics.diagS( 'Exiting WindowPrims', '' );
      :EntryDiag*)
    END Init;

BEGIN
  Initialized := FALSE;
  Init();
END WindowPrims.