Power-Programmierung/CD1.mdf/pascal/library/dos/files/fileman/fm/fmscreen.pas

Pascal/Delphi Source File | 1988-08-23 | 11.0 KB | 319 lines

{
--------------------------------------------------------------------------
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
File used with FM.PAS.

* ASSOCIATED FILES
FM.PAS
FM.DOC
FM.EXE
FM.TPU
FMFILE.PAS
FMINPUT.PAS
FMSCREEN.PAS
FMUTEST.EXE
FMUTEST.PAS
FMVIEW.PAS

==========================================================================
}
{$R-}      { Range checking off }                     { Unit:    FMScreen.PAS }
{$S-}      { Stack checking off }                     { Program: FM.PAS       }
{$I-}      { I/O checking off }                       { Author:  Jim Zwick    }
{$V+}      { Strict String type checking on }         { Version: 1.0          }
{$B-}      { Boolean short-circuit evaluation on }    { Date:    03-04-88     }

UNIT FMScreen;

INTERFACE

USES
  Crt,
  Dos;

CONST
  NormalVid  = $0700;
  ReverseVid = $7000;
  SpaceStr : STRING[1] = '─';         { Used By KbdStatus to Keep Screen Char }
  InsKeyOn : BOOLEAN = FALSE;      { Set By KbdStatus, Used By Input Routines }

VAR
  StartX, StartY : BYTE;


  PROCEDURE DisplayLine(X, Y, Len, Attr : WORD; St : STRING);
  PROCEDURE WOpen(ScrNum : BYTE);
  PROCEDURE WClose;
  PROCEDURE CursorOn(On : BOOLEAN);
  PROCEDURE ClrLn(X, Y : BYTE);
  PROCEDURE ClrArea(X1, Y1, X2, Y2 : BYTE);
  PROCEDURE KbdStatus;


IMPLEMENTATION

TYPE
  Str15 = STRING[15];
  WinRec = RECORD                                        { Window Coordinates }
              WX1     : BYTE;
              WY1     : BYTE;
              WX2     : BYTE;
              WY2     : BYTE;
              WBorder : BOOLEAN;
              WTitle  : Str15;
            END;
  WScreenContent = ARRAY[0..3999] OF CHAR;   { Buffer to hold window contents }
  WDisplayRec = RECORD
                  WStackScr : BYTE;
                  WCursX    : BYTE;
                  WCursY    : BYTE;
                  WScreen   : ^WScreenContent;
                END;

CONST
  VidAddr     : WORD = $B000;                 { Default value for monochrome. }
  CursOn      : BOOLEAN = TRUE;   { Used to Store Cursor Status for KbdStatus }
  WStackSize  : BYTE = 0;
  MaxWindows  = 4;     { Set at max used at one time or set with SetWindCoord }

VAR
  WSetWindow : ARRAY[0..MaxWindows] OF WinRec;
  WDisp      : ARRAY[0..MaxWindows] OF WDisplayRec;
  WScreenPtr : ^CHAR;    { Pointer to start of video display memory.  Avoids  }
  WCurr      : WinRec;   {   need for addresses to both mono and color memory }
  ExitSave   : Pointer;  {   locations used in most other implementations.    }
  StdStart, StdStop : WORD;              { Saves cursor scan lines at startup }

  { ------------------------------------------------------------------------- }

  PROCEDURE DisplayLine(X, Y, Len, Attr : WORD; St : STRING);
  BEGIN
    Y := PRED(Y) * 160 + PRED(X) * 2;      { Maps St and Attr to Video memory }
    X := 0;
    WHILE X < Len do
      BEGIN
        Inc(X);
        MEMW[VidAddr:Y] := ORD(St[X]) + Attr;
        Y := Y + 2;
      END;
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE InitVideo;        { Initializes Video Address and Color Variables }
  BEGIN
    IF MEM[$0000:$0449] = 7 THEN                                 { Monochrome }
      BEGIN
        VidAddr := $B000;
        TextColor(LightGray);
        TextBackGround(Black);
      END
    ELSE
      BEGIN
        VidAddr := $B800;                                            { Color }
        TextColor(LightGray);
        TextBackGround(Blue);
        CheckSnow := TRUE;
      END;
    WScreenPtr := Ptr(VidAddr, $0000);
    MEM[$0000:$0417] := (MEM[$0000:$0417] AND $7F);            { Clear Insert }
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE GetShape(VAR StartLine, StopLine : WORD);
  VAR
    CursReg : Registers;                { Determine Current Cursor Scan Lines }
  BEGIN
    WITH CursReg DO
      BEGIN
        AH := $03;
        BH := $00;
      END;
    INTR($10, CursReg);
    WITH CursReg DO
      BEGIN
        StartLine := CH;
        StopLine := CL;
      END;
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE SetShape(StartLine, StopLine : WORD);
  VAR
    CursReg : Registers;                              { Set Cursor Scan Lines }
  BEGIN
    WITH CursReg DO
      BEGIN
        AH := $01;
        CH := StartLine;
        CL := StopLine;
      END;
    INTR($10, CursReg);
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE SetWBorders(Screen : BYTE);
  VAR
    i    : BYTE;                         { Sets window coordinates and writes }
    Line : STRING[78];                   { border and title when applicable   }
  BEGIN
    WINDOW(1, 1, 80, 25);
    IF (Screen > 0) AND (WStackSize > 0) THEN
      BEGIN
        WCurr := WSetWindow[Screen];
        WITH WCurr DO
          BEGIN
            IF WBorder THEN
              BEGIN
                FILLCHAR(Line, SIZEOF(Line), '─');
                Line[0] := CHR(WX2 - WX1 - 1);
                GOTOXY(WX1, WY1);
                WRITE('┌', Line, '┐');
                HIGHVIDEO;
                GotoXY(((WX2 - WX1 + 1 - LENGTH(WTitle)) DIV 2) + WX1, WY1);
                WRITE(WTitle);
                LOWVIDEO;
                FOR i := SUCC(WY1) TO PRED(WY2) DO
                  BEGIN
                    GOTOXY(WX1, i);    WRITE('│');
                    GOTOXY(WX2, i);    WRITE('│');
                  END;
                DisplayLine(WX1, WY2, WX2 - WX1 + 1, NormalVid, '└'+ Line + '┘');
                WINDOW(SUCC(WX1), SUCC(WY1), PRED(WX2), PRED(WY2))
              END
            ELSE WINDOW(WX1, WY1, WX2, WY2);
          END;
      END;
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE SetWindCoord(WindNum, X1, Y1, X2, Y2 : BYTE; Border : BOOLEAN;
                                           Title : Str15);
  BEGIN
    WITH WCurr DO             { Stores window information for later reference }
      BEGIN                   { by WindNum.  These only need to be set once   }
        WX1 := X1;            { per program but if you use a lot of windows   }
        WY1 := Y1;            { in an application they can be changed within  }
        WX2 := X2;            { a program to avoid the memory overhead.  In   }
        WY2 := Y2;            { one application in which I use these routines }
        WBorder := Border;    { for layered menus, SetWindCoord is called by  }
        WTitle := Title       { each menu procedure -- overhead for three     }
      END;                    { windows while using eighteen!                 }
    WSetWindow[WindNum] := WCurr;
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE WOpen(ScrNum : BYTE);
  BEGIN
    Inc(WStackSize);
    WITH WDisp[WStackSize] DO              { Saves contents of current screen }
      BEGIN                                { and opens new window             }
        WStackScr := ScrNum;
        WCursX := WHEREX;
        WCursY := WHEREY;
        NEW(WScreen);
        MOVE(WScreenPtr^, WScreen^, 4000);
      END;
    SetWBorders(ScrNum);
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE WClose;
  BEGIN                                                { Restores last screen }
    WITH WDisp[WStackSize] DO
      BEGIN
        MOVE(WScreen^, WScreenPtr^, 4000);
        DISPOSE(WScreen);
      END;
    Dec(WStackSize);
    SetWBorders(WDisp[WStackSize].WStackScr);
    WITH WDisp[SUCC(WStackSize)] DO GotoXY(WCursX, WCursY);
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE CursorOn(On : BOOLEAN);
  VAR
    CReg : Registers;
  BEGIN
    IF On THEN
      IF  VidAddr = $B000 THEN CReg.CX := $0C0D
      ELSE CReg.CX := $0607
    ELSE CReg.CX := $2000;
    CReg.AX := $0100;
    INTR($10, CReg);
    CursOn := On;
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE ClrLn(X, Y : BYTE);                { A procedure for lazy typists }
  BEGIN
    GotoXY(X, Y);
    CLREOL;
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE ClrArea(X1, Y1, X2, Y2 : BYTE);
  BEGIN                                  { Another procedure for lazy typists }
    WINDOW(X1, Y1, X2, Y2);
    CLRSCR;
    WINDOW(1, 1, 80, 25);
  END;
  { ------------------------------------------------------------------------- }

  PROCEDURE KbdStatus;
  CONST
    Caps    : BOOLEAN = FALSE;
    NumLock : BOOLEAN = FALSE;
  VAR
    KbdReg         : Registers;
    OldNum, OldCap : BOOLEAN;
  BEGIN
    WHILE NOT KEYPRESSED DO                       { Monitors status of shift  }
      BEGIN                                       { states while waiting for  }
        OldCap := Caps;                           { keyboard input.  Uses     }
        OldNum := NumLock;                        { DisplayLine to report     }
        FILLCHAR(KbdReg, SIZEOF(KbdReg), 0);      { status so that windows    }
        KbdReg.AH := 2;                           { can be overwritten.       }
        INTR($16, KbdReg);                        { SpaceStr is used to store }
        InsKeyOn := (KbdReg.AL AND $80) <> 0;     { the character at the      }
        Caps := (KbdReg.AL AND $40) <> 0;         { lower corner of screen.   }
        NumLock := (KbdReg.AL AND $20) <> 0;      { InsKeyOn is global so it  }
        IF (NumLock <> OldNum) THEN               { can be used by ReadFld.   }
          BEGIN
            IF NumLock THEN DisplayLine(77, 25, 1, ReverseVid, '#')
            ELSE DisplayLine(77, 25, 1, NormalVid, SpaceStr);
          END;
        IF (Caps <> OldCap) THEN
          BEGIN
            IF Caps THEN DisplayLine(78, 25, 1, ReverseVid, 'C')
            ELSE DisplayLine(78, 25, 1, NormalVid, SpaceStr);
          END;
        IF CursOn THEN
          IF InsKeyOn THEN SetShape(StdStart-2, StdStop)    { Increase cursor }
          ELSE SetShape(StdStart, StdStop);                 { size when on    }
      END;
  END;
  { ------------------------------------------------------------------------- }

  {$F+}
  PROCEDURE FMScreenExit;  {$F-}
  BEGIN
    SetShape(StdStart, StdStop);      { Restore cursor before program ends. }
    ExitProc := ExitSave;
  END;
  { ------------------------------------------------------------------------- }

BEGIN
  InitVideo;          { Initializes video memory location and color variables }
  GetShape(StdStart, StdStop);         { Stores cursor scan lines at start-up }
  CheckBreak := FALSE;
  SetWindCoord(1, 1, 1, 80, 25, TRUE, ' Spool Control ');
  SetWindCoord(2, 1, 1, 80, 25, TRUE, ' File Manager ');
  SetWindCoord(3, 1, 1, 80, 25, FALSE, '');                            { View }
  SetWindCoord(4, 18, 8, 63, 22, TRUE, ' Help ');
  ExitSave := ExitProc;
  ExitProc := @FMScreenExit;
END.