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

    {Here is a unit I wrote for a text game I'm working on... I'd like to know what
    everybody thinks about it... All of the drawing routines use a small virtual
    page, and some of them don't draw it to the real screen.  You can do that
    yourself using DisplayScreen.  I'm gonna squash out a bunch of blank lines to
    save space...
    { *********************************************************** }
    { ************************ Text Unit ************************ }
    { *********************************************************** }
    { ***************** Written by: Rick Haines ***************** }
    { ******************Snail-Mail: 1004 N. Alabama Ave. ******** }
    { ***************************** DeLand, FL 32724 ************ }
    { ***************** E-Mail: Keiichi@Dynasty.doi.com ********* }
    { *********************************************************** }
    { ****************** Last Revised 10/03/95 ****************** }
    { *********************************************************** }
    { ************** Copyright (C) 1995 Rick Haines ************* }
    { *********************************************************** }
    { ******** You may use this code in any way you wish ******** }
    { * I only "request" that you give me credit for writing it * }
    { *********************************************************** }

    {$IfDef Debug }
     {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
    {$Else}
     {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y-}
    {$EndIf}

    Unit Text;

    Interface

    Const
     ScrlL = 1;
     NumL  = 2;
     CapsL = 4;
    Const
     Black   = 0;
     Blue    = 1;
     Green   = 2;
     Cyan    = 3;
     Red     = 4;
     Violet  = 5;
     Orange  = 6;
     Gray    = 8;
     LGray   = 7;
     LBlue   = 9;
     LGreen  = 10;
     LCyan   = 11;
     LRed    = 12;
     LViolet = 13;
     Yellow  = 14;
     White   = 15;
     Blink   = 128;
    Type
     TBoxDef = Record
       VLine, HLine,
       X1Y1, X1Y2,
       X2Y1, X2Y2: Char;
      End;
    Const
     SingleLine: TBoxDef =
      (VLine:#179; HLine:#196;
       X1Y1:#218; X1Y2:#192;
       X2Y1:#191; X2Y2:#217);
     DoubleLine: TBoxDef =
      (VLine:#186; HLine:#205;
       X1Y1:#201; X1Y2:#200;
       X2Y1:#187; X2Y2:#188);
     SingleTop: TBoxDef =
      (VLine:#186; HLine:#196;
       X1Y1:#214; X1Y2:#211;
       X2Y1:#183; X2Y2:#189);
     DoubleTop: TBoxDef =
      (VLine:#179; HLine:#205;
       X1Y1:#213; X1Y2:#212;
       X2Y1:#184; X2Y2:#190);
    Procedure KeyBReset;
    Procedure KeyBEnable;
    Procedure KeyBDisable;
    Procedure SetLeds(Leds: Byte);
    Procedure SetLocks(Locks: Byte);
    Procedure ClearLocks(Locks: Byte);
    Procedure ToggleLocks(Locks: Byte);
    Procedure ClearKeyBuf;
    Function  GetKey: Char;
    Function  ReadKey: Char;
    Procedure PutKey(Key: Char);
    Function  GetScanCode: Byte;
    Function  ReadScanCode: Byte;
    Function  KeyPressed: Boolean;

    Procedure HideCursor;
    Procedure ShowCursor;
    Procedure DisplayScreen;
    Procedure ClearScreen;
    Procedure ClearArea(X1, Y1, X2, Y2: Byte);

    Procedure SetColor(Color: Byte);
    Procedure SetBGColor(Color: Byte);

    Procedure WriteCharXY(X, Y: Byte; AChar: Char);
    Procedure WriteStrXY(X, Y: Byte; TextStr: String);
    Procedure TWrite(AString: String);
    Procedure TWriteln(AString: String);
    Procedure SDown(NumOfLines: Byte);

    Function GetX: Byte;
    Function GetY: Byte;
    Procedure CursorXY(X, Y: Byte);

    Procedure DrawHLine(X, Y, Length: Byte; AChar: Char);
    Procedure DrawVLine(X, Y, Length: Byte; AChar: Char);
    Procedure DrawBox(X1, Y1, X2, Y2: Byte; Border: TBoxDef);
    Procedure OpenBox(X1, Y1, X2, Y2: Byte; Border: TBoxDef);
    Procedure CloseBox(X1, Y1, X2, Y2: Byte; Border: TBoxDef);

    Procedure SaveScreen(Name: String);
    Procedure LoadScreen(Name: String);

    Implementation

    Var
     ExitSave,
     Screen: Pointer;
     TextSeg: Word;
     CursorX,
     CursorY: Byte;
     TextColor,
     LastMode: Byte;
    Const
     VRTPort = $03DA;
    Procedure ScrollUp; Assembler;
     Asm
      ClD
      Push ds
      Les di, Screen
      Lds si, Screen
      Add si, 160
      Mov cx, 2000-80
      Rep MovSW
      Mov ax, 0
      Mov cx, 80
      Rep StoSW
      Pop ds
     End;
    Procedure ScrollDown; Assembler;
     Asm
      StD
      Push ds
      Les di, Screen
      Lds si, Screen
      Add di, 4000
      Add si, 4000-160
      Mov cx, 2000-79
      Rep MovSW
      Mov ax, 0
      Mov cx, 80
      Rep StoSW
      Pop ds
      ClD
     End;
    Procedure H_CursorXY(X, Y: Byte); Assembler;
     Asm
      Mov dh, Y
      Mov dl, X
      Mov ah, 02h
      Xor bh, bh
      Int 10h
     End;
    Procedure KeyBReset; Assembler;
     Asm
      Mov dx, 60h
      Mov al, 0FFh
      Out dx, al
      Jmp @@Delay
     @@Delay:
     End;
    Procedure KeyBEnable; Assembler;
     Asm
      Mov dx, 60h
      Mov al, 0F4h
      Out dx, al
      Jmp @@Delay
     @@Delay:
     End;
    Procedure KeyBDisable; Assembler;
     Asm
      Mov dx, 60h
      Mov al, 0F5h
      Out dx, al
      Jmp @@Delay
     @@Delay:
     End;
    Procedure SetLeds(Leds: Byte); Assembler;
     Asm
      Mov dx, 60h
      Mov al, 0EDh
      Out dx, al
      Jmp @@LightLeds
     @@LightLeds:
      Mov al, Leds
      Out dx, al
     End;
    Procedure SetLocks(Locks: Byte); Assembler;
     Asm
      Mov ax, 40h
      Mov es, ax
      Mov bx, 17h
      Mov ah, es:[bx]
      Mov al, Locks
      Mov cl, 4
      ShL al, cl
      Or ah, al
      Mov es:[bx], ah
     End;
    Procedure ClearLocks(Locks: Byte); Assembler;
     Asm
      Mov ax, 40h
      Mov es, ax
      Mov bx, 17h
      Mov ah, es:[bx]
      Mov al, Locks
      Mov cl, 4
      ShL al, cl
      Not al
      And ah, al
      Mov es:[bx], ah
     End;
    Procedure ToggleLocks(Locks: Byte); Assembler;
     Asm
      Mov ax, 40h
      Mov es, ax
      Mov bx, 17h
      Mov ah, es:[bx]
      Mov al, Locks
      Mov cl, 4
      ShL al, cl
      Xor ah, al
      Mov es:[bx], ah
     End;
    Procedure ClearKeyBuf; Assembler;
     Asm
      Mov ax, 0C02h
      Int 21h
     End;
    Function GetKey: Char; Assembler;
     Asm
      Mov ah, 1
      Int 16h
     End;
    Function ReadKey: Char; Assembler;
     Asm
      Mov ax, 0
      Int 16h
     End;
    Procedure PutKey(Key: Char); Assembler;
     Asm
      Mov ah, 05h
      Mov cl, Key
      Xor ch, ch
      Int 16h
     End;
    Function GetScanCode: Byte; Assembler;
     Asm
      Mov ah, 1
      Int 16h
      Mov al, ah
     End;
    Function ReadScanCode: Byte; Assembler;
     Asm
      Mov ax, 0
      Int 16h
      Mov al, ah
     End;
    Function KeyPressed: Boolean; Assembler;
     Asm
      Mov ah, 01
      Int 16h
      JNZ @@Key
      Xor ax, ax
      Jmp @@Done
     @@Key:
      Mov ax, 01h
     @@Done:
     End;
    Procedure HideCursor; Assembler;
     Asm
      Mov ah, 01h
      Mov cx, 2000h
      Int 10h
     End;
    Procedure ShowCursor; Assembler;
     Asm
      Mov ah, 01h
      Mov cx, 0607h
      Int 10h
     End;
    Procedure DisplayScreen; Assembler;
     Asm
      ClD
      Push ds
      Mov di, TextSeg
      Mov es, di
      Xor di, di
      Lds si, Screen
      Mov cx, 2000
    { Wait for Vertical Retrace (So we don't shear) }
      Mov  dx, VRTPort
     @@VRT:
      In al, dx
      Test al, 8
      JNZ @@VRT   { If VRT in progress, wait for it to stop }
     @@NoVRT:
      In al, dx
      Test al, 8
      JZ @@NoVRT  { Wait for next VRT }
    { Copy the Screen }
      Rep MovSW
      Pop ds
     End;
    Procedure ClearScreen; Assembler;
     Asm
      ClD
      Les di, Screen
      Xor ax, ax
      Mov ah, TextColor
      Mov cx, 2000
      Rep StoSW
     End;
    Procedure ClearArea(X1, Y1, X2, Y2: Byte); Assembler;
     Asm
      ClD
      Les di, Screen
    { Get Offset in Video Mem }
      Xor ax, ax   { Offset = (Y * 180) + (X * 2) }
      Mov al, Y1
      Mov cl, 7
      ShL ax, cl   { = (Y * 128) }
      Mov bx, ax
      ShR ax, 1    { + (Y *  32) }
      ShR ax, 1
      Add ax, bx
      Xor bx, bx
      Mov bl, X1
      ShL bx, 1    { + (X * 2) }
      Add ax, bx
      Add di, ax
    { Get X and Y Lengths }
      Mov bl, X2
      Sub bl, X1
      Mov bh, Y2
      Sub bh, Y1
      Add bx, 0101h
    { Get # to add for next line }
      Xor dx, dx
      Mov dl, 80
      Sub dl, bl
      ShL dl, 1
    { Clear Area }
      Xor cx, cx
      Xor ax, ax
      Mov ah, TextColor
     @@YLoop:
      Mov cl, bl
      Rep StoSW
      Add di, dx
      Dec bh
      JNZ @@YLoop
     End;
    Procedure SetColor(Color: Byte);
     Begin
      TextColor := (TextColor And $70) Or Color;
     End;
    Procedure SetBGColor(Color: Byte);
     Begin
      If Color > 8 Then Exit;
      TextColor := (TextColor And $8F) Or (Color ShL 4);
     End;
    Procedure WriteCharXY(X, Y: Byte; AChar: Char); Assembler;
     Asm
      Les di, Screen
    { Get Offset in Video Mem }
      Xor ax, ax   { Offset = (Y * 180) + (X * 2) }
      Mov al, Y
      Mov cl, 7
      ShL ax, cl   { = (Y * 128) }
      Mov bx, ax
      ShR ax, 1    { + (Y *  32) }
      ShR ax, 1
      Add ax, bx
      Xor bx, bx
      Mov bl, X
      ShL bx, 1    { + (X * 2) }
      Add ax, bx
      Add di, ax
    { Write String }
      Mov ah, TextColor     { ah = TextColor, al = Char }
      Mov al, AChar
      Mov es:[di], ax
     End;
    Procedure WriteStrXY(X, Y: Byte; TextStr: String); Assembler;
     Asm
      Les di, Screen
    { Get Offset in Video Mem }
      Xor ax, ax   { Offset = (Y * 180) + (X * 2) }
      Mov al, Y
      Mov cl, 7
      ShL ax, cl   { = (Y * 128) }
      Mov bx, ax
      ShR ax, 1    { + (Y *  32) }
      ShR ax, 1
      Add ax, bx
      Xor bx, bx
      Mov bl, X
      ShL bx, 1    { + (X * 2) }
      Add ax, bx
      Add di, ax
    { Write String }
      Push ds
      Mov ah, TextColor     { ah = TextColor, al = Char }
      Lds si, TextStr       { will be reversed when written to mem }
      Xor cx, cx
      Mov cl, [si]
      Inc si
     @@Repeat:
      Mov al, [si]
      Mov es:[di], ax
      Add di, 2
      Inc si
      Dec cl
      JNZ @@Repeat
      Mov al, 32
      Mov es:[di], ax
      Pop ds
     End;
    Procedure TWrite(AString: String);
     Begin
      If CursorY > 24 Then
       Begin
        ScrollUp;
        Dec(CursorY);
       End;
      If Length(AString) <> 0 Then WriteStrXY(CursorX, CursorY, AString);
      Inc(CursorX, Length(AString));
      While CursorX > 79 Do
       Begin
        Dec(CursorX, 80);
        Inc(CursorY);
        If CursorY > 24 Then
         Begin
          ScrollUp;
          Dec(CursorY);
         End;
       End;
      H_CursorXY(CursorX, CursorY);
      DisplayScreen;
     End;
    Procedure TWriteln(AString: String);
     Begin
      If CursorY > 24 Then
       Begin
        ScrollUp;
        Dec(CursorY);
       End;
      If Length(AString) <> 0 Then WriteStrXY(CursorX, CursorY, AString);
      Inc(CursorX, Length(AString));
      While CursorX > 79 Do
       Begin
        Dec(CursorX, 80);
        Inc(CursorY);
        If CursorY > 24 Then
         Begin
          ScrollUp;
          Dec(CursorY);
         End;
       End;
      Inc(CursorY);
      CursorX := 0;
      H_CursorXY(CursorX, CursorY);
      DisplayScreen;
     End;
    Procedure SDown(NumOfLines: Byte);
     Var
      I: Byte;
     Begin
      For I := 1 To NumOfLines Do
       Begin
        Inc(CursorY);
        If CursorY > 24 Then
         Begin
          ScrollUp;
          Dec(CursorY);
         End;
        H_CursorXY(CursorX, CursorY);
        DisplayScreen;
       End;
     End;
    Function GetX: Byte;
     Begin
      GetX := CursorX;
     End;
    Function GetY: Byte;
     Begin
      GetY := CursorY;
     End;
    Procedure CursorXY(X, Y: Byte);
     Begin
      CursorX := X; CursorY := Y;
      H_CursorXY(CursorX, CursorY);
     End;
    Procedure DrawHLine(X, Y, Length: Byte; AChar: Char); Assembler;
     Asm
      ClD
      Les di, Screen
    { Get Offset in Video Mem }
      Xor ax, ax   { Offset = (Y * 180) + (X * 2) }
      Mov al, Y
      Mov cl, 7
      ShL ax, cl   { = (Y * 128) }
      Mov bx, ax
      ShR ax, 1    { + (Y *  32) }
      ShR ax, 1
      Add ax, bx
      Xor bx, bx
      Mov bl, X
      ShL bx, 1    { + (X * 2) }
      Add ax, bx
      Add di, ax
    { Draw Line }
      Mov ah, TextColor
      Mov al, AChar
      Xor cx, cx
      Mov cl, Length
      Rep StoSW
     End;
    Procedure DrawVLine(X, Y, Length: Byte; AChar: Char); Assembler;
     Asm
    { Get Offset in Video Mem }
      Xor ax, ax   { Offset = (Y * 180) + (X * 2) }
      Mov al, Y
      Mov cl, 7
      ShL ax, cl   { = (Y * 128) }
      Mov bx, ax
      ShR ax, 1    { + (Y *  32) }
      ShR ax, 1
      Add ax, bx
      Xor bx, bx
      Mov bl, X
      ShL bx, 1    { + (X * 2) }
      Add bx, ax
    { Draw Line }
      Mov ah, TextColor
      Mov al, AChar
      Mov cl, Length
      Push ds
      Lds di, Screen
      Add di, bx
     @@YLoop:
      Mov [di], ax
      Add di, 160    { Bytes per Text Line }
      Dec cl
      JNZ @@YLoop
      Pop ds
     End;
    Procedure DrawBox(X1, Y1, X2, Y2: Byte; Border: TBoxDef);
     Var
      XLen, YLen: Byte;
     Begin
      XLen := X2 - X1; YLen := Y2 - Y1;
      With Border Do
       Begin
        ClearArea(X1, Y1, X2, Y2);
        DrawHLine(X1, Y1, XLen, HLine);
        DrawHLine(X1, Y2, XLen, HLine);
        DrawVLine(X1, Y1, YLen, VLine);
        DrawVLine(X2, Y1, YLen, VLine);
        WriteCharXY(X1, Y1, X1Y1);
        WriteCharXY(X1, Y2, X1Y2);
        WriteCharXY(X2, Y1, X2Y1);
        WriteCharXY(X2, Y2, X2Y2);
       End;
     End;
    Procedure OpenBox(X1, Y1, X2, Y2: Byte; Border: TBoxDef);
     Var
      XLen, YLen: Byte;
      I: Byte;
     Begin
      XLen := X2 - X1; YLen := Y2 - Y1;
      For I := (XLen-1) DownTo 0 Do
       Begin
        DrawBox(X1, Y1, X2-I, Y1+1, Border);
        DisplayScreen;
       End;
      For I := (YLen-1) DownTo 0 Do
       Begin
        DrawBox(X1, Y1, X2, Y2-I, Border);
        DisplayScreen;
       End;
     End;
    Procedure CloseBox(X1, Y1, X2, Y2: Byte; Border: TBoxDef);
     Var
      XLen, YLen: Byte;
      I, Temp: Byte;
     Begin
      XLen := X2 - X1; YLen := Y2 - Y1;
      For I := 0 To (XLen-1) Do
       Begin
        Temp := TextColor;
        SetBGColor(Black);
        ClearArea(X1, Y1, X2, Y2);
        TextColor := Temp;
        DrawBox(X1+I, Y1, X2, Y2, Border);
        DisplayScreen;
       End;
      For I := 0 To (YLen-1) Do
       Begin
        Temp := TextColor;
        SetBGColor(Black);
        ClearArea(X2-1, Y1, X2, Y2);
        TextColor := Temp;
        DrawBox(X2-1, Y1+I, X2, Y2, Border);
        DisplayScreen;
       End;
      Temp := TextColor;
      SetBGColor(Black);
      ClearArea(X2-1, Y2-1, X2, Y2);
      TextColor := Temp;
      DisplayScreen
     End;
    Procedure SaveScreen(Name: String);
     Var
      FileN: File;
     Begin
      If Pos('.', Name) = 0 Then Assign(FileN, Name + '.SCR');
      Rewrite(FileN);               { 128 * 32 = 4096 }
      BlockWrite(FileN, Mem[Seg(Screen):Ofs(Screen)], 32);
      Close(FileN);
     End;
    Procedure LoadScreen(Name: String);
     Var
      FileN: File;
     Begin
      If Pos('.', Name) = 0 Then Assign(FileN, Name + '.SCR');
      Reset(FileN);                 { 128 * 32 = 4096 }
      BlockRead(FileN, Mem[Seg(Screen):Ofs(Screen)], 32);
      Close(FileN);
     End;
    Function SetMode(Mode: Word): Byte; Assembler;
     Asm
      Mov ax, 0F00h
      Int 10h
      Push ax
      Mov ax, Mode
      Int 10h
      Pop ax
     End;
    Procedure TextExit; Far;
     Begin
      ExitProc := ExitSave;
      FreeMem(Screen, 4096);
      SetMode(LastMode);
     End;

    Begin
     KeyBReset;
     GetMem(Screen, 4096);
     ExitSave := ExitProc;
     ExitProc := @TextExit;
     LastMode := SetMode(3);
     TextSeg := $B800;
     CursorX := 0;
     CursorY := 0;
     SetBGColor(Black);
     SetColor(LGray);
     ClearScreen;
     DisplayScreen;
    End.

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