Unit fkscr;

Interface

Uses Crt, GO32, Dos, Ports;

Procedure TextColor(c : Byte);
Procedure TextBackground(c : Byte);
Procedure WriteLn(s : string);
Procedure Write(s : string);
Procedure GotoXY(x, y : Integer);
Procedure ClrEol;
Procedure ClrScr;
Procedure VRet;
Procedure CopyScreen;
Procedure CursorShow;
Procedure CursorHide;
Procedure BlinkOn;
Procedure BlinkOff;

Var WhereX, WhereY : Integer;
    fakescr        : Array[1..50, 1..80] Of Word;
    curattr        : Byte;
    CRTSel         : Word;
    tempcursor     : Word;

Implementation

Procedure Write(s : string);
Var i : Integer;
Begin
  For i := 1 To Length(s) Do Begin
    Case s[i] Of
      #32..#255: Begin
                   fakescr[WhereY, WhereX] := (curattr Shl 8) Or Ord(s[i]);
                   WhereX := WhereX + 1;
                   If (WhereX = 81) Then Begin
                     WhereY := WhereY + 1; WhereX := 1;
                   End;
                 End;
      #13: WhereY := WhereY + 1;
      #10: WhereX := 1;
    End;
  End;
End;

Procedure WriteLn(s : String);
Begin
  Write(s+#13#10);
End;

Procedure GotoXY(x, y : Integer);
Begin
  WhereX := x; WhereY := y;
End;

Procedure TextColor(c : Byte);
Begin
  curattr := (curattr And $F0) Or c;
End;

Procedure TextBackground(c : Byte);
Begin
  curattr := (curattr And $0F) Or (c Shl 4);
End;

Procedure CopyScreen;
Begin
  Seg_Move(get_ds,ofs(fakescr),CRTSel,0,8000);
End;

Procedure ClrEol;
Var i : Integer;
Begin
  For i := WhereX To 80 Do fakescr[WhereY, i] := (curattr Shl 8) Or 32;
End;

Procedure ClrScr;
Begin
  FillWord(fakescr, 4000, (curattr Shl 8) Or 32);
End;

Function GetCursor : Word;
Var
  Reg : Registers;
Begin
  With Reg Do Begin
    AH := 3; BH := 0;
    Intr($10, Reg);
    GetCursor := CX;
  End;
End;

Procedure SetCursor(NewCursor : Word);
Var
  Reg : Registers;
Begin
  With Reg Do Begin
    AH := 1;
    BH := 0;
    CX := NewCursor;
    Intr($10, Reg);
  End;
End;

Procedure CursorShow;
Begin
  SetCursor(TempCursor);
End;

Procedure CursorHide;
Begin
  TempCursor := GetCursor;
  SetCursor($2000);
End;

Procedure SetBlinkState(State : BOOLEAN);
VAR
  ModeReg     : BYTE;
  ModeRegPort : WORD;
Begin
   Asm CLI End;
   ModeRegPort:=MEMW[$0040:$0063]+4;
   ModeReg:=MEM[$0040:$0065];
   If State Then
     ModeReg:=ModeReg OR $20
   Else
     ModeReg:=ModeReg AND $DF;

   Port[ModeRegPort] := ModeReg;
   Mem[$0040:$0065] := ModeReg;
   Asm STI End;
End;

Function EGA : BOOLEAN;
VAR
  Regs : Registers;
Begin
  Regs.AH:=$12;
  Regs.BX:=$FF10;
  INTR( $10, Regs );
  EGA := (Regs.BX AND $FEFC=0)
End;

Procedure SetEGABlinkState(State : BOOLEAN);
VAR
  Regs: Registers;
Begin
  Regs.AX := $1003;
  Regs.BL := ORD(State);
  INTR( $10, Regs )
End;

Procedure BlinkOn;
Begin
  If EGA Then
    SetEGABlinkState(TRUE)
  Else
    SetBlinkState(TRUE)
End;

Procedure BlinkOff;
Begin
  If EGA Then
    SetEGABlinkState(FALSE)
  Else
    SetBlinkState(FALSE)
End;

Procedure VRet; assembler;
asm
    mov dx,$3da
@1: in al,dx
    test al,8
    jnz @1
@2: in al,dx
    test al,8
    jz @2
end;

Begin
  curattr := 7;
  WhereX := CRT.WhereX;
  WhereY := CRT.WhereY;
  CRTSel := Segment_To_Descriptor($B800);
  Crt.TextMode(C80+Font8x8);
  BlinkOff;
End.
