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

    {
    Been digging through some old code and found this. I don't know if it will
    be useful to anybody now that we're living in the Windows age. However,
    why let old code stagnate? This unit is ready to go as is and may be useful
    to anyone STILL programming in DOS text mode.

    Note: This code is free for anyone to use as they wish. However, usage is
    at your OWN risk. I will not accept responsibility for any mishaps, mayhem
    or those little elves that appear at four in the mourning after you've
    downed
    a pint of a liquid you were told only contained 10% alcohol, but was really
    90%
    proof!

    { CRT2.PAS - by Daniel Dickman (adickman@massmed.org)
      Freeware. Comments, suggestions, enhancements welcome! }
    Unit Crt2;

    {$O+}

    Interface

    Type
      { Pointer to the screen }
      PScreen = ^TScreen;
      { Structured type representing the screen }
      TScreen = Record
        Pos : Array [1..25, 1..80] Of Record
          Ch : Char;
          At : Byte;
        End;
      End;

    Var
      { Array of multiple screens }
      Screen : Array [0..5] Of PScreen;
      { Current display page }
      Page   : Byte;

    { Sounds a simple beep through the PC speaker. }
    Procedure Beep;

    { Ordinarily, the text screen can only display 8 background colours. Using
    }
    { this procedure, you can change that so that you can have access to all
    }
    { 16 colours in the background (ie. all the brights). This procedure works
    }
    { by disabling the ability for you to have blinking characters. For a more
    }
    { technical description, see the manual. If On is True, you can only use 8
    }
    { background colours. If it is False, you have access to all 16.
    }
    Procedure Blink (On : Boolean);

    { This procedure allows complete control over the cursor size. }
    Procedure Cursor (StartLine, EndLine : Byte);

    { This procedure is used to initialise the number of logical screens }
    { specified in Number. }
    Procedure InitScreens (Number : Byte);

    { This function reads a character at a certain position on the screen. }
    Function ReadChar (X, Y : Byte) : Char;

    { Use this function to read the colour attribute at a certain position }
    { on the screen. }
    Function ReadColour (X, Y : Byte) : Byte;

    { This procedure is a functional extension to ReadChar }
    Function ReadString (Line, X1, X2 : Byte) : String;

    { As the name suggests, you can use this procedure to set the text screen's
    }
    { border colour. }
    Procedure SetBorder (Colour : Byte);

    { This procedure allows complete control over the exact colour of each }
    { palette entry. }
    Procedure SetPalette (PaletteNum : Word; Red, Green, Blue : Byte);

    { Used internally during initialisation. }
    Function VidSeg : Word;

    { A procedure to that writes directly to video memory. }
    Procedure FWrite (X, Y : Byte; S : String; At : Byte);

    { A procedure that only writes the background colour }
    Procedure FWriteBgColour (Line, X1, X2, At : Byte);

    { A procedure that only writes the foreground colour }
    Procedure FWriteFgColour (Line, X1, X2, At : Byte);

    { A procedure that writes both background and foreground colours }
    Procedure FWriteColour (Line, X1, X2, At : Byte);

    { A procedure that is the same as Write except that it uses doesn't change
    }
    { the screens set colour }
    Procedure FWriteText (X, Y : Byte; S : String);

    Implementation

    Procedure Beep;
    Begin
      System.Write (#7);
    End;

    Procedure Blink (On : Boolean);

      Procedure BlinkAsm (L : Byte); Assembler;
      Asm
        MOV  AH,$10   { Specify Service 10h   }
        MOV  AL,$03   { Specify Function 03h  }
        MOV  BL,L     { $00 = Intensity       }
                      { $01 = Blinking        }
        INT  $10      { BIOS Video Interrupt  }
      End;

    Begin
      If On Then
        BlinkAsm ($01)
      Else
        BlinkAsm ($00);
    End;

    Procedure Cursor (StartLine, EndLine : Byte); Assembler;
    Asm
      MOV  AH,01h         { Specify service 01h         }
      MOV  CH,StartLine   { Scan line on which to start }
      MOV  CL,EndLine     { Scan line on which to end   }
      INT  10h            { BIOS video interrupt        }
    End;

    Procedure InitScreens (Number : Byte);
    Var
      A : Integer;
    Begin
      For A := 1 To Number Do
        New (Screen[A]);
    End;

    Function ReadChar (X, Y : Byte) : Char;
    Begin
      ReadChar := Screen[Page]^.Pos[Y, X].Ch;
    End;

    Function ReadString (Line, X1, X2 : Byte) : String;
    Var
      Temp : String;
      Counter : Byte;
    Begin
      Temp := '';
      For Counter := X1 To X2 Do
        Begin
          Temp := Temp + Screen[Page]^.Pos[Line, Counter].Ch;
        End;
      ReadString := Temp;
    End;

    Function ReadColour (X, Y : Byte) : Byte;
    Begin
      ReadColour := Screen[Page]^.Pos[Y, X].At;
    End;

    Procedure SetBorder (Colour : Byte); Assembler;
    Asm
      MOV  AH,$10      { Specify service 10h  }
      MOV  AL,$01      { Specify function 01h }
      MOV  BH,Colour   { Set border colour    }
      INT  $10         { BIOS video interrupt }
    End;

    Procedure SetPalette (PaletteNum : Word; Red, Green, Blue : Byte);
    Assembler;
    Asm
      MOV  AH,$10          { Specify Service 10h    }
      MOV  AL,$10          { Specify Function 10h   }
      MOV  BX,PaletteNum   { Colour Register to set }
      MOV  DH,Red          { Red value to set       }
      MOV  CH,Green        { Green value to set     }
      MOV  CL,Blue         { Blue value to set      }
      INT  $10             { BIOS Video Interrupt   }
    End;

    Function VidSeg : Word;
    Begin
      If Mem[$0000:$0449] = 7 Then
        VidSeg := $B000
      Else
        VidSeg := $B800;
    End;

    Procedure FWrite (X, Y : Byte; S : String; At : Byte);
    Var
      Counter : Byte;
    Begin
      For Counter := 1 To Length(S) Do
        Begin
          Screen[Page]^.Pos[Y, X].Ch := S[Counter];
          Screen[Page]^.Pos[Y, X].At := At;
          Inc (X);
        End;
    End;

    Procedure FWriteText (X, Y : Byte; S : String);
    Var
      Counter : Byte;
    Begin
      For Counter := X To (Length(S) + X - 1) Do
        Screen[Page]^.Pos[Y, Counter].Ch := S[Counter - X + 1];
    End;

    Procedure FWriteColour (Line, X1, X2, At : Byte);
    Var
      Counter : Byte;
    Begin
      For Counter := X1 To X2 Do
        Screen[Page]^.Pos[Line, Counter].At := At;
    End;

    Procedure FWriteFgColour (Line, X1, X2, At : Byte);
    Var
      B : Byte;
      Counter : Byte;
    Begin
      For Counter := X1 To X2 Do
        Begin
          B := Screen[Page]^.Pos[Line, Counter].At;
          B := B And 240; {11110000}
          B := B + At;
          Screen[Page]^.Pos[Line, counter].At := B;
        End;
    End;

    Procedure FWriteBgColour (Line, X1, X2, At : Byte);
    Var
      A : Byte;
      C : Byte;
      Counter : Byte;
    Begin
      A := At Shl 4;
      For Counter := X1 To X2 Do
        Begin
          C := Screen[Page]^.Pos[Line, Counter].At;
          C := C And 15; {00001111}
          C := C + A;
          Screen[Page]^.Pos[Line, Counter].At := C;
        End;
    End;

    Begin
      { Set the active page }
      Page := 0;
      { Initialize the physical screen }
      Screen[Page] := Ptr(VidSeg, $0000);
    End.

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