Topspeed_JPI/TS-V3/MODBASE/SMARTSCR.MOD

IMPLEMENTATION MODULE SmartScreen;
(*
 *  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/smartscr.mov   1.5   17 Mar 1991 17:53:50   coleb  $
 *
 *)


(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)

(* IMPORT EnvironUtils; *)
IMPORT ErrorManager;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT Numbers;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT StringIO;
IMPORT SYSTEM;
IMPORT VStorage;
IMPORT FAPI;


VAR
  Initialized : BOOLEAN;


  CONST
    blink = 16;
    byte1 = 0;
  VAR
    ReturnCode: CARDINAL;
    TextAttrByte: CHAR;
    NoSnow, UsingColor: BOOLEAN;
    NilValue : VStorage.MemHandle;
    setting : ARRAY [0..80] OF CHAR;


  PROCEDURE SetBits( VAR TheWord: SYSTEM.BYTE; bit1, bit2, bit3: CARDINAL );
    BEGIN
    END SetBits;


  PROCEDURE EndCol(): CARDINAL;
    VAR
      ModeData: FAPI.VIOMODEINFO;
      ErrorNum: CARDINAL;
    BEGIN

      ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
      ErrorNum := FAPI.VIOGETMODE(SYSTEM.ADR(ModeData), 0);
      IF ErrorNum # 0 THEN
        ErrorManager.WarnNumber("VioGetMode error", ErrorNum);
      END;
      MaxCol := ModeData.col;
(*
MaxCol := 80;
*)
      RETURN MaxCol;
    END EndCol;


  PROCEDURE EndRow(): CARDINAL;
    VAR
      ModeData: FAPI.VIOMODEINFO;
      ErrorNum: CARDINAL;
    BEGIN

      ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
      ErrorNum := FAPI.VIOGETMODE(SYSTEM.ADR(ModeData), 0);
      IF ErrorNum # 0 THEN
        ErrorManager.WarnNumber("VioGetMode error", ErrorNum);
      END;
      MaxRow := ModeData.row;
(*
MaxRow := 25;
*)
      RETURN MaxRow;
    END EndRow;


  PROCEDURE GotoXY(column, row : CARDINAL);
    (*puts cursor at column X, row Y *)
    VAR
      dumstr, dumstr2 : ARRAY [0..20] OF CHAR;
    BEGIN
      IF row>MaxRow THEN
        row := MaxRow - 1;
      ELSIF row>0 THEN
        DEC(row);
      END;
      IF column>MaxCol THEN
        column := MaxCol - 1;
      ELSIF column>0 THEN
        DEC(column);
      END;
      IF FAPI.VIOSETCURPOS(row, column, 0) # 0 THEN
        ErrorManager.WARN("VioSetCurPos error ");
      END;
    END GotoXY;


  PROCEDURE MonoAttrsToColor(AttrSet : AttributeSet; VAR fg, bg :
        Colors);
    BEGIN
      fg := ForeGround;
      bg := BackGround;
      IF invisible IN AttrSet THEN
        fg := black;
        bg := black;
        RETURN;
      END;
      IF plain IN AttrSet THEN
        fg := lightgrey;
        bg := black;
        RETURN;
      END;
      IF underscored IN AttrSet THEN
        fg := blue;
        bg := black;
      END;
      IF ReverseVideo IN AttrSet THEN
        fg := black;
        bg := lightgrey;
      END;
      IF (bold IN AttrSet) AND (ForeGround<darkgrey) THEN
        fg := VAL(Colors, ORD(ForeGround)+ORD(darkgrey));
      END;
      IF (blinking IN AttrSet) AND (ORD(BackGround)<(blink DIV 2)) THEN
        bg := VAL(Colors, ORD(BackGround)+(blink DIV 2));
      END;
    END MonoAttrsToColor;

  PROCEDURE ColorToMonoAttrs(fg, bg : Colors; VAR AttrSet :
        AttributeSet);
    BEGIN
      AttrSet := AttributeSet{plain};
      IF (ORD(bg)>=(blink DIV 2)) THEN
        AttrSet := AttributeSet{blinking};
        bg := VAL(Colors, ORD(bg)-(blink DIV 2));
      END;
      IF fg>=darkgrey THEN
        INCL(AttrSet, bold);
        fg := VAL(Colors, ORD(fg)-ORD(darkgrey));
      END;
      CASE bg OF
        black :
        IF fg=blue THEN
          INCL(AttrSet, underscored);
        ELSIF fg=black THEN
          AttrSet := AttributeSet{invisible};
        END;
      | lightgrey :
        IF fg=black THEN
          INCL(AttrSet, ReverseVideo);
        END;
      ELSE
      END;
      IF AttrSet#AttributeSet{plain} THEN
        EXCL(AttrSet, plain);
      END;
    END ColorToMonoAttrs;

  PROCEDURE MakeAttrByte();
    VAR
      cnt: CARDINAL;
    BEGIN
      cnt := ORD(BackGround);
      LowLevel.ShiftLeft(cnt, 4);
      TextAttrByte := CHR(ORD(ForeGround)+cnt);
    END MakeAttrByte;



  PROCEDURE TextColor(fg, bg : Colors);
    VAR
      dumstr : ARRAY [0..8] OF CHAR;
    BEGIN
      ForeGround := fg;
      BackGround := bg;
      ColorToMonoAttrs(fg, bg, TextModeNow);
      MakeAttrByte();
    END TextColor;

  PROCEDURE ReverseColors();
    (* Switches fore and back ground colors, like reverse video *)
    VAR
      SwitchColor : Colors;
    BEGIN
      SwitchColor := ForeGround;
      ForeGround := BackGround;
      BackGround := SwitchColor;
      MakeAttrByte();
    END ReverseColors;

  PROCEDURE SetAttribOrColor(forec, backc: Colors; atrib: TextAttribute);
  (* depending on current screen mode, sets color or mono attribute *)
    BEGIN
      IF UsingColor THEN
        IF (forec<>ForeGround) OR (backc<>BackGround) THEN
          TextColor( forec, backc);
        END;
      ELSE
        IF NOT (atrib IN TextModeNow) THEN
          TextModeNow := AttributeSet{};
          ForeGround := lightgrey;
          BackGround := black;
          IF VideoMethod=ANSI THEN
            TextMode( plain);  (* resets to plain first *)
            TextMode( atrib);
          ELSE
            INCL(TextModeNow, atrib);
            MonoAttrsToColor(TextModeNow, ForeGround, BackGround);
            MakeAttrByte();
          END;
        END;
      END;
    END SetAttribOrColor;


  PROCEDURE TextMode(attribute : TextAttribute);

    PROCEDURE UpdateNeeded(attribute : TextAttribute) : BOOLEAN;
      VAR
        answer : BOOLEAN;
      BEGIN
        answer := FALSE;
        IF attribute=plain THEN
          IF TextModeNow#AttributeSet{plain} THEN
            answer := TRUE;
          END;
          TextModeNow := AttributeSet{plain};
        ELSIF NOT (attribute IN TextModeNow) THEN
          INCL(TextModeNow, attribute);
          EXCL(TextModeNow, plain);
          RETURN (TRUE);
        END;
        RETURN (answer);
      END UpdateNeeded;

    VAR
      fground, bground : CARDINAL;
    BEGIN
      IF UpdateNeeded(attribute) THEN
        MonoAttrsToColor(TextModeNow, ForeGround, BackGround);
        MakeAttrByte();
      END;
    END TextMode;


  PROCEDURE ScreenMode(TheMode : ScreenModeType);
    VAR

      dumstr : ARRAY [0..8] OF CHAR;
      temp, ModeData: FAPI.VIOMODEINFO;
    BEGIN

      IF TheMode # ScreenModeNow THEN
        CASE TheMode OF

          BW40x25:
            (* BIOS MODE 0 *)
          ModeData.cb := 12;
          ModeData.fbType := FAPI.UCHAR(FAPI.VGMT_DISABLEBURST);
              (* mono *)
          ModeData.hres := 320;
          ModeData.vres  := 200;
          ModeData.row := 25;
          ModeData.col := 40;
          SetBits (ModeData.color, 0, 7, 1);
            (* 2 colors = B/w ???*)

        | color40x25:
            (* BIOS MODE 1 *)
          ModeData.cb := 12;
          ModeData.row :=25 ;
          ModeData.col := 40;
          ModeData.fbType := FAPI.VGMT_OTHER;
              (* color ??? *)
          ModeData.hres := 320;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 4);
            (* 16 colors *)

        | BW80x25:
            (* BIOS MODE 2 *)
          ModeData.cb := 12;
          ModeData.row := 25;
          ModeData.col := 80;
          ModeData.fbType := FAPI.VGMT_DISABLEBURST;
          ModeData.hres := 640;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 1);
            (* 2 colors = B/w ???*)

        | color80x25:
            (* BIOS MODE 3 *)
          ModeData.cb := 12;
          ModeData.row :=25 ;
          ModeData.col :=80 ;
          ModeData.fbType := FAPI.VGMT_OTHER;
            (* ModeData.color *)
          ModeData.hres := 640;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 4);
            (* 16 colors *)

        | color320:
            (* BIOS MODE 4 *)
          ModeData.cb := 12;
          ModeData.row := 0 ;
          ModeData.col := 0 ;
          ModeData.fbType := FAPI.VGMT_GRAPHICS;
            (* color graphics *)
          ModeData.hres := 320;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 2);
            (* 4 colors *)

        | BW320:
            (* BIOS MODE 5 *)
          ModeData.cb := 12;
          ModeData.row := 0;
          ModeData.col :=0 ;
          ModeData.fbType := FAPI.VGMT_DISABLEBURST + FAPI.VGMT_GRAPHICS;
          ModeData.hres := 320;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 1);
            (* 2 colors = B/w ???*)

        | BW640:
            (* BIOS MODE 6 *)
          ModeData.cb := 12;
          ModeData.row := 0;
          ModeData.col :=0 ;
          ModeData.fbType := FAPI.VGMT_DISABLEBURST + FAPI.VGMT_GRAPHICS;
          ModeData.hres := 640;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 1);
            (* 2 colors = B/w ???*)

        | Mono:
            (* BIOS MODE 7 *)
          ModeData.row := 25;
          ModeData.cb := 12;
          ModeData.col :=80 ;
          ModeData.fbType := FAPI.VGMT_DISABLEBURST;
            (* mono *)
          ModeData.hres := 720;
          ModeData.vres  := 350;
          SetBits (ModeData.color, 0, 7, 1);
            (* 2 colors = B/w ???*)

        | PCjr160:
            (*   BIOS MODE 8 not supported *)
          ErrorManager.WARN("VioSetMode - not supported ");

        | PCjr320:
            (* BIOS MODE 9 - NOT SUPPORTED *)
          ErrorManager.WARN("VioSetMode - not supported ");

        | PCjr640:
            (* BIOS MODE Ah - NOT SUPPORTS *)
          ErrorManager.WARN("VioSetMode - not supported ");

        | EGA11:
            (* BIOS MODE B hex - not supported *)
          ErrorManager.WARN("VioSetMode - not supported ");

        | EGA12:
            (* BIOS MODE c hex  *);

        | EGA320:
            (* BIOS MODE d hex *)
          ModeData.cb := 12;
          ModeData.row := 0;
          ModeData.col := 0;
          ModeData.fbType := FAPI.VGMT_GRAPHICS + FAPI.VGMT_OTHER;
             (*??*)
          ModeData.hres := 320;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 4);
            (* 16 colors *)

        | EGA640:
            (* BIOS MODE E hex *)
          ModeData.cb := 12;
          ModeData.row := 0;
          ModeData.col :=0 ;
          ModeData.fbType := FAPI.VGMT_GRAPHICS + FAPI.VGMT_OTHER;
          ModeData.hres := 640;
          ModeData.vres  := 200;
          SetBits (ModeData.color, 0, 7, 2);
            (* 4 colors = *)

        | EGAMono:
            (* BIOS MODE F hex *)
          ModeData.cb := 12;
          ModeData.row := 0;
          ModeData.col :=0 ;
          ModeData.fbType := FAPI.VGMT_GRAPHICS;
          ModeData.hres := 640;
          ModeData.vres  := 350;
          SetBits (ModeData.color, 0, 7, 1);
            (* 2 colors = B/w ???*)

        | EGA64color:
            (* BIOS MODE 10 hex *)
          ModeData.cb := 12;
          ModeData.row := 0;
          ModeData.col :=0 ;
          ModeData.fbType := FAPI.VGMT_GRAPHICS + FAPI.VGMT_OTHER;
          ModeData.hres := 640;
          ModeData.vres  := 350;
          SetBits (ModeData.color, 0, 7, 4);
            (* 16  colors *)

        ELSE
          ErrorManager.WARN ("Screen mode not supported");
        END; (* CASE *)

        ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);
        IF FAPI.VIOSETMODE(SYSTEM.ADR(ModeData), 0) #0 THEN
          ErrorManager.WARN("VioSetMode error");
        END;

        MaxCol := ModeData.col;
        MaxRow := ModeData.row;
        ScreenModeNow := TheMode;
        UsingColor := NOT ( (TheMode = BW40x25) OR (TheMode = BW80x25)
                      OR (TheMode = BW320) OR (TheMode = BW640) OR
                      (TheMode = Mono) OR (TheMode = EGAMono));
      END;

    END ScreenMode;


  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, MaxRow-1) * MaxCol +
          Numbers.Between(1, ColNum, MaxCol));
    END coord;


  PROCEDURE RealVideoMode() : ScreenModeType;
    (* This is incomplete, I know, but its only purpose is
       compatibility with old code.  New code ought
       to get this information in some more rational way. *)
    VAR
      ModeData: FAPI.VIOMODEINFO;
      ErrorNum: CARDINAL;
    BEGIN
      ModeData.cb := SYSTEM.TSIZE(FAPI.VIOMODEINFO);

      ErrorNum := FAPI.VIOGETMODE(SYSTEM.ADR(ModeData), 0);

      IF ErrorNum # 0 THEN
        ErrorManager.WarnNumber("VioGetMode Error", ErrorNum);
      END;
      MaxCol := ModeData.col;
      MaxRow := ModeData.row +1;
        (* Adjust to Repertoire's system of
           numbering from 1 instead of 0 *)
      IF (CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_OTHER,
                              ORD(ModeData.fbType))) # 0) THEN
        IF (CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_GRAPHICS,
                                         ORD(ModeData.fbType))) # 0) THEN
          (* We're in a graphics mode. *)
          IF CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_DISABLEBURST,
                ORD(ModeData.fbType))) # 0 THEN
            (* We're in a monochrome graphics mode. *)
            IF ModeData.hres = 320 THEN
              RETURN BW320;
            ELSE
              RETURN BW640;
            END;
          ELSE
            (* We're in a color graphics mode. *)
            IF ModeData.hres = 320 THEN
              RETURN EGA320;
            ELSE
              RETURN EGA640;
            END;
          END;
        ELSE
          (* We're in a text mode. *)
          IF CARDINAL(LowLevel.BitwiseAnd(FAPI.VGMT_DISABLEBURST,
                                          ORD(ModeData.fbType))) # 0 THEN
            (* We're in a monochrome text mode. *)
            IF (ModeData.row =25) AND (ModeData.col = 40) THEN
              RETURN BW40x25;
            ELSE
              RETURN BW80x25;
            END;
          ELSE
            (* We're in a color text mode. *)
            IF (ModeData.row =25) AND (ModeData.col = 40) THEN
              RETURN color40x25;
            ELSE
              RETURN color80x25;
            END;
          END;
    END;
      ELSE
        RETURN Mono;
      END;

      RETURN color80x25;
    END RealVideoMode;


  PROCEDURE WriteAt(ColNum, RowNum : CARDINAL; TheStr : ARRAY OF CHAR);
    BEGIN
      AdrWriteAt( ColNum, RowNum, SYSTEM.ADR(TheStr),
          M2Strings.Length(TheStr));
    END WriteAt;


  PROCEDURE AdrWriteAt(ColNum, RowNum : CARDINAL; TheAdr:
      SYSTEM.ADDRESS; TheSize: CARDINAL );
    BEGIN
      IF TheSize = 0 THEN
        RETURN;
      END;
      ColNum := Numbers.Between( 1, ColNum, MaxCol );
      RowNum := Numbers.Between( 1, RowNum, MaxRow );
      TheSize := Numbers.Min( TheSize, (MaxCol - ColNum) + 1 );
      NominalCol := ColNum + TheSize;
      NominalRow := RowNum;
      IF FAPI.VIOWRTCHARSTRATT( TheAdr, TheSize,
          RowNum-1, ColNum-1, SYSTEM.ADR(TextAttrByte), 0 ) # 0 THEN
        ErrorManager.WARN("VioWrtCharStrAtt error");
      END;
    END AdrWriteAt;


  PROCEDURE SetCursorHeight(lines : CARDINAL);
    VAR
      CursorData: FAPI.VIOCURSORINFO;
    BEGIN
      ReturnCode := FAPI.VIOGETCURTYPE(SYSTEM.ADR(CursorData), 0);
      IF ReturnCode # 0 THEN
        ErrorManager.WarnNumber("VioGetCurType error", ReturnCode);
      END;
        (* We set CursorWidth to 0, which means default width, because
           the API.LIB version of VIOGETCURTYPE doesn't seem to be
           returning values that can be passed on to VIOSETCURTYPE. *)
      CursorData.cx := 0;
(*
      CursorData.CursorEndLine := -100;
           OS/2 lets us specify percentages of the character cell by
           using negative numbers.  This means that the end line is
           always 100% of the way down from the top of the character
           cell.

Unfortunately, API.LIB doesn't support this, so we start by getting
CursorData, and we try not to change it much.
*)
      IF lines <= 0 THEN
        CursorData.attr := 65535;
      ELSE
        CursorData.attr := 1;
        IF lines >= 10 THEN
          CursorData.yStart := 0;
        ELSE
          CursorData.yStart := CursorData.cEnd - lines;
        END;
      END;
      ReturnCode := FAPI.VIOSETCURTYPE(SYSTEM.ADR(CursorData), 0);
      IF ReturnCode # 0 THEN
        ErrorManager.WarnNumber("VioSetCurType error", ReturnCode);
      END;
    END SetCursorHeight;


  PROCEDURE ClearPart(col1, row1, col2, row2 : CARDINAL);
    VAR
      BackGroundCell: VideoMemChar;
    BEGIN
      row2 := Numbers.Min( row2, MaxRow );
      col2 := Numbers.Min( col2, MaxCol );
      col1 := Numbers.Between( 1, col1, col2 );
      row1 := Numbers.Between( 1, row1, row2 );
      BackGroundCell.attr :=TextAttrByte;
      BackGroundCell.ch := ' ';
      IF FAPI.VIOSCROLLUP( row1-1, col1-1, row2-1, col2-1, 65535,
          SYSTEM.ADR(BackGroundCell), 0) # 0 THEN
        ErrorManager.WARN("VioScrollUp error");
      END;
    END ClearPart;


  PROCEDURE ClearScreen();
  (*Clears the screen and sends the cursor to the top left corner.*)
    BEGIN
      ClearPart(1, 1, MaxCol, MaxRow);
    END ClearScreen;


  PROCEDURE SetVideoVars();
    BEGIN
      ScreenModeNow := RealVideoMode();
      IF ScreenModeNow >= color320 THEN
        VideoMethod := ROM;
      END;
      IF M2Strings.CompareStr( setting, 'DMAWAIT') = 0 THEN
        NoSnow := TRUE;
      ELSIF M2Strings.CompareStr( setting, 'DMA') = 0 THEN
        NoSnow := FALSE;
      ELSE
        NoSnow := ScreenModeNow < Mono;
      END;
      UsingColor := NOT ( (ScreenModeNow = BW40x25) OR
                          (ScreenModeNow = BW80x25) OR
                          (ScreenModeNow = BW320) OR
                          (ScreenModeNow = BW640) OR
                          (ScreenModeNow = Mono) OR
                          (ScreenModeNow = EGAMono));
    END SetVideoVars;



  PROCEDURE SetVideoMethod( NewMethod: VidMethodType);
    BEGIN
      IF (VideoMethod = ANSI) AND (NewMethod # ANSI) THEN
        SetVideoVars();
      END;
      VideoMethod := NewMethod;
    END SetVideoMethod;


  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
(*EntryDiag:
      Diagnostics.Init();
:EntryDiag*)

      ErrorManager.Init();
      LowLevel.Init();
      M2Strings.Init();
      Numbers.Init();
      StrConv.Init();
      StrEdit.Init();
      StringIO.Init();
      VStorage.Init();
(*EntryDiag:
      Diagnostics.diagS( 'Entering SmartScreen', '' );
:EntryDiag*)

      VStorage.NilHandle( NilValue );
      VideoMethod := DMA;
      ForeGround := lightgrey;
      BackGround := black;
      TextModeNow := AttributeSet{ plain};
      MakeAttrByte();
      MaxCol := 80;
      MaxRow := 25;

(*
      ScreenModeNow :=RealVideoMode();
*)
      SetVideoVars();

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

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