[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]