[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]
Unit AnsiUnit;
{$Q-}
{$R-}
Interface
Uses Dos, Crt;
Var
Ansi : Text; { Ansi is the name of the device }
Wrap : Boolean; { True if Cursor should wrap }
ReportedX,
ReportedY : Word; { X,Y reported }
{ Hook for handling control chars i.e. Ch < Space }
WriteHook : Procedure(Ch : Char);
{ hook for implementing Your own Device Status Report procedure }
ReplyHook : Procedure(St : String);
{ Hook for handling simultaneous writes to ComPort and Screen }
BBsHook : Procedure (Ch : Char);
Function In_Ansi : Boolean; { True if a sequence is pending }
Procedure WriteChar(Ch : Char);
Procedure AnsiWrite(S: String);
Procedure AssignAnsi(Var f : Text); { use like AssignCrt }
Implementation
Type
States = (Waiting, Bracket, Get_Args, Get_Param, Eat_Semi,
Get_String, In_Param, Get_Music);
Const
St : String = '';
ParamArr : Array[1..10] Of Word = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
Params : Word = 0; { number of parameters }
NextState : States = Waiting; { next state for the parser }
Reverse : Boolean = False; { true if text attributes are
reversed }
Var
Quote : Char;
SavedX, SavedY : Word;
Function In_Ansi : Boolean; { True if a sequence is pending }
Begin
In_Ansi := (NextState <> Waiting) And (NextState <> Bracket);
End {In_Ansi} ;
Function ms(w: word): string;
var s: string;
begin
str(w,s);
Ms := s;
end;
{$F+}
Procedure Report(St : String);
{$F-}
Begin
{StuffString(St);}
End;
{$F+}
Procedure WriteChar(Ch : Char);
{$F-}
Begin
Case Ch Of
#7 :
Begin
NoSound;
Sound(500);
Delay(50);
NoSound;
Delay(50);
End;
#8 : If (WhereX > 1) Then Write(#8' '#8);
#9 : If (WhereX < 71) Then
Repeat
GotoXy(WhereX + 1, Wherey);
Until (WhereX Mod 8 = 1);
Else
Write(Ch);
End {Case} ;
End {WriteChar} ;
{$F+}
Procedure Dummy(St : String);
{$F-}
Begin
End;
Procedure AnsiWrite(S: String);
Var
i : Word;
j : Byte;
Ch : Char;
Label Command, Ending;
Begin
for j := 1 to length(S) do
begin
Ch := s[j];
If Ch = #27 Then
Begin
NextState := Bracket;
Goto Ending;
End;
Case NextState Of
Waiting : If (Ch > ' ') Then Write(Ch)
Else WriteHook(Ch);
Bracket :
Begin
If Ch <> '[' Then
Begin
NextState := Waiting;
If (Ch > ' ') Then Write(Ch)
Else WriteHook(Ch);
Goto Ending;
End;
St := '';
Params := 1;
FillChar(ParamArr, 10, 0);
NextState := Get_Args;
End;
Get_Args, Get_Param, Eat_Semi :
Begin
{$IFNDEF Music}
If (NextState = Get_Args) And ((Ch = '=') Or (Ch = '?')) Then
Begin
NextState := Get_Param;
Goto Ending;
End;
{$ELSE}
If (NextState = Get_Args) Then
Case Ch Of
'=', '?' :
Begin
NextState := Get_Param;
Goto Ending;
End;
'M' :
Begin
NextState := Get_Music;
Goto Ending;
End;
End {Case} ;
{$ENDIF}
If (NextState = Eat_Semi) And (Ch = ';') Then
Begin
If Params < 10 Then Inc(Params);
NextState := Get_Param;
Exit;
End;
Case Ch Of
'0'..'9' :
Begin
ParamArr[Params] := Ord(Ch) - Ord('0');
NextState := In_Param;
End;
';' :
Begin
If Params < 10 Then Inc(Params);
NextState := Get_Param;
End;
'"', '''' :
Begin
Quote := Ch;
St := St + Ch;
NextState := Get_String;
End;
Else
GoTo Command;
End {Case Ch} ;
End;
Get_String :
Begin
St := St + Ch;
If Ch <> Quote
Then NextState := Get_String
Else NextState := Eat_Semi;
End;
In_Param : { last char was a digit }
Begin
{ looking for more digits, a semicolon, or a command char }
Case Ch Of
'0'..'9' :
Begin
ParamArr[Params] := ParamArr[Params] * 10 + Ord(Ch) -
Ord('0'); NextState := In_Param;
Goto Ending;
End;
';' :
Begin
If Params < 10 Then Inc(Params);
NextState := Eat_Semi;
Goto Ending;
End;
End {Case Ch} ;
Command:
NextState := Waiting;
Case Ch Of
{ Note: the order of commands is optimized for execution speed }
'm' : {sgr}
Begin
For i := 1 To Params Do
Begin
If Reverse Then TextAttr := TextAttr Shr 4 + TextAttr Shl
4; Case ParamArr[i] Of
0 :
Begin
Reverse := False;
TextAttr := 7;
End;
1 : TextAttr := TextAttr And $FF Or $08;
2 : TextAttr := TextAttr And $F7 Or $00;
4 : TextAttr := TextAttr And $F8 Or $01;
5 : TextAttr := TextAttr Or $80;
7 : If Not Reverse Then
Begin
{
TextAttr := TextAttr shr 4 + TextAttr shl 4;
}
Reverse := True;
End;
22 : TextAttr := TextAttr And $F7 Or $00;
24 : TextAttr := TextAttr And $F8 Or $04;
25 : TextAttr := TextAttr And $7F Or $00;
27 : If Reverse Then
Begin
Reverse := False;
{
TextAttr := TextAttr shr 4 + TextAttr shl 4;
}
End;
30 : TextAttr := TextAttr And $F8 Or $00;
31 : TextAttr := TextAttr And $F8 Or $04;
32 : TextAttr := TextAttr And $F8 Or $02;
33 : TextAttr := TextAttr And $F8 Or $06;
34 : TextAttr := TextAttr And $F8 Or $01;
35 : TextAttr := TextAttr And $F8 Or $05;
36 : TextAttr := TextAttr And $F8 Or $03;
37 : TextAttr := TextAttr And $F8 Or $07;
40 : TextAttr := TextAttr And $8F Or $00;
41 : TextAttr := TextAttr And $8F Or $40;
42 : TextAttr := TextAttr And $8F Or $20;
43 : TextAttr := TextAttr And $8F Or $60;
44 : TextAttr := TextAttr And $8F Or $10;
45 : TextAttr := TextAttr And $8F Or $50;
46 : TextAttr := TextAttr And $8F Or $30;
47 : TextAttr := TextAttr And $8F Or $70;
End {Case} ;
{ fixup for reverse }
If Reverse Then TextAttr := TextAttr Shr 4 + TextAttr Shl
4; End;
End;
'A' : {cuu}
Begin
If ParamArr[1] = 0 Then ParamArr[1] := 1;
If (Wherey - ParamArr[1] >= 1)
Then GotoXy(WhereX, Wherey - ParamArr[1])
Else GotoXy(WhereX, Hi(WindMax));
End;
'B' : {cud}
Begin
If ParamArr[1] = 0 Then ParamArr[1] := 1;
If (Wherey + ParamArr[1] <= Hi(WindMax))
Then GotoXy(WhereX, Wherey + ParamArr[1])
Else GotoXy(WhereX, 1);
End;
'C' : {cuf}
Begin
If ParamArr[1] = 0 Then ParamArr[1] := 1;
If WhereX + ParamArr[1] <= Lo(WindMax)
Then GotoXy(WhereX + ParamArr[1], Wherey)
Else GotoXy(Lo(WindMax), Wherey);
End;
'D' : {cub}
Begin
If ParamArr[1] = 0 Then ParamArr[1] := 1;
If (WhereX - ParamArr[1] >= 1)
Then GotoXy(WhereX - ParamArr[1], Wherey)
Else GotoXy(1, Wherey);
End;
'H', 'f' : {cup,hvp}
Begin
If ParamArr[1] = 0 Then ParamArr[1] := 1;
If ParamArr[2] = 0 Then ParamArr[2] := 1;
GotoXy(ParamArr[2], ParamArr[1]);
End;
'J' : {EID}
Case ParamArr[1] Of
2 : ClrScr;
(*
0 : {ClrEos}
Begin
ClrEol;
ScrollWindowDown(Lo(WindMin) + 1, Hi(WindMin) + Wherey +
1, Lo(WindMax) + 1, Hi(WindMax) + 1, 0);
End;
1 : {Clear from beginning of screen}
Begin
ScrollWindowDown(Lo(WindMin) + 1, Hi(WindMin) + Wherey,
Lo(WindMin) + WhereX,
Hi(WindMin) + Wherey, 0);
ScrollWindowDown(Lo(WindMin) + 1, Hi(WindMin) + 1,
Lo(WindMax) + 1, Hi(WindMin) + Wherey -
1, 0); End;
*)
End {Case} ;
'K' : {eil}
Case ParamArr[1] Of
0 : ClrEol;
(*
1 : { clear from beginning of line to cursor }
ScrollWindowDown(Lo(WindMin) + 1, Hi(WindMin) + Wherey,
Lo(WindMin) + WhereX - 1,
Hi(WindMin) + Wherey, 0);
2 : { clear entire line }
ScrollWindowDown(Lo(WindMin) + 1, Hi(WindMin) + Wherey,
Lo(WindMax) + 1,
Hi(WindMin) + Wherey, 0);
*)
End {Case ParamArr} ;
'L' : {il } For i := 1 To ParamArr[1] Do InsLine; { must not
move cursor } 'M' : {d_l} For i := 1 To ParamArr[1] Do DelLine; {
must not move cursor } 'P' : {dc }
Begin
End;
'R' : {cpr}
Begin
ReportedY := ParamArr[1];
ReportedX := ParamArr[2];
End;
'@' : {ic}
Begin
{ insert blank chars }
End;
'h', 'l' : {sm/rm}
Case ParamArr[1] Of
0 : TextMode(BW40);
1 : TextMode(CO40);
2 : TextMode(BW80);
3 : TextMode(CO80);
4 : {GraphMode(320x200 col)} ;
5 : {GraphMode(320x200 BW)} ;
6 : {GraphMode(640x200 BW)} ;
7 : Wrap := Ch = 'h';
End {case} ;
'n' : {dsr}
If (ParamArr[1] = 6) Then
ReplyHook(#27'[' + ms(Wherey) + ';' +
ms(WhereX) + 'R');
's' : {scp}
Begin
SavedX := WhereX;
SavedY := Wherey;
End;
'u' : {rcp} GotoXy(SavedX, SavedY);
Else
Begin
If (Ch > ' ') Then Write(Ch)
Else WriteHook(Ch);
Goto Ending;
End;
End {Case Ch} ;
End;
{$IFDEF Music}
Get_Music :
Begin
If Ch <> #3 {Ctrl-C}
Then St := St + Ch
Else
Begin
NextState := Waiting;
End;
End;
{$ENDIF}
End {Case NextState} ;
Ending:
End;
End {AnsiWrite} ;
{$IFNDEF Small}
{$F+} { All Driver function must be far }
Function Nothing(Var f : TextRec) : Integer;
Begin
Nothing := 0;
End {Nothing} ;
Procedure Null(Ch : Char);
Begin
{}
End {Null} ;
Function DevOutput(Var f : TextRec) : Integer;
Var
i : Integer;
Begin
With f Do
Begin
{ f.BufPos contains the number of chars in the buffer }
{ f.BufPtr^ is your buffer }
{ Any variable conversion done by writeln is already }
{ done by now. }
i := 0;
While i < BufPos Do
Begin
AnsiWrite(BufPtr^[i]);
{$IFDEF BBS}
BBSHook(BufPtr^[i]);
{$ENDIF}
Inc(i);
End;
BufPos := 0;
End;
DevOutput := 0; { return IOResult Error codes here }
End {DevOutput} ;
Function DevOpen(Var f : TextRec) : Integer;
Begin
With f Do
Begin
If Mode = FmInput Then
Begin
InOutFunc := @Nothing;
FlushFunc := @Nothing;
End
Else
Begin
Mode := FmOutput; { in case it was FmInOut }
InOutFunc := @DevOutput;
FlushFunc := @DevOutput;
End;
CloseFunc := @Nothing;
End;
DevOpen := 0; { return IOResult error codes here }
End {DevOpen} ;
Procedure AssignAnsi(Var f : Text);
Begin
FillChar(f, SizeOf(f), #0); { init file var }
With TextRec(f) Do
Begin
Handle := $ffff;
Mode := FmClosed;
BufSize := SizeOf(Buffer);
BufPtr := @Buffer;
OpenFunc := @DevOpen;
Name[0] := #0;
End;
End {AssignAnsi} ;
{$ENDIF}
Begin
AssignAnsi(Ansi); { set up the variable }
Rewrite(Ansi); { open it for output }
Wrap := True;
ReplyHook := Report;
WriteHook := WriteChar;
End.
[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]