[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]
{ ANSI_IO [ANSI Input / Output Unit]
Written: 01/15/97-01/31/97
Author: Chad Moore
Requirements:
- 80386+ CPU
- Color CGA+ video adaptor (for 80x25C Textmode)
- Borland Turbo Pascal 6.0+ to compile
Recommended System:
- Color VGA video adaptor (for extended textmodes such as 80x50
or 80x43 on EGA)
Notes:
- This unit currently does not support changing the current video
mode. If you would like to enter a different mode such as 80x28,
80x30, 80x35, 80x43, 80x50, or 80x60 you must use a different
unit or your own code.
- When using the virtual screen set up for direct video output, all
cursor movements are still virtual. The actual text cursor will
not be modified by this program. (This does not hinder the unit
in any way.)
- To modify the screen size for direct video output, simply modify
the constant values below.
History:
v1.00: 01/15/97-01/20/97
- Features:
þ Object oriented code
þ Error handling
þ Buffered output (for scrolling)
þ Also supports direct video output
v1.01: 01/21/97
- FIXED: cursor positioning errors
- FIXED: error handling errors
v1.02: 01/23/97
- UPDATED: Changed 'ANSIHandlerObj.WriteCh' to support
CR/LF characters.
- FIXED: virtical wrap-around errors
- UPDATED: direct virtual screen routines _may_ support any
screen type (ex: 80x25, 80x43, 80x50), including non-standard
modes (ex: 80x28, 80x30)
- UPDATED: added "scrolling" to direct video output
v1.03: 01/26/97-01/28/97
- FIXED: 'ANSIHandlerObj.ClearFromCursorToEndOfLine' only worked
when 'VirtualScreen.Cursor.Y' was equal to 0.
- UPDATED: virtual screen routines were optomized-- some routines
were written in inline ASM, some lookup constants were added
to speed up some routines.
- UPDATED: 286 instructions for faster virtualscreen writing.
- UPDATED: removed a lot of "if" statements by adding a
single video screen size constant.
v1.04: 01/28/97-01/31/97
- Features:
þ ANSI routines for both input and output. These routines
can be used for converting an image -> ANSI code or ANSI
codes -> an image!
þ Much faster routines for faster loading and displaying!
- UPDATED: Changed 'VirtualScreenObj.WriteCh' to support
CR/LF characters.
- FIXED: WriteCh (ansi) didn't support the 'H' or 'f' commands
w/o parameters. (now defaults to 1,1)
- UPDATED: 386 instructions for faster virtualscreen writing.
Compiled with Borland International's Turbo Pascal 7.0 for DOS.
Tested on an Intel 486SX-20MHz system w/ a color VGA display.
Disclaimer:
There is no garentee that comes with this source code; the author of
this unit is NOT responsible for any direct or indirect damages
caused by this program. Use it at your own risk.
Contacting the author:
NOTE: All comments/questions/suggestions are welcome! Also, any
additions or modifications are welcome!
Chad Moore can be reached via Internet e-mail at: war@usaor.net
Or send a letter to: Chad Moore
535 Mellon Ave.
Rochester, PA
15074-1237
}
{$G+} { Enable 286/287 instructions }
unit ANSI_IO;
interface
const
{ Release information }
Version = $0104;
{ Defaults }
VideoSegment = $B800; { $B800 for color; DOES NOT SUPPORT MONO }
TextModeLength = 25; { # of lines in selected textmode }
TextModeWidth = 80;
{ Virtual screen constants }
VirtualScreenLength = 400; { Set to 'TextModeRows' for __ONLY__ direct video output }
VirtualScreenWidth = 80;
VirtualScreenSize = VirtualScreenLength * VirtualScreenWidth;
{ ANSI parameter constants }
ParameterBufferLength = 5;
ParameterBufferSize = ParameterBufferLength * 3;
{ ANSI Error values }
ANSIErrorListLength = 7;
ANSIErrorList : array [0..ANSIErrorListLength - 1] of string = (
'None',
'ANSI routines not initialized',
'Virtual screen not initialized',
'Invalid format',
'Too many parameters',
'Parameter too long',
'Cannot execute command'
);
type
PosRec = record
X : Byte;
Y : Integer;
end;
ScreenCharRec = record
Character,
Attribute : Byte;
end;
PScreenType = ^ScreenType;
ScreenType = array [0..VirtualScreenSize - 1] of ScreenCharRec;
VirtualScreenObj = object
ActiveAttribute : Byte;
DirectVideo : Boolean;
Data : PScreenType;
MemForData : Word;
EndOfBuffer : Boolean; { Not used w/ direct video }
Cursor : PosRec;
Initialized : Boolean;
procedure Error ( Command : Byte );
function Init : Byte;
function InitDirectVideo : Byte;
procedure DeInit;
procedure Clear;
procedure GotoXY ( X : Byte; Y : Integer );
procedure ScrollScreenUp; { Direct video __ONLY__ }
procedure WriteCR;
procedure WriteCh ( Ch : Char );
procedure WriteStr ( Str : string );
procedure WriteStrLn ( Str : string );
end;
ANSIHandlerObj = object
ParameterBuffer : array [0..ParameterBufferLength - 1,0..2] of Char;
ParameterRow,
ParameterColumn : Byte;
LastCharacter : Char;
Escape, EscapeSequence : Boolean;
SavedCursor : PosRec;
LastError : Byte;
procedure Init;
procedure DeInit;
procedure ClearParameterBuffer;
function ReturnParameters : string;
function Attribute : Boolean;
function ClearCommand : Boolean;
function EraseFromCursorToEndOfLine : Boolean;
function PositionCursor ( Command : Char ) : Boolean;
function CursorUp : Boolean;
function CursorDown : Boolean;
function CursorRight : Boolean;
function CursorLeft : Boolean;
function CursorUpCommand : Boolean;
function CursorDownCommand : Boolean;
function CursorRightCommand : Boolean;
function CursorLeftCommand : Boolean;
procedure SaveCursorLocation;
procedure RestoreCursorLocation;
function ProcessCommand ( Command : Char ) : Boolean;
function WriteCh ( Ch : Char ) : Byte;
procedure WriteStr ( Str : string );
function SetClearScreen : string;
function SetAttribute ( FromAttribute : Integer; ToAttribute : Byte ) : string;
function SetCursorPosition ( X, Y : Byte ) : string;
function SetCursorUp ( Num : Byte ) : string;
function SetCursorDown ( Num : Byte ) : string;
function SetCursorLeft ( Num : Byte ) : string;
function SetCursorRight ( Num : Byte ) : string;
function SetSaveCursorPosition : string;
function SetRestoreCursorPosition : string;
end;
var
ScreenWidth, ScreenLength, ScreenSize : Word;
VirtualScreen : VirtualScreenObj;
ANSIHandler : ANSIHandlerObj;
implementation
procedure VirtualScreenObj.Error ( Command : Byte );
type
ErrRec = record
Msg : string;
Cmd : Byte;
{ Cmd: $00 : None }
{ $01 : Halt }
end;
const
NumErrorTypes = $02;
ErrorHandler : array [0..NumErrorTypes - 1] of ErrRec = (
(Msg : ''; Cmd : $00),
(Msg : 'Out of Memory'; Cmd : $01)
{ This format of storing the errors & commands is very configurable }
);
begin
if ErrorHandler[Command].Msg <> '' then begin
WriteLn;
WriteLn('ERROR: ', ErrorHandler[Command].Msg);
end;
case ErrorHandler[Command].Cmd of
$01 : begin
Halt($0000);
end;
end;
end;
function VirtualScreenObj.Init : Byte;
begin
Init := $00;
MemForData := SizeOf(Data^);
if MaxAvail > MemForData then begin
{ Get memory }
GetMem(Data, MemForData);
{ Initialize values }
Clear;
EndOfBuffer := False;
ActiveAttribute := 7;
ScreenLength := VirtualScreenLength;
ScreenWidth := VirtualScreenWidth;
ScreenSize := ScreenLength * ScreenWidth;
Initialized := True;
DirectVideo := False;
end
else Init := $01;
end;
function VirtualScreenObj.InitDirectVideo : Byte;
begin
InitDirectVideo := $00;
{ Set Data -> VideoSegment:$0000 }
Data := Ptr(VideoSegment,$0000);
ScreenLength := TextModeLength;
ScreenWidth := TextModeWidth;
ScreenSize := TextModeLength * TextModeWidth;
DirectVideo := True;
{ Initialize values }
Clear;
EndOfBuffer := False;
Cursor.X := 0;
Cursor.Y := 0;
ActiveAttribute := 7;
Initialized := True;
end;
procedure VirtualScreenObj.DeInit;
begin
FreeMem(Data, MemForData);
ScreenWidth := 0;
ScreenLength := 0;
ScreenSize := 0;
end;
procedure VirtualScreenObj.Clear;
var
AA : Byte;
begin
AA := VirtualScreen.ActiveAttribute;
asm
mov cx,VideoSegment
mov es,cx
xor di,di
mov cx,ScreenSize { CX = ScreenSize/2 }
shr cx,1 { CX = ScreenSize/4 }
mov ah,AA
mov al,$20
db 66h; shl ax,16 { move AX to high word of EAX }
mov ah,AA
mov al,$20 { set AX again }
db 66h; rep stosw { REP STOSD }
end;
Cursor.X := 0; Cursor.Y := 0;
EndOfBuffer := False;
end;
procedure VirtualScreenObj.GotoXY ( X : Byte; Y : Integer );
begin
if (Cursor.Y < ScreenLength) and (Cursor.X < ScreenWidth) then begin
Cursor.X := X;
Cursor.Y := Y;
EndOfBuffer := False;
end;
end;
procedure VirtualScreenObj.ScrollScreenUp;
begin
{ adjust display }
Move(Mem[$B800:160],Mem[$B800:0],ScreenSize shl 1);
Dec(Cursor.Y);
end;
procedure VirtualScreenObj.WriteCR;
begin
Cursor.X := 0;
Inc(Cursor.Y);
if DirectVideo then begin
while Cursor.Y >= ScreenLength do ScrollScreenUp;
end
else begin
if Cursor.Y >= ScreenLength then begin
EndOfBuffer := True;
while Cursor.Y >= ScreenLength do Dec(Cursor.Y);
end;
end;
end;
procedure VirtualScreenObj.WriteCh ( Ch : Char );
var
Value : Integer;
begin
Value := Cursor.Y * ScreenWidth + Cursor.X;
{ This speeds up the routine ever so SLIGHTLY... }
if Ch = #10 then begin
Cursor.X := 0;
end
else if Ch = #13 then begin
Inc(Cursor.Y);
if DirectVideo then begin
while Cursor.Y >= ScreenLength do ScrollScreenUp;
end
else begin
if Cursor.Y >= ScreenLength then begin
EndOfBuffer := True;
while Cursor.Y >= ScreenLength do Dec(Cursor.Y);
end;
end;
end
else begin
VirtualScreen.Data^[Value].Character := Ord(Ch);
VirtualScreen.Data^[Value].Attribute := ActiveAttribute;
Inc(Cursor.X);
if Cursor.X >= ScreenWidth then begin
Cursor.X := 0;
Inc(Cursor.Y);
if DirectVideo then begin
while Cursor.Y >= ScreenLength do ScrollScreenUp;
end
else begin
if Cursor.Y >= ScreenLength then begin
EndOfBuffer := True;
while Cursor.Y >= ScreenLength do Dec(Cursor.Y);
end;
end;
end;
end;
end;
procedure VirtualScreenObj.WriteStr ( Str : string );
var
I : Byte;
begin
for I := 1 to Length(Str) do WriteCh(Str[I]);
end;
procedure VirtualScreenObj.WriteStrLn ( Str : string );
var
I : Byte;
begin
for I := 1 to Length(Str) do WriteCh(Str[I]);
WriteCR;
end;
procedure ANSIHandlerObj.Init;
begin
LastError := 0;
Escape := False;
EscapeSequence := False;
ClearParameterBuffer;
end;
procedure ANSIHandlerObj.DeInit;
begin
LastError := 1;
end;
procedure ANSIHandlerObj.ClearParameterBuffer;
begin
FillChar(ParameterBuffer,ParameterBufferSize,#255);
ParameterRow := 0;
ParameterColumn := 0;
end;
function ANSIHandlerObj.ReturnParameters : string;
var
I, J : Integer;
ParameterString : string;
begin
ParameterString := '';
for J := 0 to ParameterRow do
if J = ParameterRow then begin
for I := 0 to ParameterColumn do begin
if (I = 0) and (J > 0) then
if ParameterBuffer[J,I] <> #255 then ParameterString := ParameterString + ';';
if ParameterBuffer[J,I] <> #255 then ParameterString := ParameterString + ParameterBuffer[J,I];
end;
end
else begin
for I := 0 to 2 do begin
if (I = 0) and (J > 0) then ParameterString := ParameterString + ';';
if ParameterBuffer[J,I] <> #255 then ParameterString := ParameterString + ParameterBuffer[J,I];
end;
end;
ReturnParameters := ParameterString;
end;
function ANSIHandlerObj.Attribute : Boolean;
const
Colors : array [0..7] of Byte = (0, 4, 2, 6, 1, 5, 3, 7);
var
I, Foreground, Background,
Number, OldAttribute : Byte;
Intensity, Blink : Boolean;
begin
Attribute := True;
OldAttribute := VirtualScreen.ActiveAttribute;
if OldAttribute >= 128 then begin
Blink := True;
OldAttribute := OldAttribute - 128;
end
else Blink := False;
Background := (OldAttribute shr 4);
if (OldAttribute mod 16) > 7 then begin
Intensity := True;
Foreground := (OldAttribute mod 16) - 8;
end
else begin
Intensity := False;
Foreground := (OldAttribute mod 16);
end;
for I := 0 to ParameterBufferLength - 1 do begin
if ParameterBuffer[I,0] <> #255 then begin
if ParameterBuffer[I,1] = #255 then begin
Number := Ord (ParameterBuffer[I,0]) - 48;
end
else if ParameterBuffer[I,2] = #255 then begin
Number := (Ord (ParameterBuffer[I,0]) - 48) * 10;
Number := Number + (Ord (ParameterBuffer[I,1]) - 48);
end
else begin
Number := (Ord (ParameterBuffer[I,0]) - 48) * 100;
Number := Number + (Ord (ParameterBuffer[I,1]) - 48) * 10;
Number := Number + (Ord (ParameterBuffer[I,2]) - 48);
end;
case Number of
0 : begin
Foreground := 7;
Background := 0;
Intensity := False;
Blink := False;
end;
1 : Intensity := True;
5 : Blink := True;
7 : begin
OldAttribute := Foreground;
Foreground := Background;
Background := OldAttribute;
end;
30..37 : Foreground := Colors [Number - 30];
40..47 : Background := Colors [Number - 40];
else begin { Unknown command }
Attribute := False;
{ In this instance, the unknown command is ignoured and the
current block is not terminated. If desired, uncomment
the next line. }
{ Exit; }
end;
end;
end;
end;
VirtualScreen.ActiveAttribute := Background shl 4;
if Intensity then VirtualScreen.ActiveAttribute := VirtualScreen.ActiveAttribute + (Foreground + 8)
else VirtualScreen.ActiveAttribute := VirtualScreen.ActiveAttribute + Foreground;
if Blink then VirtualScreen.ActiveAttribute := VirtualScreen.ActiveAttribute + 128;
end;
function ANSIHandlerObj.ClearCommand : Boolean;
begin
ClearCommand := True;
if ParameterRow = 0 then begin
if ParameterBuffer[0,0] = #255 then ClearCommand := False
else if ParameterBuffer[0,1] = #255 then begin
case ParameterBuffer[0,0] of
{ '0' : ; }{ Clear from cursor up? }
{ '1' : ; }{ Clear from cursor down? }
'2' : VirtualScreen.Clear; { Clear screen }
else ClearCommand := False;
end;
end
else if ParameterBuffer[0,2] = #255 then ClearCommand := False;
end
else ClearCommand := False;
end;
function ANSIHandlerObj.EraseFromCursorToEndOfLine : Boolean;
var
ValueY : Word;
I, X, AA, Count : Byte;
begin
EraseFromCursorToEndOfLine := True;
if VirtualScreen.Initialized then begin
X := VirtualScreen.Cursor.X;
if VirtualScreen.DirectVideo then begin
ValueY := VirtualScreen.Cursor.Y * ScreenWidth;
Count := ScreenWidth - X;
end
else begin
ValueY := VirtualScreen.Cursor.Y * ScreenWidth;
Count := ScreenWidth - X;
end;
AA := VirtualScreen.ActiveAttribute;
asm
mov cx,VideoSegment
mov es,cx
mov di,ValueY
shl di,1
xor ah,ah
mov al,X
shl ax,1
add di,ax
shl di,1
xor ch,ch
mov cl,Count
shr cl,1
mov ah,AA { Set AX }
mov al,$20
db 66h; shl ax,16 { Shift AX -> high end of EAX }
mov ah,AA { Set AX }
mov al,$20
db 66h; rep stosw { REP STOSD }
end;
VirtualScreen.WriteCR;
end
else EraseFromCursorToEndOfLine := False;
end;
function ANSIHandlerObj.PositionCursor ( Command : Char ) : Boolean;
var
Number : Byte;
begin
PositionCursor := True;
if ParameterRow = 1 then begin
if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
else if ParameterBuffer[0,2] = #255 then begin
Number := 10 * (Ord (ParameterBuffer[1,0]) - 48);
Number := Number + (Ord (ParameterBuffer[1,1]) - 48);
end
else begin
Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
end;
if (Number > 0) and (Number <= ScreenLength) then VirtualScreen.Cursor.Y := Number - 1;
if ParameterBuffer[1,1] = #255 then Number := Ord (ParameterBuffer[1,0]) - 48
else if ParameterBuffer[1,2] = #255 then begin
Number := 10 * (Ord (ParameterBuffer[1,0]) - 48);
Number := Number + (Ord (ParameterBuffer[1,1]) - 48);
end
else begin
Number := 100 * (Ord (ParameterBuffer[1,0]) - 48);
Number := Number + (10 * (Ord (ParameterBuffer[1,1]) - 48));
Number := Number + (Ord (ParameterBuffer[1,2]) - 48);
end;
if (Number > 0) and (Number <= ScreenWidth) then VirtualScreen.Cursor.X := Number - 1;
end
else begin
VirtualScreen.Cursor.X := 0;
VirtualScreen.Cursor.Y := 0;
end;
end;
function ANSIHandlerObj.CursorUp : Boolean;
begin
CursorUp := True;
if VirtualScreen.Cursor.Y > 0 then begin
Dec(VirtualScreen.Cursor.Y);
end
else CursorUp := False;
end;
function ANSIHandlerObj.CursorDown : Boolean;
begin
CursorDown := True;
if VirtualScreen.Cursor.Y < ScreenLength - 1 then begin
Inc(VirtualScreen.Cursor.Y);
end
else CursorDown := False;
end;
function ANSIHandlerObj.CursorRight : Boolean;
begin
CursorRight := True;
if VirtualScreen.Cursor.X < ScreenWidth - 1 then begin
Inc(VirtualScreen.Cursor.X);
end
else begin
if VirtualScreen.Cursor.Y < ScreenLength - 1 then begin
Inc(VirtualScreen.Cursor.Y);
VirtualScreen.Cursor.X := 0;
end
else CursorRight := False;
end;
end;
function ANSIHandlerObj.CursorLeft : Boolean;
begin
CursorLeft := True;
if VirtualScreen.Cursor.X > 0 then begin
Dec(VirtualScreen.Cursor.X);
end
else CursorLeft := False;
end;
function ANSIHandlerObj.CursorUpCommand : Boolean;
var
I, Number : Byte;
begin
CursorUpCommand := True;
if ParameterRow = 0 then begin
if ParameterBuffer[0,0] = #255 then Number := 1
else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
else if ParameterBuffer[0,2] = #255 then begin
Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
end
else begin
Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
end;
if Number > 0 then for I := 1 to Number do begin
if not CursorUp then CursorUpCommand := False;
end;
end
else CursorUpCommand := False;
end;
function ANSIHandlerObj.CursorDownCommand : Boolean;
var
I, Number : Byte;
begin
CursorDownCommand := True;
if ParameterRow = 0 then begin
if ParameterBuffer[0,0] = #255 then Number := 1
else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
else if ParameterBuffer[0,2] = #255 then begin
Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
end
else begin
Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
end;
if Number > 0 then for I := 1 to Number do begin
if not CursorDown then CursorDownCommand := False;
end;
end
else CursorDownCommand := False;
end;
function ANSIHandlerObj.CursorRightCommand : Boolean;
var
I, Number : Byte;
begin
CursorRightCommand := True;
if ParameterRow = 0 then begin
if ParameterBuffer[0,0] = #255 then Number := 1
else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
else if ParameterBuffer[0,2] = #255 then begin
Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
end
else begin
Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
end;
if Number > 0 then for I := 1 to Number do begin
if not CursorRight then CursorRightCommand := False;
end;
end
else CursorRightCommand := False;
end;
function ANSIHandlerObj.CursorLeftCommand : Boolean;
var
I, Number : Byte;
begin
CursorLeftCommand := True;
if ParameterRow = 0 then begin
if ParameterBuffer[0,0] = #255 then Number := 1
else if ParameterBuffer[0,1] = #255 then Number := Ord (ParameterBuffer[0,0]) - 48
else if ParameterBuffer[0,2] = #255 then begin
Number := 10 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (Ord (ParameterBuffer[0,1]) - 48);
end
else begin
Number := 100 * (Ord (ParameterBuffer[0,0]) - 48);
Number := Number + (10 * (Ord (ParameterBuffer[0,1]) - 48));
Number := Number + (Ord (ParameterBuffer[0,2]) - 48);
end;
if Number = 255 then VirtualScreen.Cursor.X := 0 { Cursor at beginning of line }
else if Number > 0 then for I := 1 to Number do begin
if not CursorLeft then CursorLeftCommand := False;
end;
end
else CursorLeftCommand := False;
end;
procedure ANSIHandlerObj.SaveCursorLocation;
begin
SavedCursor.X := VirtualScreen.Cursor.X;
SavedCursor.Y := VirtualScreen.Cursor.Y;
end;
procedure ANSIHandlerObj.RestoreCursorLocation;
begin
VirtualScreen.Cursor.X := SavedCursor.X;
VirtualScreen.Cursor.Y := SavedCursor.Y;
end;
function ANSIHandlerObj.ProcessCommand ( Command : Char ) : Boolean;
begin
ProcessCommand := True;
case Command of
'm' : begin
if not Attribute then
ProcessCommand := False;
end;
'H','f' : begin
if not PositionCursor(Command) then
ProcessCommand := False;
end;
'J' : begin
if not ClearCommand then
ProcessCommand := False;
end;
'K' : begin
if not EraseFromCursorToEndOfLine then
ProcessCommand := False;
end;
'A' : begin
if not CursorUpCommand then
ProcessCommand := False;
end;
'B' : begin
if not CursorDownCommand then
ProcessCommand := False;
end;
'C' : begin
if not CursorRightCommand then
ProcessCommand := False;
end;
'D' : begin
if not CursorLeftCommand then
ProcessCommand := False;
end;
's' : SaveCursorLocation;
'u' : RestoreCursorLocation;
end;
Escape := False;
EscapeSequence := False;
end;
function ANSIHandlerObj.WriteCh ( Ch : Char ) : Byte;
begin
WriteCh := 0; { No errors }
if LastError = 1 then begin
WriteCh := 1; { Error #1 }
end
else if not VirtualScreen.Initialized then begin
WriteCh := 2; { Error #2 }
end
else case Ch of
#10 : begin { Line feed }
if Escape then begin
if EscapeSequence then begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters);
Inc(VirtualScreen.Cursor.Y);
if VirtualScreen.DirectVideo then begin
while VirtualScreen.Cursor.Y >= ScreenLength do VirtualScreen.ScrollScreenUp;
end
else begin
if VirtualScreen.Cursor.Y >= ScreenLength then begin
VirtualScreen.EndOfBuffer := True;
while VirtualScreen.Cursor.Y >= ScreenLength do Dec(VirtualScreen.Cursor.Y);
end;
end;
WriteCh := 3; { Error #3 }
end
else begin
Escape := False;
VirtualScreen.WriteCh(#27);
Inc(VirtualScreen.Cursor.Y);
if VirtualScreen.DirectVideo then begin
while VirtualScreen.Cursor.Y >= ScreenLength do VirtualScreen.ScrollScreenUp;
end
else begin
if VirtualScreen.Cursor.Y >= ScreenLength then begin
VirtualScreen.EndOfBuffer := True;
while VirtualScreen.Cursor.Y >= ScreenLength do Dec(VirtualScreen.Cursor.Y);
end;
end;
WriteCh := 3; { Error #3 }
end;
end
else begin
Inc(VirtualScreen.Cursor.Y);
if VirtualScreen.DirectVideo then begin
while VirtualScreen.Cursor.Y >= ScreenLength do VirtualScreen.ScrollScreenUp;
end
else begin
if VirtualScreen.Cursor.Y >= ScreenLength then begin
VirtualScreen.EndOfBuffer := True;
while VirtualScreen.Cursor.Y >= ScreenLength do Dec(VirtualScreen.Cursor.Y);
end;
end;
end;
end;
#13 : begin { CR }
if Escape then begin
if EscapeSequence then begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters);
VirtualScreen.Cursor.X := 0;
WriteCh := 3; { Error #3 }
end
else begin
Escape := False;
VirtualScreen.WriteCh(#27);
VirtualScreen.Cursor.X := 0;
WriteCh := 3; { Error #3 }
end;
end
else VirtualScreen.Cursor.X := 0;
end;
#27 : begin { Esc }
if Escape then begin
if EscapeSequence then begin
Escape := True;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters);
WriteCh := 3; { Error #3 }
end
else VirtualScreen.WriteCh(#27);
end
else Escape := True;
end;
#91 : begin { [ }
if Escape then begin
if EscapeSequence then begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
WriteCh := 3; { Error #3 }
end
else begin
EscapeSequence := True;
ClearParameterBuffer;
end;
end
else VirtualScreen.WriteCh(Ch);
end;
'0'..'9' : begin
if Escape then begin
if EscapeSequence then begin
if ParameterColumn <= 2 then begin
ParameterBuffer[ParameterRow,ParameterColumn] := Ch;
Inc (ParameterColumn);
end
else begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
WriteCh := 5; { Error #5 }
end;
end
else begin
Escape := False;
VirtualScreen.WriteStr(#27 + Ch);
WriteCh := 3; { Error #3 }
end;
end
else VirtualScreen.WriteCh(Ch);
end;
';' : begin
if Escape then begin
if EscapeSequence then begin
if LastCharacter in ['0'..'9'] then begin
Inc(ParameterRow);
if ParameterRow > ParameterBufferLength - 1 then begin
ParameterRow := ParameterBufferLength - 1;
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters + ';');
WriteCh := 4; { Error #4 }
end
else ParameterColumn := 0;
end
else begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters + ';');
WriteCh := 3; { Error #3 }
end;
end
else begin
Escape := False;
VirtualScreen.WriteStr(#27 + ';');
WriteCh := 3; { Error #3 }
end;
end
else VirtualScreen.WriteCh(';');
end;
'm','H','f','J','K','A','B','C','D','s','u' : begin
if Escape then begin
if EscapeSequence then begin
if LastCharacter = ';' then begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters + ';' + Ch);
WriteCh := 3; { Error #3 }
end
else begin
if not ProcessCommand(Ch) then begin
VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
WriteCh := 6; { Error #6 }
end;
end;
end
else begin
Escape := False;
VirtualScreen.WriteStr(#27 + Ch);
end;
end
else VirtualScreen.WriteCh(Ch);
end;
else begin
if Escape then begin
if EscapeSequence then begin
Escape := False;
EscapeSequence := False;
VirtualScreen.WriteStr(#27#91 + ReturnParameters + Ch);
WriteCh := 3; { Error #3 }
end
else begin
Escape := False;
VirtualScreen.WriteStr(#27 + Ch);
WriteCh := 3; { Error #3 }
end;
end
else VirtualScreen.WriteCh(Ch);
end;
end;
LastCharacter := Ch;
end;
procedure ANSIHandlerObj.WriteStr ( Str : string );
var
I : Byte;
begin
for I := 1 to Length(Str) do ANSIHandler.WriteCh(Str[I]);
end;
function ANSIHandlerObj.SetClearScreen : string;
{ This function returns the ANSI string for clearing the screen
(written for saving an image in ANSI characters) }
begin
SetClearScreen := '[2J';
end;
function ANSIHandlerObj.SetAttribute ( FromAttribute : Integer; ToAttribute : Byte ) : string;
{ This function returns the ANSI string for setting the attribute
(written for saving an image in ANSI characters) }
const
Colors : array [0..7] of Char = ('0', '4', '2', '6', '1', '5', '3', '7');
var
Str : string;
WasBlink, WasInten : Boolean;
WasBG, WasFG : Byte;
NowBlink, NowInten : Boolean;
NowBG, NowFG : Byte;
Param : Boolean;
begin
Param := False;
Str := '';
if FromAttribute <> -1 then begin
if FromAttribute > 127 then WasBlink := True
else WasBlink := False;
if FromAttribute mod 16 > 7 then begin
WasInten := True;
WasFG := FromAttribute mod 16 - 8;
end
else begin
WasInten := False;
WasFG := FromAttribute mod 16;
end;
WasBG := FromAttribute div 16;
end
else begin
Str := #27#91#48; { '[0' }
Param := True;
WasBlink := False;
WasInten := False;
WasBG := 0;
WasFG := 7;
end;
if ToAttribute > 127 then NowBlink := True
else NowBlink := False;
if ToAttribute mod 16 > 7 then begin
NowInten := True;
NowFG := ToAttribute mod 16 - 8;
end
else begin
NowInten := False;
NowFG := ToAttribute mod 16;
end;
NowBG := ToAttribute div 16;
if ((WasBlink) and (not NowBlink)) or ((WasInten) and (not NowInten)) then begin
Str := #27#91#48; { '[0' }
Param := True;
WasBlink := False;
WasInten := False;
WasBG := 0;
WasFG := 7;
end;
if NowBlink then
if not WasBlink then begin
if Param then Str := Str + ';5'
else begin
Str := #27#91 + '5';
Param := True;
end;
end;
if NowInten then
if not WasInten then begin
if Param then Str := Str + ';1'
else begin
Str := #27#91 + '1';
Param := True;
end;
end;
if NowBG <> WasBG then begin
if Param then Str := Str + ';4' + Colors[NowBG]
else begin
Str := #27#91 + '4' + Colors[NowBG];
Param := True;
end;
end;
if NowFG <> WasFG then begin
if Param then Str := Str + ';3' + Colors[NowFG]
else begin
Str := #27#91 + '3' + Colors[NowFG];
Param := True;
end;
end;
if Param then Str := Str + #109; { Str + 'm' }
SetAttribute := Str;
end;
function NumStr ( N : Byte ) : string;
{ Used for following routines ONLY }
const
NM : array [0..2] of Byte = (1,10,100);
var
I, Num, Digits : Byte;
Str : string;
begin
Str := '';
Digits := 0;
Num := N;
for I := 2 downto 0 do
if (Num div NM[I] > 0) or (Digits > 0) then begin
Str := Str + Chr(Num div NM[I] + 48);
Num := Num mod NM[I];
Inc(Digits);
end;
NumStr := Str;
end;
function ANSIHandlerObj.SetCursorPosition ( X, Y : Byte ) : string;
{ This function returns the ANSI string for setting the cursor position
(written for saving an image in ANSI characters) }
var
Str : string;
begin
if (X = 0) and (Y = 0) then Str := '[H'
else Str := '[' + NumStr(Y + 1) + ';' + NumStr(X + 1) + 'H';
SetCursorPosition := Str;
end;
function ANSIHandlerObj.SetCursorUp ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor up
(written for saving an image in ANSI characters) }
var
Ch : string;
begin
Ch := NumStr(Num);
if Ch = #48 then Ch := '';
SetCursorUp := '[' + Ch + 'A';
end;
function ANSIHandlerObj.SetCursorDown ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor down
(written for saving an image in ANSI characters) }
var
Ch : string;
begin
Ch := NumStr(Num);
if Ch = #48 then Ch := '';
SetCursorDown := '[' + Ch + 'B';
end;
function ANSIHandlerObj.SetCursorLeft ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor left
(written for saving an image in ANSI characters) }
var
Ch : string;
begin
Ch := NumStr(Num);
if Ch = #48 then Ch := '';
SetCursorLeft := '[' + Ch + 'D';
end;
function ANSIHandlerObj.SetCursorRight ( Num : Byte ) : string;
{ This function returns the ANSI string for moving the cursor right
(written for saving an image in ANSI characters) }
var
Ch : string;
begin
Ch := NumStr(Num);
if Ch = #48 then Ch := '';
SetCursorRight := '[' + Ch + 'C';
end;
function ANSIHandlerObj.SetSaveCursorPosition : string;
{ This function returns the ANSI string for saving the cursor position
(written for saving an image in ANSI characters) }
begin
SetSaveCursorPosition := '[s';
end;
function ANSIHandlerObj.SetRestoreCursorPosition : string;
{ This function returns the ANSI string for restoring the cursor position
(written for saving an image in ANSI characters) }
begin
SetRestoreCursorPosition := '[u';
end;
begin
VirtualScreen.Initialized := False;
ANSIHandler.LastError := 1;
ScreenWidth := 0;
ScreenLength := 0;
ScreenSize := 0;
end.
[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]