Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/MISC/CONSOLE.ZIP/CONSOLE.MOD

Modula Implementation | 1988-04-18 | 11.9 KB | 360 lines

IMPLEMENTATION MODULE Console;

(************************************************************************)
(* COPYRIGHT 1988 by David Albert                                       *)
(* You may use this module in any of your work and distribute it freely *)
(* Provided that:    1) The copyright notice is not changed or removed  *)
(*                   2) The module is not modified                      *)
(*                   3) Under NO conditions is this module to be sold   *)
(************************************************************************)

IMPORT ASCII;
FROM SYSTEM   IMPORT ASSEMBLER;
FROM TermBase IMPORT AssignWrite, UnAssignWrite;

CONST  BIOSVidInt = 10H;
       SetMode    = 0000H;  (* Set video mode 0-7                   *)
       GetMode    = 0F00H;  (* Get current video mode               *)
       SetCurSize = 0100H;  (* Set cursor size 0-7 or 0-13          *)
       MoveCursor = 0200H;  (* Move cursor to position X,Y          *)
       CursorPos  = 0300H;  (* Get current cursor position          *)
       ReadLtPen  = 0400H;  (* Get light pen position and status    *)
       SetPage    = 0500H;  (* Set video page 0-7 or 0-3            *)
       ScrlUp     = 0600H;  (* Scroll a window up N lines           *)
       ScrlDn     = 0700H;  (* Scroll a window down N lines         *)
       GetChAttr  = 0800H;  (* Get character and attribute at X,Y   *)
       PutChAttr  = 0900H;  (* Put character and attribute to X,Y   *)
       PutCh      = 0A00H;  (* Put character at X,Y leave cur. attr *)
       SetColor   = 0B00H;  (* Set color in modes 1-4               *)
       WritePixel = 0C00H;  (* Set the color of a pixel X,Y         *)
       ReadPixel  = 0D00H;  (* Get the color of pixel X,Y           *)
       WriteTTY   = 0E00H;  (* Teletype character output            *)

VAR WriteStolen  : BOOLEAN;

PROCEDURE ClearScreen ();
BEGIN
  ScrollUp(0);             (* Clear Screen via BIOS                 *)
  GotoXY(1,1);             (* Home cursor                           *)
END ClearScreen;

PROCEDURE ClearEOL();
VAR NumSpaces : CARDINAL;
BEGIN
  NumSpaces := CurWindow.X2 - WhereX();
  PutChar(' ',NumSpaces);
END ClearEOL;

PROCEDURE GetVidCh() : CARDINAL;
VAR Char : CARDINAL;
BEGIN
  ASM
     MOV  AH, 08H
     MOV  BX, 00H
     PUSH BP
     INT  10H
     POP  BP
     MOV  Char, AX
  END;
  RETURN Char;
END GetVidCh;

PROCEDURE GetVidMode() : CARDINAL;
VAR Mode : CARDINAL;
BEGIN
  ASM
     MOV  AH, 0FH          (* Setup to read video mode              *)
     PUSH BP
     INT  10H              (* Perform interrupt                     *)
     POP  BP
     MOV  Mode, AX         (* Mode returned in AH (scr width in AL) *)
  END;
  Mode :=  Mode MOD 100H;  (* Separate mode and screen width        *)
  RETURN Mode;
END GetVidMode;

PROCEDURE GotoXY (X,Y : CARDINAL);
VAR Position : CARDINAL;
BEGIN
  X := X + CurWindow.X1 - 1;                (* Adjust coordinates to    *)
  Y := Y + CurWindow.Y1 - 1;                (* current window           *)
  WITH CurWindow DO
    IF (X >= X1) AND (X <= X2) AND          (* Test to see if point X,Y *)
       (Y >= Y1) AND (Y <= Y2)              (* falls within window      *)
    THEN                                    (* If so, then              *)
       Position := (Y-1) * 100H + (X-1);    (* Convert position to word *)
       ASM
          MOV  AH, 02H
          MOV  BX, 00H                      (* Set video page to 0      *)
          MOV  DX, Position                 (* Store position in DX     *)
          PUSH BP                           (* PUSH BP                  *)
          INT  10H                          (* Perform interrupt        *)
          POP  BP                           (* POP BP                   *)
       END;
    END;
  END;
END GotoXY;

PROCEDURE Highlight();
BEGIN
  CurWindow.Attribute := 15;
END Highlight;

PROCEDURE Inverse ();
BEGIN
  CurWindow.Attribute := 112;
END Inverse;

PROCEDURE KeyPressed () : BOOLEAN;
VAR Result : CHAR;
BEGIN
  ASM
    MOV AH, 0BH
    INT 21H
    MOV Result, AL
  END;
  RETURN (Result <> 0C)
END KeyPressed;

PROCEDURE Normal();
BEGIN
  CurWindow.Attribute := 7;
END Normal;

PROCEDURE PutChar (Ch : CHAR; Num : CARDINAL);
VAR Attr : CARDINAL;
BEGIN
  IF (Num > 0) THEN
    Attr := CurWindow.Attribute;
    ASM
       MOV  AH, 09H          (* Set up for function call              *)
       MOV  AL, Ch           (* Load character into AL                *)
       MOV  BX, Attr         (* Load vid page and attr into BX *)
       MOV  CX, Num          (* CX gets number of characters to write *)
       PUSH BP               (* PUSH BP                               *)
       INT  10H              (* Perform interrupt                     *)
       POP  BP               (* POP BP                                *)
    END;
  END;
END PutChar;

PROCEDURE PutVidCh (ChAttr : CARDINAL);
VAR Char : CHAR;
    Attr : CARDINAL;
BEGIN
  Char := CHR(ChAttr MOD 100H);
  Attr := ChAttr DIV 100H;
  ASM
     MOV  AH, 09H          (* Setup for BIOS call                   *)
     MOV  AL, Char         (* Load character into AL                *)
     MOV  BX, Attr         (* Load video page and attribute into BX *)
     MOV  CX, 01H          (* CX gets number of characters to write *)
     PUSH BP               (* PUSH BP                               *)
     INT  10H              (* Perform interrupt                     *)
     POP  BP               (* POP BP                                *)
  END;
END PutVidCh;

PROCEDURE Read(VAR Ch : CHAR);
VAR Key : CHAR;
BEGIN
  ASM
    MOV  AH, 08
    INT  21H
    MOV  Key, AL
  END;
  Ch := Key;
END Read;

PROCEDURE ScrollDown(Lines : CARDINAL) ;
VAR TL,BR : CARDINAL;
BEGIN
  WITH CurWindow DO
    TL := Y1 * 100H + X1;                   (* calculate top left corner*)
    BR := Y2 * 100H + X2;                   (* calculate bot rt. corner *)
  END;
  Lines := Lines + 0700H;                   (* Setup to scroll down     *)
  ASM
     MOV AX, Lines                          (* Set lines to scroll      *)
     MOV BX, 0700H                          (* Set attr. for new lines  *)
     MOV CX, TL                             (* Store top left in CX     *)
     MOV DX, BR                             (* Store bottom right in DX *)
     PUSH BP                                (* PUSH BP                  *)
     INT  10H                               (* Call BIOS video interrupt*)
     POP  BP                                (* POP BP                   *)
  END;
END ScrollDown ;

PROCEDURE ScrollUp(Lines : CARDINAL) ;
VAR TL,BR : CARDINAL;
BEGIN
  WITH CurWindow DO
    TL := (Y1-1) * 100H + (X1-1);           (* calculate top left corner*)
    BR := (Y2-1) * 100H + (X2-1);           (* calculate bot rt. corner *)
  END;
  Lines := Lines + 0600H;                   (* Setup to scroll up       *)
  ASM
     MOV AX, Lines                          (* Set lines to scroll      *)
     MOV BX, 0700H                          (* Set attr. for new lines  *)
     MOV CX, TL                             (* Store top left in CX     *)
     MOV DX, BR                             (* Store bottom right in DX *)
     PUSH BP                                (* PUSH BP                  *)
     INT  10H                               (* BIOS Video interrupt     *)
     POP  BP                                (* POP BP                   *)
  END;
END ScrollUp ;

PROCEDURE SetCursorSize(Top, Bottom : CARDINAL);
BEGIN
  ASM
     MOV AH, 01
     MOV CH, BYTE Top
     MOV CL, BYTE Bottom
     PUSH BP
     INT  10H
     POP  BP
  END;
END SetCursorSize;

PROCEDURE SetVidMode (Mode : CARDINAL);
BEGIN
  ASM
     MOV  AX, Mode          (* Load AX with new video mode          *)
     PUSH BP                (* PUSH BP                              *)
     INT  10H               (* Perform interrupt                    *)
     POP  BP                (* POP  BP                              *)
  END;
END SetVidMode;

PROCEDURE WhereX () : CARDINAL;
VAR Pos : CARDINAL;
BEGIN
  ASM
     MOV  AH, 03H          (* BIOS Call to read cursor position     *)
     MOV  BX, 00H          (* Set current video page to 0           *)
     PUSH BP               (* PUSH BP                               *)
     INT  10H              (* Perform interrupt                     *)
     POP  BP               (* POP BP                                *)
     MOV  Pos, DX          (* Read cursor position from DX          *)
  END;
  Pos := (Pos MOD 100H)+1; (* separate X position                   *)
  WITH CurWindow DO
     IF (Pos >= X1) AND (Pos <=X2)
       THEN Pos := Pos - X1 + 1;
       ELSE Pos := 0;
     END;
  END;
  RETURN Pos;
END WhereX;

PROCEDURE WhereY () : CARDINAL;
VAR Pos : CARDINAL;
BEGIN
  ASM
     MOV  AH, 03H          (* Prepare to read cursor position       *)
     MOV  BX, 00H          (* Set current video page to 0           *)
     PUSH BP               (* PUSH BP                               *)
     INT  10H              (* Perform interrupt                     *)
     POP  BP               (* POP BP                                *)
     MOV  Pos, DX          (* Read cursor position from DX          *)
  END;
  Pos := (Pos DIV 100H)+1; (* separate Y position                   *)
  WITH CurWindow DO
     IF (Pos >= Y1) AND (Pos <= Y2)
       THEN Pos := Pos - Y1 + 1;
       ELSE Pos := 0;
     END;
  END;
  RETURN Pos;
END WhereY;

PROCEDURE Window(X1, Y1, X2, Y2 : CARDINAL);
BEGIN
  CurWindow.X1 := X1;  CurWindow.Y1 := Y1;
  CurWindow.X2 := X2;  CurWindow.Y2 := Y2;
END Window;

PROCEDURE WriteChar (Ch : CHAR);
BEGIN
  ASM
     MOV  AH, 0EH          (* Use teletype output                   *)
     MOV  AL, Ch           (* Char to be printed goes in AL         *)
     PUSH BP               (* PUSH BP                               *)
     INT  10H              (* Perform interrupt                     *)
     POP  BP               (* POP BP                                *)
  END;
END WriteChar;

PROCEDURE Write (Ch : CHAR);
BEGIN
  WITH CurWindow DO
    CASE Ch OF
      ASCII.EOL: IF (WhereY() < (Y2 - Y1) )
                    THEN GotoXY(1,(WhereY()+1));
                    ELSE ScrollUp(1);
                         GotoXY(1,Y2-Y1);
                 END;
    | ASCII.CR : IF (WhereY() < (Y2 - Y1) )
                    THEN GotoXY(1,(WhereY()+1));
                    ELSE ScrollUp(1);
                         GotoXY(1,Y2-Y1);
                 END;
    | ASCII.LF : IF (WhereY() < (Y2-Y1) )
                    THEN GotoXY(WhereX(),(WhereY() + 1));
                    ELSE ScrollUp(1);
                         GotoXY(WhereX(),Y2-Y1);
                 END;
    | ASCII.BS : IF (WhereX() > 1)
                    THEN GotoXY((WhereX()-1),WhereY());
                 END;
    | ASCII.BEL: WriteChar(07C);
      ELSE       PutChar(Ch,1);
                 IF (WhereX() >= (X2-X1+1))
                    THEN IF (WhereY() = (Y2-Y1+1))
                           THEN ScrollUp(1);
                                GotoXY(1,Y2-Y1+1);
                           ELSE GotoXY(1,(WhereY()+1));
                         END;
                    ELSE GotoXY((WhereX()+1),WhereY());
                END;
    END;  (* Case statment     *)
  END;    (* With CurWindow Do *)
END Write;

PROCEDURE WriteLn ();
BEGIN
  Write(ASCII.CR);
END WriteLn;

PROCEDURE WriteString(S : ARRAY OF CHAR);
VAR Ndx : CARDINAL;
BEGIN
  Ndx := 0;
  WHILE (Ndx <= HIGH(S)) AND (S[Ndx] # 0C) DO
    Write(S[Ndx]);
    INC(Ndx);
  END;
END WriteString;

PROCEDURE StealWrite ();
BEGIN
  IF (NOT WriteStolen) THEN
     AssignWrite(Write,WriteStolen);
  END;
END StealWrite;

PROCEDURE ReturnWrite ();
BEGIN
  IF WriteStolen THEN
     UnAssignWrite(WriteStolen);
     WriteStolen := NOT WriteStolen;
  END;
END ReturnWrite;

BEGIN
  WriteStolen := FALSE;
  Window(1,1,ScreenSizeX,ScreenSizeY);
  Normal();
  StealWrite;
END Console.