{$G+,X+,B-,V-,F-,O+,A+,P-}
{$UNDEF RPlus}

{$D+}
Unit SVGA;

Interface

{$IFNDEF DOSLYHYT}
Uses Crt;
{$ENDIF}

Const
  PCXAdd: Word = 0;
Type
  PutMethods = (ANDPut, XORPut, ORPut, BackPut, MOVPut, UndoPut);
  Directions = (Up,Down,Left,Right);

  PPCX=^PCX;
  PCX = Record
    Manufacturer: Byte; {10=ZSoft}
    Version: Byte; {5=What we use, don't care}
    RLE: Boolean; {Packed using RLE?}
    BitsPerPixel: Byte; {1,2,4,8, don't care}
    XMin,YMin,XMax,YMax:Word; {0,0,319,199 for example}
    HDpi,VDpi:Word; {Don't care}
    ColorMap:Array[0..47]Of Byte; {Don't care}
    Reserved:Byte; {Set to zero, don't care}
    NPlanes:Byte; {Number of colour planes}
    BytesPerLine:Word;
    PaletteInfo:Word; {Don't care}
    HScreenSize,VScreenSize:Word; {Screen size in pixels, don't care}
    Filler:Array[0..53]Of Byte; {Set to zero, don't care}
    ThePicture:Array(.0..0.) Of Byte; {The picture}
  End;
  Palette = Array[0..767]Of Byte;

Var
  VirtSeg: Word; { = SegA000}

{$IFDEF JKA}
Const
  ModeX: Boolean = False;
  GraphMode: Boolean = False;
  SEEK_SET = 0;
  SEEK_CUR = 1;
  SEEK_END = 2;
Procedure FillWord(Var Dest; Count: Word; Data: Word);
Procedure HaltError;
Function FSeek(Var f:File; NewPos:LongInt; Method:Word):LongInt;
{$ENDIF}
Const
  BackGroundColor: Byte = 0;
  FlipPic: Boolean = False;
  TextBack: Byte = 0;
  FontLev: Byte = 8;
  TextDir: Directions = Right;
Var
  Font8, Font14, Font16: PChar;
  CursPixX, CursPixY: Word;
  CursX, CursY: Byte;
  TextPatn: LongInt;
  FontKork: Byte;
  XAdd, YAdd: Integer;
  PreviousPage: Word;
  VGAPal: Palette;

  SVGAIncXRes,            {T„ss„ on ruudun fyysinen koko (kuvamuistissa) }
  SVGAIncYRes: Word;
  SCRXMax, SCRYMax: Word; {N„iss„ muuttujissa on ruudun visuaalinen koko.}

  Page64kSize: Byte; {2 jos univbe, 4 ilman}

Procedure WaitRetrace;
InLine($BA/$DA/$03/$EC/$A8/$08/$75/$FB/$EC/$A8/$08/$74/$FB);

Procedure Set256Mode(XRes, YRes: Word);
Procedure PSET(x, y: Integer; c: Byte);
Function Point(x, y: Integer): Byte;
Procedure AddPoint(x1, y1, x2, y2: Integer; Add,Min,Max: Integer);
Procedure Put(x, y: Integer; Var Src; Start, xs, ys: Byte; Method: PutMethods);
Procedure Set256Palette(rinc, ginc, binc: ShortInt);
Procedure SetFractPalette(rinc, ginc, binc: ShortInt);
Procedure MakeUniformPalette(rbits,gbits,bbits, maxbright: Integer);
Procedure PaletteScale(r1,g1,b1, r2,g2,b2, Len: Byte);
Procedure OnePalette(Num, r, g, b: Byte);
Procedure Scroll256Palette(Min, Max: Byte; Dir: Byte);
Procedure Line(x1, y1, x2, y2: Integer; Color: byte);
Procedure LineCheck(x1, y1, x2, y2: Integer; Color: byte);
Procedure IfPoint(x1, y1, x2, y2: Integer; What, New: byte);
Function PixSum(x1, y1, x2, y2: Integer): LongInt;
Procedure HorLine(x1,x2,y:Integer; Color:byte);
Procedure ShowPCX(Addr: PPCX; DetectMode: Boolean);
Procedure Bar(x1,y1,x2,y2: Integer; Color:Byte);
Procedure Rect(x1,y1,x2,y2: Integer; Color:Byte);
{$IFNDEF NOSTDIO}
Function PCXFile(Name: PChar; ClearItFirst,SetItThen,DetectMode: Boolean): Boolean; {ret false=ok}
Procedure GetPaletteFromPCX(s: PChar; Var Dest: Palette);
{$ENDIF}
Procedure ClearPalette;
Procedure SetPalette;
Procedure GetPalette;
Procedure FadeIn;
Procedure FadeOut;
Procedure Cls(Color: Byte);

Procedure LineClip(x1,y1, x2,y2: Integer; Color: byte);
Function ClipLine: Boolean; {True if out of screen}

{---------------------------------------------------------------------------}
{$IFNDEF DOSLYHYT}
{CRT-functions' replacements}
Procedure DefaultPutChar(Ch: Char);
Procedure TextColor(w: Word);
Procedure GotoXYProc(x, y: Integer);
{$IFNDEF NOSTDIO}{$IFNDEF JKA}
Procedure WindowProc(x1,y1,x2,y2: Integer);
Procedure ClrScrProc;
{$ENDIF}{$ENDIF}
Function WhereXFunc: Integer;
Function WhereYFunc: Integer;
Procedure WriteStr(Size:Word; Str: PChar);
{$ENDIF}
{---------------------------------------------------------------------------}
{$IFNDEF DOSLYHYT}
Const
  PutChar: Procedure(Ch: Char) = DefaultPutChar;
{$ENDIF}

Implementation

Function ClipLine; External; {$L DRAWLINE.OBJ}

Var
  d: Word;
  a, b: Byte;

Procedure LitlDelay; Assembler;
Asm
  mov es, Seg0040
  mov ax, es:[6Ch]
@:cmp ax, es:[6Ch]
  je @
End;

Var
  VESA: Array[0..511]Of Char;

Procedure Set256Mode(XRes, YRes: Word);
Label P1;
Begin
  Page64kSize := 4;
  PLongInt(@VESA)^ := $32454256; {'VBE2'}
  Asm
    push ds
    pop es
    mov di, offset VESA
    mov ax, 4F00h
    int 10h
  End;
  If PLongInt(@VESA)^ = $41534556 Then {'VESA'}
    If PWord(PChar(@VESA)+4)^ = $200 Then
      Page64kSize := 4;

  {Some parts of Mode-X routines by Matt Pritchard}
  {$IFNDEF DOSLYHYT}
  {$IFNDEF JKA}ModeX := False;{$ENDIF}
  {$ENDIF}
  {$IFNDEF TweakAll}
  If(XRes=320)And(YRes=200)Then Asm mov ax, 13h; int 10h End
  Else {$ENDIF}
  Begin
    If YRes=201 Then YRes := 200;
    {$IFNDEF DOSLYHYT}
    If XRes = 256 Then
    Begin
      Asm mov ax, 13h; int 10h End;
      Port[$3C2] := $E3;
      PortW[$3D4] := $2C11;
      PortW[$3D4] := $3F01;
      PortW[$3D4] := $4002;
      PortW[$3D4] :=130*256 + 3;
      PortW[$3D4] := 74*256 + 4;
      PortW[$3D4] :=154*256 + 5;
      PortW[$3D4] := 35*256 + 6;
      PortW[$3D4] := $B207;
      PortW[$3D4] := $0008;
      PortW[$3D4] := $E009;

      PortW[$3D4] := $0010;
      PortW[$3D4] := $AC11;
      PortW[$3D4] := $12 + (YRes-17)*256;

      PortW[$3D4] := $2013;
      PortW[$3D4] := $4014;
      PortW[$3D4] := $0115;
      PortW[$3D4] := $0A16;
      PortW[$3D4] := $A317;
      PortW[$3D4] := $0018;

      PortW[$3C4] := $0F02;

      PortW[$3CE] := $0000;
      PortW[$3CE] := $0003;
      PortW[$3CE] := $4005;
      PortW[$3CE] := $0506;
      PortW[$3CE] := $0007;
      PortW[$3CE] := $FF08
    End
    Else If((XRes=320)Or(XRes=360))And((YRes=200)Or(YRes=240)Or(YRes=400)Or(YRes=480))Then
    Begin
      Asm mov ax, 13h; int 10h End;
      PortW[$3C4] := $0604; LitlDelay;{Chain 4 mode off}
      PortW[$3C4] := $0100; LitlDelay;{Async reset}

{     If(XRes=320)And((YRes=200)Or(YRes=400))Then Port[$3C2] := $63;}
      If(XRes=360)And((YRes=200)Or(YRes=400))Then Port[$3C2] := $67;
      If(XRes=320)And((YRes=240)Or(YRes=480))Then Port[$3C2] := $E3;
      If(XRes=360)And((YRes=240)Or(YRes=480))Then Port[$3C2] := $E7;
      LitlDelay;

      PortW[$3C4] := $0300; {Restart sequencer}
      LitlDelay;
      Port[$3D4] := $11;
      Port[$3D5] := Port[$3D5]And $7F; {Mask out write protect}
      LitlDelay;

      If XRes=360 Then
      Begin
        PortW[$3D4] := $6B00;
        PortW[$3D4] := $5901;
        PortW[$3D4] := $5A02;
        PortW[$3D4] := $8E03;
        PortW[$3D4] := $5E04;
        PortW[$3D4] := $8A05;
      End;
      If YRes>=400 Then PortW[$3D4] := $4009;

      If(YRes=240)Or(YRes=480)Then
      Begin
        PortW[$3D4] := $0D06;
        PortW[$3D4] := $3E07;
        PortW[$3D4] := $EA10;
        PortW[$3D4] := $AC11;
        PortW[$3D4] := $DF12;
        PortW[$3D4] := $E715;
        PortW[$3D4] := $0616
      End;

      PortW[$3D4] := $0014; {DWord mode off}
      PortW[$3D4] := $E317; {Byte mode on}

      PortW[$3D4] := $13+(XRes Shr 3)Shl 8;

      {$IFNDEF JKA}ModeX := True{$ENDIF}
    End
    Else{$ENDIF}If(XRes=640)And(YRes=400)Then
    Begin
      Asm mov ax, 4F02h; mov bx, 100h; int 10h End;
    End
    Else If(XRes=640)And(YRes=480)Then
      Asm mov ax, 4F02h; mov bx, 101h; int 10h End
    Else If(XRes=640)And(YRes=200)Then
    Begin
      Asm mov ax, 4F02h; mov bx, 100h; int 10h End;
      PortW[$3D4] := $C009
    End
    Else If(XRes=640)And(YRes=240)Then
    Begin
      Asm mov ax, 4F02h; mov bx, 101h; int 10h End;
      PortW[$3D4] := $C009
    End
    Else If(XRes=800)And(YRes=600)Then
      Asm mov ax, 4F02h; mov bx, 103h; int 10h End
    Else If(XRes=800)And(YRes=200)Then
    Begin
      Asm mov ax, 4F02h; mov bx, 103h; int 10h End;
      PortW[$3D4] := $C109
    End
    Else If(XRes=1024)And(YRes=384)Then
    Begin
      Asm mov ax, 4F02h; mov bx, 105h; int 10h End;
      PortW[$3D4] := $C009
    End
    Else If(XRes=1024)And(YRes=256)Then
    Begin
      Asm mov ax, 4F02h; mov bx, 105h; int 10h End;
      PortW[$3D4] := $C109
    End
    Else If(XRes=1024)And(YRes=768)Then
      Asm mov ax, 4F02h; mov bx, 105h; int 10h End
    Else If(XRes=1280)And(YRes=1024)Then
      Asm mov ax, 4F02h; mov bx, 107h; int 10h End
    Else If(XRes=80)And(YRes=50)Then
    Asm
      mov cx,4709h
      jmp P1
    End
    Else If(XRes=80)And(YRes=80)Then
    Asm
      mov cx,4409h
P1:   mov ax,13h; int 10h
      mov dx,03C4h
      mov ax,0604h
      out dx,ax
      mov dx,03D4h
      mov ax,cx
      out dx,ax
      mov ax,0014h
      out dx,ax
      mov ax,0E317h
      out dx,ax
      mov es,VirtSeg
      xor di,di
      xor ax,ax
      mov cx,1600
      rep
      stosw
    End
    {$IFOPT R+}Else RunError(201){$ENDIF}
  End;
  PreviousPage := 0;
  SVGAIncXRes := XRes; CursX := 1; CursPixX := 0;
  SVGAIncYRes := YRes; CursY := 1; CursPixY := 0;
  TextPatn := $FFFFFFFF;

  PortW[$3C4] := $0F02;
  FillWord(Mem[VirtSeg:0],32000,0);
  {$IFNDEF DOSLYHYT}
  GraphMode := True;
  {$ENDIF}

  If SVGAIncYRes<400
    Then FontKork := 8
    Else If SVGAIncYRes<480
      Then FontKork := 14
      Else FontKork := 16;
  {$IFNDEF NOSTDIO}
  {$IFNDEF DOSLYHYT}
  Window(1,1, SVGAIncXRes Div 8,60);
  {$ENDIF}
  {$ENDIF}

  SCRXMax := SVGAIncXRes;
  SCRYMax := SVGAIncYRes;
End;

Procedure PSET; Assembler;
Asm
  mov ax, XAdd; add X, ax
  mov ax, YAdd; add Y, ax
  {$IFOPT R+}
  mov ax, X
  or ax, ax; js @E
  cmp ax, SVGAIncXRes; jge @E
  mov ax, Y
  or ax, ax; js @E
  cmp ax, SVGAIncYRes; jge @E
  {$ENDIF}
  mov es, VirtSeg
@T1:
  {$IFNDEF DOSLYHYT}
  cmp ModeX, True
  je @MODEX
  {$ENDIF}
  cmp SVGAIncXRes, 256
  je @@256
  mov ax, Y
  mul SVGAIncXRes
  add ax, X
  adc dx, 0

  push ax   {8 bits}
   cmp dx, PreviousPage
   je @1
   mov PreviousPage, dx

{  mov ah, dl
   mov cl, Page64kSize
   shl ah, cl
   mov al, 9
   mov dx, 3CEh
   out dx, ax
   }
   mov ax, 4F05h
   mov bx, 0
   int 10h{}
@1:pop di
  mov al, c {8 bits}
  mov es:[di], al
  jmp @F

@@256:
  xor al, al
  mov ah, byte ptr Y
  add ax, X
  push ax
  jmp @1

@E:
  {$IFDEF SVGARESUME}
  jmp @F
  {$ELSE}
  pop ax; {Restore BP}
  mov ax, 201
  jmp HaltError
  {$ENDIF}
{$IFNDEF DOSLYHYT}
@MODEX:
  mov ax, Y
  mov bx, SVGAIncXRes
  shr bx, 2
  mul bx
  mov bx, X
  mov cx, bx
  shr bx, 2
  add bx, ax

  mov ax, 0102h
  and cl, 3
  shl ah, cl
  mov dx, 3C4h
  out dx, ax

  mov al, c
  mov es:[bx], al
{$ENDIF}
@F:
End;

Function Point; Assembler;
Asm
  mov ax, XAdd; add X, ax
  mov ax, YAdd; add Y, ax
  {$IFOPT R+}
  mov ax, X
  or ax, ax; js @E
  cmp ax, SVGAIncXRes; jge @E
  mov ax, Y
  or ax, ax; js @E
  cmp ax, SVGAIncYRes; jge @E
  {$ENDIF}
  mov es, VirtSeg
@T1:{$IFNDEF DOSLYHYT}
  cmp ModeX, True
  je @MODEX
  {$ENDIF}
  mov ax, Y
  mul SVGAIncXRes
  add ax, X
  adc dx, 0
  push ax
   {}cmp dx, PreviousPage
   je @1
   {}mov PreviousPage, dx

   {mov ah, dl
   mov cl, Page64kSize
   shl ah, cl
   mov al, 9
   mov dx, 3CEh
   out dx, ax{}

   mov ax, 4F05h
   mov bx, 0
   int 10h{}
@1:pop bx
  jmp @D
@E:xor ax, ax
  jmp @F
{$IFNDEF DOSLYHYT}
@MODEX:
  mov cx, X
  mov dx, 3CEh
  mov ah, cl
  mov al, 4
  and ah, 3
  out dx, ax
  mov ax, SVGAIncXRes
  shr ax, 2
  mul Y
  shr cx, 2
  add ax, cx
  mov bx, ax
{$ENDIF}
@D:mov al, es:[bx]
@F:
End;

Procedure Put(x, y: Integer; Var Src; Start, xs, ys: Byte; Method: PutMethods);
Var sx, sy, c: Word;
Begin
  If FlipPic Then
    Case Method Of
      MOVPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Start+Mem[Seg(Src):Ofs(Src)+(sy+1)*xs-1-sx]);
      BackPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
          Begin
            c := Mem[Seg(Src):Ofs(Src)+(sy+1)*xs-1-sx];
            If c<>BackGroundColor Then PSet(x+sx, y+sy, c)
          End;
      UndoPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
          Begin
            c := Mem[Seg(Src):Ofs(Src)+(sy+1)*xs-1-sx];
            If c<>BackGroundColor Then PSet(x+sx, y+sy, BackGroundColor)
          End;
      XORPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Point(x+sx,y+sy)Xor Mem[Seg(Src):Ofs(Src)+(sy+1)*xs-1-sx]);
      ANDPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Point(x+sx,y+sy)And Mem[Seg(Src):Ofs(Src)+(sy+1)*xs-1-sx]);
      ORPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Point(x+sx,y+sy)Or Mem[Seg(Src):Ofs(Src)+(sy+1)*xs-1-sx])
    End
  Else
    Case Method Of
      MOVPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Start+Mem[Seg(Src):Ofs(Src)+sy*xs+sx]);
      BackPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
          Begin
            c := Mem[Seg(Src):Ofs(Src)+sy*xs+sx];
            If c<>BackGroundColor Then PSet(x+sx, y+sy, c)
          End;
      UndoPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
          Begin
            c := Mem[Seg(Src):Ofs(Src)+sy*xs+sx];
            If c<>BackGroundColor Then PSet(x+sx, y+sy, BackGroundColor)
          End;
      XORPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Point(x+sx,y+sy)Xor Mem[Seg(Src):Ofs(Src)+sy*xs+sx]);
      ANDPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Point(x+sx,y+sy)And Mem[Seg(Src):Ofs(Src)+sy*xs+sx]);
      ORPut:
        For sx := xs-1 DownTo 0 Do
          For sy := ys-1 DownTo 0 Do
            PSet(x+sx, y+sy, Point(x+sx,y+sy)Or Mem[Seg(Src):Ofs(Src)+sy*xs+sx])
    End
End;

Procedure PaletteScale;
Var a: Byte;
Begin
  For a := 1 To Len Do
  Begin
    Port[$3C9] := (a-1)*(r2-r1)Div Len+r1;
    Port[$3C9] := (a-1)*(g2-g1)Div Len+g1;
    Port[$3C9] := (a-1)*(b2-b1)Div Len+b1
  End
End;

Procedure OnePalette; Assembler;
Asm
  mov dx, 3C8h; mov al, Num; out dx, al
  inc dx
  mov al, r; out dx, al
  mov al, g; out dx, al
  mov al, b; out dx, al
End;

Procedure Set256Palette;
Var r,g,b:ShortInt; a: Byte;
Begin
  r := 0; g := 0; b := 0; Port[$3C8] := 0;
  For a := 0 To 255 Do
  Begin
    If(r+rinc<0)Or(r+rinc>64)Then rinc := -rinc;
    If(g+ginc<0)Or(g+ginc>64)Then ginc := -ginc;
    If(b+binc<0)Or(b+binc>64)Then binc := -binc;
    Inc(r, rinc); Inc(g, ginc); Inc(b, binc);
    If r<64 Then Port[$3C9] := r Else Port[$3C9] := 63;
    If g<64 Then Port[$3C9] := g Else Port[$3C9] := 63;
    If b<64 Then Port[$3C9] := b Else Port[$3C9] := 63
  End
End;

Procedure SetFractPalette;
Var dr,gr,br,r,g,b:ShortInt; a: Byte;
Begin
  r := 0; g := 0; b := 0; Port[$3C8] := 0;
  For a := 0 To 127 Do
  Begin
    If(r+rinc<0)Or(r+rinc>64)Then rinc := -rinc;
    If(g+ginc<0)Or(g+ginc>64)Then ginc := -ginc;
    If(b+binc<0)Or(b+binc>64)Then binc := -binc;
    Inc(r, rinc); Inc(g, ginc); Inc(b, binc);

    If r<64 Then Port[$3C9] := r Else Port[$3C9] := 63;
    If g<64 Then Port[$3C9] := g Else Port[$3C9] := 63;
    If b<64 Then Port[$3C9] := b Else Port[$3C9] := 63;

    dr:=r; gr:=g; br:=b; Inc(r,8);Inc(g,8);Inc(b,8);

    If r<64 Then Port[$3C9] := r Else Port[$3C9] := 63;
    If g<64 Then Port[$3C9] := g Else Port[$3C9] := 63;
    If b<64 Then Port[$3C9] := b Else Port[$3C9] := 63;

    r:=dr; g:=gr; b:=br
  End
End;

Procedure Scroll256Palette;
Var
  a: Word; b: Byte;
Begin
  Port[$3C7] := 0;
  For a := 0 To 767 Do VGAPal[a] := Port[$3C9];
  For a := 0 To Max-Min Do
  Begin
    Port[$3C8] := (a+Dir)Mod(Max-Min+1)+Min;
    Port[$3C9] := VGAPal[(a+Min)*3+0];
    Port[$3C9] := VGAPal[(a+Min)*3+1];
    Port[$3C9] := VGAPal[(a+Min)*3+2]
  End
End;

Procedure MakeUniformPalette(rbits,gbits,bbits, maxbright: Integer);
Var r,g,b: Integer;
Begin
  Port[$3C8] := 0;
  rbits := 1 Shl rbits - 1;
  gbits := 1 Shl gbits - 1;
  bbits := 1 Shl bbits - 1;
  For r := 0 To rbits Do
    For g := 0 To gbits Do
      For b := 0 To bbits Do
      Begin
        Port[$3C9] := r * maxbright Div rbits;
        Port[$3C9] := g * maxbright Div gbits;
        Port[$3C9] := b * maxbright Div bbits
      End
End;

Procedure LineClip(x1,y1, x2,y2: Integer; Color: Byte);
Begin
  Asm
    mov bx, x1
    mov cx, y1
    mov si, x2
    mov di, y2
    call ClipLine
    test ax, ax
    jnz @END
    push bx
    push cx
    push si
    push di
    mov al, Color
    push ax
    call Line
@END:
  End
End;

Procedure Line;
Var i, DeltaX, DeltaY, NumPixels,
  d, dinc1, dinc2,
  x, xinc1, xinc2,
  y, yinc1, yinc2: Integer;
begin
  { Calculate DeltaX and DeltaY for initialisation }
  DeltaX := abs(x2 - x1);
  DeltaY := abs(y2 - y1);

  { Initialize all vars based on which is the independent variable }
  if DeltaX >= DeltaY then
  begin
    { x is independent variable }
    NumPixels := DeltaX + 1;
    d := DeltaY Shl 1 - DeltaX;
    dinc1 := DeltaY Shl 1;
    dinc2 := (DeltaY - DeltaX) shl 1;
    xinc1 := 1; yinc1 := 0;
    xinc2 := 1; yinc2 := 1
  end
  else
  begin
    { y is independent variable }
    NumPixels := DeltaY + 1;
    d := DeltaX Shl 1 - DeltaY;
    dinc1 := DeltaX Shl 1;
    dinc2 := (DeltaX - DeltaY) shl 1;
    xinc1 := 0; yinc1 := 1;
    xinc2 := 1; yinc2 := 1
  end;

  { Make sure x and y move in the right directions }
  If x1 > x2 Then Begin xinc1 := -xinc1; xinc2 := -xinc2 End;
  If y1 > y2 Then Begin yinc1 := -yinc1; yinc2 := -yinc2 End;

  { Start drawing at <x1, y1> }
  x := x1; y := y1;

  { Draw the pixels }
  For i := 1 To NumPixels Do
  Begin
    PSet(x, y, Color);
    If d < 0 Then
    Begin
      Inc(d, dinc1);
      Inc(x, xinc1);
      Inc(y, yinc1)
    End
    Else
    Begin
      Inc(d, dinc2);
      Inc(x, xinc2);
      Inc(y, yinc2)
    End
  End
End;

Procedure LineCheck;
Var i, DeltaX, DeltaY, NumPixels,
  d, dinc1, dinc2,
  x, xinc1, xinc2,
  y, yinc1, yinc2: Integer;
begin
  { Calculate DeltaX and DeltaY for initialisation }
  DeltaX := abs(x2 - x1);
  DeltaY := abs(y2 - y1);

  { Initialize all vars based on which is the independent variable }
  if DeltaX >= DeltaY then
  begin
    { x is independent variable }
    NumPixels := DeltaX + 1;
    d := DeltaY Shl 1 - DeltaX;
    dinc1 := DeltaY Shl 1;
    dinc2 := (DeltaY - DeltaX) shl 1;
    xinc1 := 1; yinc1 := 0;
    xinc2 := 1; yinc2 := 1
  end
  else
  begin
    { y is independent variable }
    NumPixels := DeltaY + 1;
    d := DeltaX Shl 1 - DeltaY;
    dinc1 := DeltaX Shl 1;
    dinc2 := (DeltaX - DeltaY) shl 1;
    xinc1 := 0; yinc1 := 1;
    xinc2 := 1; yinc2 := 1
  end;

  { Make sure x and y move in the right directions }
  If x1 > x2 Then Begin xinc1 := -xinc1; xinc2 := -xinc2 End;
  If y1 > y2 Then Begin yinc1 := -yinc1; yinc2 := -yinc2 End;

  { Start drawing at <x1, y1> }
  x := x1; y := y1;

  { Draw the pixels }
  For i := 1 To NumPixels Do
  Begin
    If(x>=0)And(y>=0)And(x<ScrXMax)And(y<ScrYMax)Then
      PSet(x, y, Color);

    If d < 0 Then
    Begin
      Inc(d, dinc1);
      Inc(x, xinc1);
      Inc(y, yinc1)
    End
    Else
    Begin
      Inc(d, dinc2);
      Inc(x, xinc2);
      Inc(y, yinc2)
    End
  End
End;

Procedure AddPoint;
Var
  i, DeltaX, DeltaY, NumPixels, c,
  d, dinc1, dinc2,
  x, xinc1, xinc2,
  y, yinc1, yinc2: Integer;
begin
  { Calculate DeltaX and DeltaY for initialisation }
  DeltaX := abs(x2 - x1);
  DeltaY := abs(y2 - y1);

  { Initialize all vars based on which is the independent variable }
  if DeltaX >= DeltaY then
  begin
    { x is independent variable }
    NumPixels := DeltaX + 1;
    d := DeltaY Shl 1 - DeltaX;
    dinc1 := DeltaY Shl 1;
    dinc2 := (DeltaY - DeltaX) shl 1;
    xinc1 := 1; yinc1 := 0;
    xinc2 := 1; yinc2 := 1
  end
  else
  begin
    { y is independent variable }
    NumPixels := DeltaY + 1;
    d := DeltaX Shl 1 - DeltaY;
    dinc1 := DeltaX Shl 1;
    dinc2 := (DeltaX - DeltaY) shl 1;
    xinc1 := 0; yinc1 := 1;
    xinc2 := 1; yinc2 := 1
  end;

  { Make sure x and y move in the right directions }
  If x1 > x2 Then Begin xinc1 := -xinc1; xinc2 := -xinc2 End;
  If y1 > y2 Then Begin yinc1 := -yinc1; yinc2 := -yinc2 End;

  { Start drawing at <x1, y1> }
  x := x1; y := y1;

  { Draw the pixels }
  For i := 1 To NumPixels Do
  Begin
    c := Point(x,y) + Add;
    If c < Min Then c := Min;
    If c > Max Then c := Max;
    PSet(x, y, c);
    If d < 0 Then
    Begin
      Inc(d, dinc1);
      Inc(x, xinc1);
      Inc(y, yinc1)
    End
    Else
    Begin
      Inc(d, dinc2);
      Inc(x, xinc2);
      Inc(y, yinc2)
    End
  End
End;

Procedure IfPoint;
Var i, DeltaX, DeltaY, NumPixels,
  d, dinc1, dinc2,
  x, xinc1, xinc2,
  y, yinc1, yinc2: Integer;
begin
  { Calculate DeltaX and DeltaY for initialisation }
  DeltaX := abs(x2 - x1);
  DeltaY := abs(y2 - y1);

  { Initialize all vars based on which is the independent variable }
  if DeltaX >= DeltaY then
  begin
    { x is independent variable }
    NumPixels := DeltaX + 1;
    d := DeltaY Shl 1 - DeltaX;
    dinc1 := DeltaY Shl 1;
    dinc2 := (DeltaY - DeltaX) shl 1;
    xinc1 := 1; yinc1 := 0;
    xinc2 := 1; yinc2 := 1
  end
  else
  begin
    { y is independent variable }
    NumPixels := DeltaY + 1;
    d := DeltaX Shl 1 - DeltaY;
    dinc1 := DeltaX Shl 1;
    dinc2 := (DeltaX - DeltaY) shl 1;
    xinc1 := 0; yinc1 := 1;
    xinc2 := 1; yinc2 := 1
  end;

  { Make sure x and y move in the right directions }
  If x1 > x2 Then Begin xinc1 := -xinc1; xinc2 := -xinc2 End;
  If y1 > y2 Then Begin yinc1 := -yinc1; yinc2 := -yinc2 End;

  { Start drawing at <x1, y1> }
  x := x1; y := y1;

  { Draw the pixels }
  For i := 1 To NumPixels Do
  Begin
    If Point(x,y)=What Then PSet(x,y, New);
    If d < 0 Then
    Begin
      Inc(d, dinc1);
      Inc(x, xinc1);
      Inc(y, yinc1)
    End
    Else
    Begin
      Inc(d, dinc2);
      Inc(x, xinc2);
      Inc(y, yinc2)
    End
  End
End;

Function PixSum;
Var i, DeltaX, DeltaY, NumPixels,
  d, dinc1, dinc2,
  x, xinc1, xinc2,
  y, yinc1, yinc2: Integer;
  l: LongInt;
begin
  l := 0;
  { Calculate DeltaX and DeltaY for initialisation }
  DeltaX := Abs(x2 - x1);
  DeltaY := Abs(y2 - y1);

  { Initialize all vars based on which is the independent variable }
  If DeltaX >= DeltaY Then
  Begin
    { x is independent variable }
    NumPixels := DeltaX + 1;
    d := DeltaY Shl 1 - DeltaX;
    dinc1 := DeltaY Shl 1;
    dinc2 := (DeltaY - DeltaX) shl 1;
    xinc1 := 1; yinc1 := 0;
    xinc2 := 1; yinc2 := 1
  End
  Else
  Begin
    { y is independent variable }
    NumPixels := DeltaY + 1;
    d := DeltaX Shl 1 - DeltaY;
    dinc1 := DeltaX Shl 1;
    dinc2 := (DeltaX - DeltaY) shl 1;
    xinc1 := 0; yinc1 := 1;
    xinc2 := 1; yinc2 := 1
  End;

  { Make sure x and y move in the right directions }
  If x1 > x2 Then Begin xinc1 := -xinc1; xinc2 := -xinc2 End;
  If y1 > y2 Then Begin yinc1 := -yinc1; yinc2 := -yinc2 End;

  { Start drawing at <x1, y1> }
  x := x1; y := y1;

  { Draw the pixels }
  For i := 1 To NumPixels Do
  Begin
    Inc(l, Point(x, y));
    If d < 0 Then
    Begin
      Inc(d, dinc1);
      Inc(x, xinc1);
      Inc(y, yinc1)
    End
    Else
    Begin
      Inc(d, dinc2);
      Inc(x, xinc2);
      Inc(y, yinc2)
    End
  End;
  PixSum := l
End;

Procedure Cls;
Var i: Byte; x,y: Word;
Begin
  x := XAdd;
  y := YAdd;
  XAdd := 0;
  YAdd := 0;
  If(SVGAIncXRes=320)And(SVGAIncYRes=200){$IFNDEF DOSLYHYT}And Not ModeX{$ENDIF}Then
    FillWord(Mem[VirtSeg:0], 32000, Color+(Color Shl 8))
  {Else If SVGAIncYRes=640 Then
  Begin
  End}
  Else
    For d := 0 To SVGAIncYRes-1 Do
      HorLine(0, SVGAIncXRes-1, d, Color);
  XAdd := x;
  YAdd := y
End;

Procedure HorLine; Assembler;
Asm
{$IFNDEF DOSLYHYT}
        cmp Modex, True
        je @ModeX
{$ENDIF}
        mov cx, x1
@:      push cx
         push cx
          push y
           mov al, Color
           push ax
         call PSet
        pop cx
        inc cx
        cmp cx, x2
        jle @
{$IFNDEF DOSLYHYT}
        jmp @Oho
@ModeX:
        mov ax, XAdd; add X1, ax; add X2, ax
        mov ax, YAdd; add Y, ax
        {$IFOPT R+}
        mov ax, x1
        or ax, ax; js @E
        cmp ax, SVGAIncXRes; jnl @E
        mov ax, x2
        or ax, ax; js @E
        cmp ax, SVGAIncXRes; jnl @E
        mov ax, y
        or ax, ax; js @E
        cmp ax, SVGAIncYRes; jl @F
@E:     pop ax
        mov ax, 201
        jmp HaltError
@F:     {$ENDIF}
        mov es,VirtSeg
        cld
        mov ax,SVGAIncXRes
        shr ax,2
        mul y
        mov di,ax             { base of scan line }
        mov bx,x1
        mov dx,x2
        cmp bx,dx
        jb @Skip
        xchg bx,dx
@Skip:  mov cl,bl
        shr bx,2
        mov ch,dl
        shr dx,2
        and cx,0303h
        sub dx,bx             { width in Bytes }
        add di,bx             { offset into video buffer }
        mov ax,0FF02h
        shl ah,cl
        and ah,0Fh            { left edge mask }
        mov cl,ch
        mov bh,0F1h
        rol bh,cl
        and bh,0Fh            { right edge mask }
        mov cx,dx
        or cx,cx
        jnz @Left
        and ah,bh             { combine left & right bitmasks }
@Left:  mov dx,3C4h
        out dx,ax
        inc dx
        mov al,Color
        stosb
        jcxz @Oho
        dec cx
        jcxz @Right
        mov al,0Fh
        out dx,al             { skipped if cx=0,1 }
        mov al,Color
        repe stosb            { fill middle Bytes }
@Right: mov al,bh
        out dx,al             { skipped if cx=0 }
        mov al,Color
        stosb
@Oho:
{$ENDIF}
end;

Procedure ClearPalette;
Begin
  Port[$3C8] := 0;
  For d := 0 To 767 Do Port[$3C9] := 0;
End;

Procedure GetPalette;
Begin
  Port[$3C7] := 0;
  Asm
    mov di, offset VGAPal
    push ds
    pop es
    mov dx, 3C9h
    mov cx, 768
    rep insb
  End{;
  For d := 0 To 767 Do VGAPal[d] := Port[$3C9];}
End;

Procedure SetPalette;
Begin
  Port[$3C8] := 0;
  Asm
    mov si, offset VGAPal
    cld
    mov dx, 3C9h
    mov cx, 768
    rep outsb
  End{;
  For d := 0 To 767 Do Port[$3C9] := VGAPal[d]}
End;

Procedure FadeIn;
Begin
  For a := 1 To 64 Do
  Begin
    WaitRetrace;
    Port[$3C8] := 0;
    For d := 0 To 767 Do Port[$3C9] := VGAPal[d]*a Shr 6
  End
End;

Procedure FadeOut;
Begin
  For a := 64 DownTo 1 Do
  Begin
    WaitRetrace;
    Port[$3C8] := 0;
    For d := 0 To 767 Do Port[$3C9] := VGAPal[d]*a Shr 6
  End
End;

{$IFNDEF NOSTDIO}
Procedure GetPaletteFromPCX;
Var f: File; x: Word; c: Byte;
Label P1;
Begin
  Assign(f, s);
  Reset(f, 1);
  BlockRead(f, c, 1);

  If c=Ord('R') {RIX}Then
  Begin
    Seek(f, 10);
    Goto P1;
  End;
  FSeek(f, -769, SEEK_END);

  BlockRead(f, c, 1);
  If c=12 Then
  Begin
P1: BlockRead(f, Dest, 768, x);
    For x := 0 To 767 Do Dest[x] := Dest[x] Shr 2
  End;
  Close(f)
End;
{$ENDIF}

Procedure Bar;
Var y: Integer;
Begin
  For y := y1 To y2 Do HorLine(x1,x2, y, Color)
End;

Procedure Rect;
Var y: Integer;
Begin
  HorLine(x1,x2,y1, Color);
  HorLine(x1,x2,y2, Color);
  For y := y1+1 To y2-1 Do
  Begin
    PSet(x1,y, Color);
    PSet(x2,y, Color)
  End
End;

Procedure DoDetectMode(X, Y: Word);
Begin
  If(X<=256)And(Y<=240)Then Set256Mode(256,Y)
  Else If X<=320 Then
    If Y<=200 Then Set256Mode(320,200)
    Else If Y<=240 Then Set256Mode(320,240)
    Else If Y<=400 Then Set256Mode(320,400)
    Else If Y<=480 Then Set256Mode(360,480)
    Else If Y<=600 Then Set256Mode(800,600)
    Else If Y<=768 Then Set256Mode(1024,768)
    Else Set256Mode(1280,1024)
  Else If X<=360 Then
    If Y<=200 Then Set256Mode(360,200)
    Else If Y<=240 Then Set256Mode(360,240)
    Else If Y<=400 Then Set256Mode(360,400)
    Else If Y<=480 Then Set256Mode(360,480)
    Else If Y<=600 Then Set256Mode(800,600)
    Else If Y<=768 Then Set256Mode(1024,768)
    Else Set256Mode(1280,1024)
  Else If X<=640 Then
    If Y<=400 Then Set256Mode(640,400)
    Else If Y<=480 Then Set256Mode(640,480)
    Else If Y<=600 Then Set256Mode(800,600)
    Else If Y<=768 Then Set256Mode(1024,768)
    Else Set256Mode(1280,1024)
  Else If X<=800 Then
    If Y<=600 Then Set256Mode(800,600)
    Else If Y<=768 Then Set256Mode(1024,768)
    Else Set256Mode(1280,1024)
  Else If X<=1024 Then
    If Y<=768 Then Set256Mode(1024,768)
    Else Set256Mode(1280,1024)
  Else Set256Mode(1280,1024);
End;

Procedure ShowPCX;
Var
  X, Y, Pos: Word;
  c, l, m: Byte;
Label Hih;
Begin
  With Addr^ Do
    If(ManuFacturer=10)And(Version=5)Then
    Begin
      If DetectMode Then DoDetectMode(XMax-XMin, YMax-YMin);

      Port[$3C8] := 0; For X := 0 To 767 Do Port[$3C9] := 0;

      X := 0;
      Y := 0;
      Pos := 0;
      Repeat
        {$IFOPT R+}{$DEFINE RPlus}{$R-}{$ENDIF}
        c := ThePicture[Pos]; Inc(Pos);
        {$IFDEF RPlus}{$UNDEF RPlus}{$R+}{$ENDIF}
        If Not RLE Or(c < $C0)Then m := 1
        Else
        Begin
          m := c - $C0;
          {$IFOPT R+}{$DEFINE RPlus}{$R-}{$ENDIF}
          c := ThePicture[Pos]; Inc(Pos)
          {$IFDEF RPlus}{$UNDEF RPlus}{$R+}{$ENDIF}
        End;
        For l := 1 To m Do
        Begin
          If(x<SVGAIncXRes)And(y<SVGAIncYRes)Then PSet(x, y, c);
          If x<XMax Then Inc(x)
          Else
          Begin
            If y >= YMax Then Goto Hih;
            x := 0;
            Inc(y)
          End
        End
      Until False;
Hih:Inc(Pos);
    Port[$3C8] := 0;
    {$IFOPT R+}{$DEFINE RPlus}{$R-}{$ENDIF}
    For X := 0 To 767 Do Port[$3C9] := ThePicture[Pos+X]Shr 2
    {$IFDEF RPlus}{$UNDEF RPlus}{$R+}{$ENDIF}
  End
End;

{$IFNDEF NOSTDIO}
Function PCXFile;
Var
  f: File;
  X, Y, Pos: Word;
  c, l, m: Byte;
  Hdr: PCX;
Label Hih;
Begin
  PCXFile := True;
  Assign(f, Name);
  Reset(f, 1);
  If IOResult <> 0 Then Exit;
  PCXFile := False;
  BlockRead(f, Hdr, SizeOf(Hdr));
  With Hdr Do
    If(ManuFacturer=Ord('R'))And(Version=Ord('I'))Then {RIX}
    Begin
      If DetectMode Then DoDetectMode(XMin, YMin);
      If ClearItFirst Or SetItThen Then
      Begin
        Close(f);
        GetPaletteFromPCX(Name, VGAPal);
        Port[$3C8] := 0;
        If ClearItFirst Then ClearPalette;
        Reset(f, 1)
      End;
      Seek(f, 768+10);
      For Y := 0 To YMin-1 Do
        For X := 0 To XMin-1 Do
        Begin
          BlockRead(f, c, 1);
          If(x<SVGAIncXRes)And(y<SVGAIncYRes)Then
          Begin
            {If c > 0 Then}
            PSet(PCXAdd+x, y, c)
          End
        End
    End
    Else If(ManuFacturer=10)And(Version=5)Then
    Begin
      If DetectMode Then DoDetectMode(XMax-XMin, YMax-YMin);

      If ClearItFirst Or SetItThen Then
      Begin
        Close(f);
        GetPaletteFromPCX(Name, VGAPal);
        Port[$3C8] := 0;
        If ClearItFirst Then ClearPalette;
        Reset(f, 1)
      End;

      Seek(f, 128);

      X := 0;
      Y := 0;
      Pos := 0;
      Repeat
        BlockRead(f, c, 1);
        If Not RLE Or(c < $C0)Then m := 1
        Else
        Begin
          m := c - $C0;
          BlockRead(f, c, 1);
        End;
        For l := 1 To m Do
        Begin
          If(x<SVGAIncXRes)And(y<SVGAIncYRes)Then
          Begin
            {If c > 0 Then}
            PSet(PCXAdd+x, y, c)
          End;
          If x<XMax Then Inc(x)
          Else
          Begin
            If y >= YMax Then Goto Hih;
            x := 0;
            Inc(y)
          End
        End
      Until False;
Hih:End;
  If SetItThen Then SetPalette;
  Close(f)
End;
{$ENDIF}

{$IFNDEF DOSLYHYT}
Procedure TextColor(w: Word);
Begin
  TextAttr := Lo(w);
  TextBack := Hi(w);
End;

Procedure DefaultPutChar(Ch: Char);
Var x, y: Integer;
Begin
  {$IFOPT R+}{$DEFINE RPlus}{$R-}{$ENDIF}
  Case FontKork Of
    8:For y := 0 To 7 Do
        If Odd(TextPatn Shr y)Then
          For x := 0 To FontLev-1 Do
            PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)Shl 3+y,
              TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
                (Ord(Font8[Word(Ch)Shl 3+y])Shr(7-x*8 Div FontLev)And 1));
    1..7,9:
      For y := 0 To FontKork-1 Do
        If Odd(TextPatn Shr y)Then
          For x := 0 To FontLev-1 Do
            PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)*FontKork+y,
              TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
                (Ord(Font8[Word(Ch)Shl 3+y*8 Div FontKork])Shr(7-x*8 Div FontLev)And 1));

    10..13:For y := 0 To FontKork-1 Do
          If Odd(TextPatn Shr y)Then
            For x := 0 To FontLev-1 Do
              PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)*FontKork+y,
                TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
                  (Ord(Font16[Word(Ch)Shl 4+y*16 Div FontKork])Shr(7-x*8 Div FontLev)And 1));
    14:For y := 0 To 13 Do
        If Odd(TextPatn Shr y)Then
          For x := 0 To FontLev-1 Do
            PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)*14+y,
              TextBack+(TextAttr-TextBack)*
                (Ord(Font14[Word(Ch)*14+y])Shr(7-x*8 Div FontLev)And 1));
    15:For y := 0 To 14 Do
        If Odd(TextPatn Shr y)Then
          For x := 0 To FontLev-1 Do
            PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)*FontKork+y,
              TextBack+(TextAttr-TextBack)*
                (Ord(Font14[Word(Ch)*14+y*14 Div FontKork])Shr(7-x*8 Div FontLev)And 1));
    16:For y := 0 To 15 Do
        If Odd(TextPatn Shr y)Then
          For x := 0 To FontLev-1 Do
            PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)Shl 4+y,
              TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
                (Ord(Font16[Word(Ch)Shl 4+y])Shr(7-x*8 Div FontLev)And 1));
    17..63:
      For y := 0 To FontKork-1 Do
        If Odd(TextPatn Shr y)Then
          For x := 0 To FontLev-1 Do
            PSet(CursPixX+Word(CursX+Lo(WindMin)-1)*FontLev+x, CursPixY+Word(CursY+Hi(WindMin)-1)*FontKork+y,
              TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
                (Ord(Font16[Word(Ch)Shl 4+y*16 Div FontKork])Shr(7-x*8 Div FontLev)And 1));
{    32:For y := 0 To 15 Do
        For x := 0 To FontLev-1 Do
        Begin
          PSet(Word(CursX+Lo(WindMin)-1)*FontLev+x, Word(CursY+Hi(WindMin)-1)*32+y*2,
            TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
              (Ord(Font16[Word(Ch)Shl 4+y])Shr(7-x*8 Div FontLev)And 1));
          PSet(Word(CursX+Lo(WindMin)-1)*FontLev+x, Word(CursY+Hi(WindMin)-1)*32+y*2+1,
            TextBack+Integer(Integer(TextAttr)-Integer(TextBack))*
              (Ord(Font16[Word(Ch)Shl 4+y])Shr(7-x*8 Div FontLev)And 1))
        End;}
  End;
  {$IFDEF RPlus}{$UNDEF RPlus}{$R+}{$ENDIF}
End;

Procedure WriteStr;
Var a: Byte; y: Byte;
Label Feed;
Begin
  {$IFNDEF NOSTDIO}
  {$IFNDEF JKA}
  If(Mem[$40:$49] < $14)And Not GraphMode Then
    CrtOldWrite(Size, Str)
  Else{$ENDIF}{$ENDIF}
  Begin
    While Size>0 Do
    Begin
      Case Str^ Of
        #8: If WhereXFunc>1 Then GotoXYProc(WhereXFunc-1, WhereYFunc);
        #7: Begin
              Port[$61] := Port[$61]Or 3; Delay(100);
              Port[$61] := Port[$61]And $FC
            End;
        #13:
          GotoXYProc(1, WhereYFunc);
        #10:
Feed:     If WhereYFunc > Hi(WindMax) Then
          Begin
            {$IFNDEF NOSTDIO}{$IFNDEF JKA}
            If Not ModeX Then
            Begin
              Asm mov al, TextAttr; push ax End;
              TextAttr := TextBack;
              CrtOldWrite(1, Str);
              Asm pop ax; mov TextAttr, al End
            End
            Else{$ENDIF}{$ENDIF}
            Begin
              For a := 0 To 3 Do
              Begin
                PortW[$3CE] := $0400+a;
                PortW[$3C4] := $0200+(1 Shl a);
                For y := Hi(WindMin) To Hi(WindMax)Do
                  Move(Mem[VirtSeg:Lo(WindMin)*4+1],
                       Mem[VirtSeg:Lo(WindMin)*4], (Lo(WindMax)-Lo(WindMin)+1)*4)
              End;
              PortW[$3C4] := $0F02
            End
          End
          Else GotoXYProc(WhereXFunc, WhereYFunc+1)
      Else
        PutChar(Str^);
        Inc(CursX);
        If CursX > Lo(WindMax)-Lo(WindMin)+1Then
        Begin
          GotoXYProc(1, WhereYFunc);
          Goto Feed
        End
      End;
      Dec(Size);
      Inc(Str)
    End
  End;
End;

Procedure GotoXYProc;
Begin
  CursPixX := 0;
  CursPixY := 0;
  {$IFNDEF NOSTDIO}{$IFNDEF JKA}
  CrtOldGotoXY(x, y);
  {$ENDIF}{$ENDIF}
  CursX := x; CursY := y
End;

Function WhereXFunc;
Begin
  {$IFNDEF NOSTDIO}{$IFNDEF JKA}
  If Not GraphMode
    Then WhereXFunc := CrtOldWhereX
    Else {$ENDIF}{$ENDIF}WhereXFunc := CursX
End;

Function WhereYFunc;
Begin
  {$IFNDEF NOSTDIO}{$IFNDEF JKA}
  If Not GraphMode
    Then WhereYFunc := CrtOldWhereY
    Else {$ENDIF}{$ENDIF}WhereYFunc := CursY
End;
{$ENDIF}

{$IFDEF JKA}
Procedure FillWord(Var Dest; Count: Word; Data: Word); Assembler;
Asm les di, Dest; mov ax, Data; mov cx, Count; cld; rep stosw End;
Procedure HaltError; Var a: Word; Begin Asm mov a, ax End; Halt(a)End;
Function FSeek(Var f:File; NewPos:LongInt; Method:Word):LongInt;
Begin
  If Method=SEEK_SET Then Seek(f, NewPos)
  Else If Method=SEEK_CUR Then Seek(f, FilePos(f)+NewPos)
  Else If Method=SEEK_END Then Seek(f, FileSize(f)+NewPos)
End;
{$ENDIF}

{$IFDEF NOSTDIO}{$DEFINE TEMPTEMP}{$ENDIF}
{$IFDEF JKA}{$DEFINE TEMPTEMP}{$ENDIF}

{$IFNDEF TEMPTEMP}
Procedure ClrScrProc;
Const Space: Char = ' ';
Var x: Word;
Begin
  If GraphMode Then
  Begin
    CursX := 1;
    CursY := 1;

    For x := 1 To (Hi(WindMax)-Hi(WindMin)+1)*(Lo(WindMax)-Lo(WindMin)+1)Do
      WriteStr(1, @Space);
    CursX := 1; CursY := 1
  End
  Else
    CrtOldClrScr
End;

Procedure WindowProc;
Begin
  If GraphMode Then
  Begin
    WindMin := (x1-1)+(y1-1)Shl 8;
    WindMax := (x2-1)+(y2-1)Shl 8;
    CursX := 1; CursY := 1
  End
  Else
    CrtOldWindow(x1,y1,x2,y2)
End;

Begin
  With CRTLocal Do
  Begin
    WriteStrProcAddr := WriteStr;
    GotoXYProcAddr := GotoXYProc;
    WhereXFuncAddr := WhereXFunc;
    WhereYFuncAddr := WhereYFunc;
    ClrScrProcAddr := ClrScrProc;
    WindowProcAddr := WindowProc
  End;
  DirectVideo := False;
{$ELSE}
Begin
{$ENDIF}
  Asm
    push bp
     mov ax, 1130h
     mov bh, 6
     int 10h
     mov Font16.word[0], bp
     mov Font16.word[2], es
     mov ax, 1130h
     mov bh, 2
     int 10h
     mov Font14.word[0], bp
     mov Font14.word[2], es
     mov ax, 1130h
     mov bh, 3
     int 10h
     mov Font8.word[0], bp
     mov Font8.word[2], es
    pop bp
  End;
  VirtSeg := SegA000
End.