[Back to SCREEN SWAG index] [Back to Main SWAG index] [Original]

    unit scrn;
    {$D-,I-,S-,V-}
    interface
    Uses
            Dos;
    Const
          display : Boolean = true;
          FGround : Byte = 0;
          BGround : Byte = 0;
          attribute : Byte = 0;
          apage : Word = $B800;
          apoint : Word = 0;
          { foreground and background colors }
          Black        = 0;
          Blue         = 1;
          Green        = 2;
          Cyan         = 3;
          Red          = 4;
          Magenta      = 5;
          Brown        = 6;
          LightGray    = 7;

          { foreground colors }
          DarkGray     = 8;
          LightBlue    = 9;
          LightGreen   = 10;
          LightCyan    = 11;
          LightRed     = 12;
          LightMagenta = 13;
          Yellow       = 14;
          White        = 15;

          { add for blinking characters }
          Blink        = 128;

    VAR
            regs : Registers;

    Function GetMode : Byte;
    {returns the current video mode}

    Procedure SetMode (m : Byte);
    {sets the video mode}

    Procedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);
    {scrolls the window up (nbr is +) or down (nbr is -)}
    {If nbr is 0 or out of range then the screen clears}
    {ur is the upper row, lc is the left column,
     lr is the lower row, and rc is the right column}
    {Note:  using an out-of-range number may have unpredictable
     results on the colors...it is not recommended}

    Procedure SetCursor (s, e : Byte);
    {sets the size of the cursor}
    {s is the starting line, e is the ending line}

    Procedure SetAPage (page : Word);
    {Set the Active (drawing) page}

    Procedure SetVPage (vpage : Byte);
    {Set the display page}

    Function DisplayCursor (display1 : Boolean) : Boolean;
    {hides or displays the cursor}

    Function Xis : Byte;
    {Tells you what the X coordinate is for the current active page}

    Function Yis : Byte;
    {Tells you what the Y coordinate is for the current active page}

    Procedure PXY (x, y : Byte);
    {sets the coordinates on the current active page}
    {To move the cursor on the visual page, first make the visual page
     and active page the same}
    {x is the row, y is the column}

    Procedure SetFGround (FG : Byte);
    {sets the foreground color}
    {constants can be used}
    {add 128 or the constant BLINK to make the foreground blink}

    Procedure SetBGround (BG : Byte);
    {sets the background color}
    {constants can be used}

    Procedure PWrite (S : String);
    {writes a string to the current active page}
    {numbers must be converted to a string before calling this procedure}

    Procedure PWriteln (S : String);

    Procedure ClrScrn;
    {Clear the current active page}

    implementation

    Function GetMode : Byte;
    {returns the current video mode}
    Begin
         regs.ah := $0F;
         Intr($10,regs);
         GetMode := regs.al;
    End;

    Procedure SetMode (m : Byte);
    {sets the video mode}
    Begin
         regs.ah := 0;
         regs.al := m;
         Intr($10,regs);
    End;

    Procedure Scroll (ur, lc, lr, rc : Byte; nbr : ShortInt);
    {scrolls the window up (nbr is +) or down (nbr is -)}
    {If nbr is 0 or out of range then the screen clears}
    Begin
            Dec(ur);
            Dec(lc);
            Dec(lr);
            Dec(rc);
            If nbr < 0 Then regs.ah := 7 Else regs.ah := 6;
            regs.al := Abs(nbr);
            regs.bh := attribute;
            regs.ch := ur;
            regs.cl := lc;
            regs.dh := lr;
            regs.dl := rc;
            Intr($10,regs);
    End;

    Procedure SetCursor (s, e : Byte);
    Begin
            regs.ah := 1;
            regs.ch := s;
            regs.cl := e;
            Intr($10,regs);
    End;

    Procedure SetAPage (page : Word);
    Begin
            apage := $B800 + (page * $100);
    End;

    Procedure SetVPage (vpage : Byte);
    Begin
            regs.ah := 5;
            regs.al := vpage;
            Intr($10,regs);
    End;

    Function DisplayCursor(display1 : Boolean) : Boolean;
    Begin
            If Not(display1) Then Begin
               regs.dh := 50;
               regs.dl := 0;
               End
            Else regs.dx := apoint;
            regs.ah := 2;
            regs.bh := (apage - $B800) DIV $100;
            Intr($10,regs);
            display := display1;
    End;

    Function Xis : Byte;
    Var        cpage : Word;
    Begin
            cpage := (apage - $B800) DIV $100;
            Xis := (Mem[$40:$51+(cpage * 2)]) + 1;
    End;

    Function Yis : Byte;
    Var        cpage : Word;
    Begin
            cpage := (apage - $B800) DIV $100;
            Yis := (Mem[$40:$50+(cpage * 2)]) + 1;
    End;

    Procedure PXY (x, y : Byte);
    Begin
            Dec(x);
            Dec(y);
            regs.dh := x;
            regs.dl := y;
            regs.ah := 2;
            regs.bh := (apage - $B800) DIV $100;
            Intr($10,regs);
            If Not(display) Then Begin
               regs.dh := 50;
               regs.dl := 0;
            regs.ah := 2;
            regs.bh := (apage - $B800) DIV $100;
            Intr($10,regs);
            End;
            apoint := x * 80 * 2 + y * 2;
    End;

    Procedure SetFGround (FG : Byte);
    Begin
            FGround := FG;
            attribute := BGround * 16 + FGround;
    End;

    Procedure SetBGround (BG : Byte);
    Begin
            BGround := BG;
            attribute := BGround * 16 + FGround;
    End;

    Procedure PWrite (S : String);
    Var
            Len, x, y : Byte;
            tmp : Word;
    Begin
            If Length(S) = 0 Then Exit;
            tmp := apoint;
            For Len := 0 To Length(S) - 1 Do Begin
                Mem[apage:apoint+Len] := Ord(S[Len+1]);
                Inc(apoint);
                Mem[apage:apoint+Len] := attribute;
            End;
            apoint := (tmp + Length(S) * 2) DIV 2;
            y := apoint MOD 80;
            x := apoint DIV 80;
            Inc(x);
            Inc(y);
            PXY(x,y);
            If Not(display) Then Begin
               regs.dh := 50;
               regs.dl := 0;
            regs.ah := 2;
            regs.bh := (apage - $B800) DIV $100;
            Intr($10,regs);
            End;
    End;

    Procedure PWriteln (S : String);
    Var
            Len, x, y : Byte;
            tmp : Word;
    Begin
            If Length(S) = 0 Then Exit;
            tmp := apoint;
            For Len := 0 To Length(S) - 1 Do Begin
                Mem[apage:apoint+Len] := Ord(S[Len+1]);
                Inc(apoint);
                Mem[apage:apoint+Len] := attribute;
            End;
            apoint := (tmp + Length(S) * 2) DIV 2;
            x := apoint DIV 80 + 2;
            y := 1;
            PXY(x,y);
            If Not(display) Then Begin
               regs.dh := 50;
               regs.dl := 0;
            regs.ah := 2;
            regs.bh := (apage - $B800) DIV $100;
            Intr($10,regs);
            End;
    End;

    Procedure ClrScrn;
    Var
            x : Word;
    Begin
            x := 0;
            While x < 4048 Do Begin
              Mem[apage:x] := $20;
              Inc(x);
              Mem[apage:x] := attribute;
              Inc(x);
              End;
    End;

    {initializes the foreground and backbround colors}
    Begin
            regs.ah := 8;
            regs.bh := 0;
            Intr($10,regs);
            attribute := regs.ah;
            FGround := attribute MOD 16;
            BGround := (attribute - FGround) DIV 16;
    End.

[Back to SCREEN SWAG index] [Back to Main SWAG index] [Original]