Topspeed_JPI/TS-V3/MODBASE/VWINDOWS.MOD

IMPLEMENTATION MODULE VWindows;
(*
 *  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/vwindows.mov   1.7   10 Mar 1991 15:34:42   coleb  $
 *
 *)


(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)

IMPORT LowLevel;
IMPORT MsColors;
IMPORT MsgBox1;
IMPORT SmartScreen;
IMPORT SYSTEM;
IMPORT WindowPrims;

VAR
  Initialized : BOOLEAN;
  handle: CARDINAL;

TYPE
  AWindowHandle = POINTER TO CARDINAL;
VAR
  NormalBackGround: MsColors.AColor;
  NormalAttrib: MsColors.AMonoAttribute;

  PROCEDURE NullScan( StrAddr: SYSTEM.ADDRESS ): CARDINAL;
    BEGIN
      RETURN LowLevel.ScanEQ( 32767, 0C, StrAddr );
    END NullScan;


  PROCEDURE AtrbSetToAtrb( TheSet: SmartScreen.AttributeSet ):
      SmartScreen.TextAttribute;
    BEGIN
      IF SmartScreen.plain IN TheSet THEN
        RETURN SmartScreen.plain;
      ELSIF SmartScreen.bold IN TheSet THEN
        RETURN SmartScreen.bold;
      ELSIF SmartScreen.underscored IN TheSet THEN
        RETURN SmartScreen.underscored;
      ELSIF SmartScreen.blinking IN TheSet THEN
        RETURN SmartScreen.blinking;
      ELSIF SmartScreen.ReverseVideo IN TheSet THEN
        RETURN SmartScreen.ReverseVideo;
      ELSE
        RETURN SmartScreen.plain;
      END;
    END AtrbSetToAtrb;


  PROCEDURE DefaultGetCursorHeight( TheWindow: AWindowHandle ):
      CARDINAL;
    BEGIN
      RETURN WindowPrims.GetCursorHeight();
    END DefaultGetCursorHeight;


  PROCEDURE DefaultSetCursorHeight( TheWindow: AWindowHandle;
      LinesInCursor: CARDINAL );
    BEGIN
      SmartScreen.SetCursorHeight( LinesInCursor );
    END DefaultSetCursorHeight;


  PROCEDURE DefaultGetCursorCoords( TheWindow: AWindowHandle; VAR
      x, y: CARDINAL );
    BEGIN
      WindowPrims.GetCursorCoords( x, y );
    END DefaultGetCursorCoords;


  PROCEDURE DefaultDrawBox( TheWindow: AWindowHandle; BoxChars: BoxStr;
      col1, row1, col2, row2 : CARDINAL);
    BEGIN
      WindowPrims.DrawThisBox( BoxStr(BoxChars), col1, row1,
          col2, row2 );
    END DefaultDrawBox;

  PROCEDURE DefaultDrawStr( TheWindow: AWindowHandle; x, y:
      CARDINAL; StrAddr: SYSTEM.ADDRESS; StrLength: CARDINAL );
    BEGIN
      IF StrLength = 0 THEN
        StrLength := NullScan( StrAddr );
      END;
      SmartScreen.AdrWriteAt( x, y, StrAddr, StrLength );
    END DefaultDrawStr;


  PROCEDURE DefaultClearPart( TheWindow: AWindowHandle;
      col1, row1, col2, row2: CARDINAL );
    BEGIN
      IF (col1 <= 1) AND (col2 >= SmartScreen.EndCol()) AND (row1 <= 1)
          AND (row2 >= SmartScreen.EndRow() ) THEN
        (*If they're clearing the whole window, we assume they're
          changing the NormalBackGround color.*)
        NormalBackGround := MsColors.AColor(SmartScreen.BackGround);
        NormalAttrib := MsColors.AMonoAttribute( AtrbSetToAtrb(
            SmartScreen.TextModeNow));
      END;
      SmartScreen.ClearPart( col1, row1, col2, row2 );
    END DefaultClearPart;


  PROCEDURE DefaultEndCol( TheWindow: AWindowHandle ): CARDINAL;
    BEGIN
      RETURN SmartScreen.EndCol();
    END DefaultEndCol;


  PROCEDURE DefaultEndRow( TheWindow: AWindowHandle ): CARDINAL;
    BEGIN
      RETURN SmartScreen.EndRow();
    END DefaultEndRow;


  PROCEDURE DefaultGotoXY( TheWindow: AWindowHandle; x, y: CARDINAL );
    BEGIN
      SmartScreen.GotoXY( x, y );
    END DefaultGotoXY;


  PROCEDURE DefaultReverseColors( TheWindow: AWindowHandle );
    BEGIN
      SmartScreen.ReverseColors();
    END DefaultReverseColors;


  PROCEDURE DefaultSetMonoAttr( TheWindow: AWindowHandle;
      NewMonoAttr : MsColors.AMonoAttribute );
    BEGIN
      SmartScreen.SetAttribOrColor( SmartScreen.ForeGround,
          SmartScreen.BackGround,
          SmartScreen.TextAttribute(NewMonoAttr) );
    END DefaultSetMonoAttr;


  PROCEDURE DefaultSetForeColor( TheWindow: AWindowHandle;
      NewForeColor : MsColors.AColor );
    BEGIN
      SmartScreen.SetAttribOrColor( SmartScreen.Colors( NewForeColor ),
          SmartScreen.BackGround, AtrbSetToAtrb(SmartScreen.TextModeNow) );
    END DefaultSetForeColor;


  PROCEDURE DefaultSetBackColor( TheWindow: AWindowHandle;
      NewBackColor : MsColors.AColor );
    BEGIN
      SmartScreen.SetAttribOrColor( SmartScreen.ForeGround,
          SmartScreen.Colors( NewBackColor ),
          AtrbSetToAtrb(SmartScreen.TextModeNow) );
    END DefaultSetBackColor;


  PROCEDURE DefaultMsgBox( TheWindow: AWindowHandle;
      TextPtr: SYSTEM.ADDRESS; CaptionPtr: SYSTEM.ADDRESS;
      WinType: CARDINAL ): CARDINAL;
    BEGIN
      RETURN MsgBox1.WinMsgBox( TheWindow, TextPtr, CaptionPtr, WinType );
    END DefaultMsgBox;


  PROCEDURE DefaultMonoAttr( TheWindow: AWindowHandle ):
      MsColors.AMonoAttribute;
    VAR
      TmpAttr : MsColors.AMonoAttribute;
    BEGIN
(*
      TmpAttr := MsColors.AMonoAttribute(
          AtrbSetToAtrb(SmartScreen.TextModeNow) );
      RETURN TmpAttr;
*)
      RETURN NormalAttrib;
    END DefaultMonoAttr;


  PROCEDURE DefaultForeColor( TheWindow: AWindowHandle ): MsColors.AColor;
    BEGIN
      RETURN MsColors.AColor( SmartScreen.ForeGround );
    END DefaultForeColor;


  PROCEDURE DefaultBackColor( TheWindow: AWindowHandle ): MsColors.AColor;
    BEGIN
      (* We need something that tells us what color to use in
         clearing the window, so we hijack this function for that
         purpose.  Neither it nor the ForeColor function were
         particularly useful in their old roles because you
         should always know the colors in which you want to
         write.  You don't need the window manager to tell you
         the colors in which you are writing. *)
      RETURN NormalBackGround;
(*
      RETURN MsColors.AColor( SmartScreen.BackGround );
*)
    END DefaultBackColor;


  PROCEDURE DefaultScrollVertically( TheWindow: AWindowHandle;
      col1, row1, col2, row2: CARDINAL; lines: INTEGER ): BOOLEAN;
    BEGIN
      WindowPrims.ScrollWindow( col1, row1, col2, row2, lines );
      RETURN TRUE;
    END DefaultScrollVertically;


  PROCEDURE DefaultScrollHorizontally( TheWindow: AWindowHandle;
      col1, row1, col2, row2: CARDINAL; lines: INTEGER ): BOOLEAN;
    BEGIN
      (*We don't have a fast routine to scroll horizontally, so
        we leave it to the client module to repaint. *)
      RETURN FALSE;
    END DefaultScrollHorizontally;


VAR
  col1, row1, col2, row2: CARDINAL;

  PROCEDURE DefaultSetScrollPos( TheWindow: AWindowHandle;
      WhichScrollBar: INTEGER; AmountScrolled: INTEGER );

    PROCEDURE DrawMarkedLine( col1, row1, col2, row2:
        CARDINAL; LineType: CHAR; TotalLengthOrWidth,
        scrolled: CARDINAL);

      PROCEDURE FigurePlacement( VisibleUnits, TotalUnits,
          ScrolledUnits: CARDINAL; VAR offs1, offs2: CARDINAL );
        VAR
          ratio: CARDINAL;
        BEGIN
          (*First we figure out how many lines of TotalUnits a
            single line of VisibleUnits corresponds to.*)
          IF VisibleUnits >= TotalUnits THEN
            offs1 := 1;
            offs2 := 2;
            RETURN;
          END;
          ratio := TotalUnits DIV VisibleUnits;
          offs1 := ScrolledUnits DIV ratio;
          offs2 := ((TotalUnits - VisibleUnits) -
              ScrolledUnits);
            (*offs2 now represents the number of units in
              TotalUnits below those visible.*)
          offs2 := VisibleUnits - (offs2 DIV ratio);
          IF offs1 = 0 THEN
            INC( offs1 );
            INC( offs2 );
          END;
          IF offs2 = offs1 THEN
            (*Now we make sure the marks don't come out on top of
              each other.*)
            IF offs1 > 1 THEN
              DEC(offs1);
            ELSE
              INC(offs2);
            END
          END;
        END FigurePlacement;

      VAR
        LineChar, MarkChar: CHAR;
        offs1, offs2: CARDINAL;
      BEGIN
        (*DrawMarkedLine*)
        IF col1 < col2 THEN
          (*We're drawing a horizontal line.*)
          IF LineType = 'D' THEN
            LineChar := 315C;
              (*horizontal double-lined char*)
            MarkChar := 330C;
          ELSE
            LineChar := 304C;
              (*horizontal single-lined char*)
            MarkChar := 305C;
          END;
          WindowPrims.DrawLine( col1 + 1, row2, col2 - 1, row2,
              LineChar);
            (*This wipes out any previous marks.*)
          FigurePlacement( (col2 - col1) - 1, TotalLengthOrWidth,
              scrolled, offs1, offs2 );
          DrawStr( TheWindow, col1 + offs1, row2, SYSTEM.ADR(MarkChar), 1 );
          DrawStr( TheWindow, col1 + offs2, row2, SYSTEM.ADR(MarkChar), 1 );
        ELSE
          (*We're drawing a vertical line.*)
          IF LineType = 'D' THEN
            LineChar := 272C;
              (*vertical double-lined char*)
            MarkChar := 327C;
          ELSE
            LineChar := CHR(179);
              (*vertical single-lined char*)
            MarkChar := CHR(197);
          END;
          WindowPrims.DrawLine( col2, row1 + 1, col2, row2 - 1,
              LineChar );
            (*This wipes out any previous marks.*)
          FigurePlacement( (row2 - row1) - 1, TotalLengthOrWidth,
              scrolled, offs1, offs2 );
          DrawStr( TheWindow, col2, row1 + offs1,
              SYSTEM.ADR(MarkChar), 1 );
          DrawStr( TheWindow, col2, row1 + offs2,
              SYSTEM.ADR(MarkChar), 1 );
        END;
      END DrawMarkedLine;

    VAR
      box: CHAR;
    BEGIN
      IF WhichScrollBar = SbVert THEN
        DrawMarkedLine( col2, row1, col2,
            row2, box, row2 - row1 + 1, AmountScrolled );
      ELSIF WhichScrollBar = SbHorz THEN
        DrawMarkedLine( col1, row2, col2,
            row2, box, col2 - col1 + 1, AmountScrolled );
      END;
    END DefaultSetScrollPos;


  PROCEDURE DefaultSetScrollRange( TheWindow: AWindowHandle;
      WhichScrollBar, MinPos, MaxPos: INTEGER );
    BEGIN
      IF WhichScrollBar = SbVert THEN
        row1 := MinPos;
        row2 := MaxPos;
      ELSIF WhichScrollBar = SbHorz THEN
        col1 := MinPos;
        col2 := MaxPos;
      END;
    END DefaultSetScrollRange;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
(*EntryDiag:
      Diagnostics.Init();
:EntryDiag*)
      LowLevel.Init();
      MsColors.Init();
      MsgBox1.Init();
      SmartScreen.Init();
      WindowPrims.Init();

    (*EntryDiag:
      Diagnostics.diagS( 'Entering VWindows', '' );
    :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;
      NormalBackGround := MsColors.black;
      NormalAttrib := MsColors.plain;
      BackColor := DefaultBackColor;
      ClearPart := DefaultClearPart;
      CurrentWindow := SYSTEM.ADR(handle);
      handle:=0;
      DrawBox := DefaultDrawBox;
      DrawStr := DefaultDrawStr;
      EndCol := DefaultEndCol;
      EndRow := DefaultEndRow;
      ForeColor := DefaultForeColor;
      GetCursorHeight := DefaultGetCursorHeight;
      GetCursorCoords := DefaultGetCursorCoords;
      GotoXY := DefaultGotoXY;
      MessageBox := DefaultMsgBox;
      MonoAttr := DefaultMonoAttr;
      ReverseColors := DefaultReverseColors;
      ScrollHorizontally := DefaultScrollHorizontally;
      ScrollVertically := DefaultScrollVertically;
      SetBackColor := DefaultSetBackColor;
      SetCursorHeight := DefaultSetCursorHeight;
      SetForeColor := DefaultSetForeColor;
      SetMonoAttr := DefaultSetMonoAttr;
      SetScrollPos := DefaultSetScrollPos;
      SetScrollRange := DefaultSetScrollRange;

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

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