unit NewCrt; {$A+,B-,D-,F-,I-,N-,R-,S-,V-}

interface

uses
  Dos;

const
  TextAttr : Byte = 7;
  maxX     : Byte = 80;
  maxY     : Byte = 25;

type
  TChar2 = Array[1..2] of Char;
  TChar3 = Array[1..3] of Char;
  TChar4 = Array[1..4] of Char;
  TChar5 = Array[1..5] of Char;
  TChar6 = Array[1..6] of Char;
  PString80 = ^TString80;
  TString4  = String[4];
  TString80 = String[80];

var
  AktVModus : Byte;
  VioSeg, i : Word;
  Monocrom  : Boolean;

function KeyPressed : Boolean;
function ReadKey : Char;
function AltTaste(ch : Char) : Char;
procedure Exec(s1, s2 : TString80);
procedure Delay(Z : Word);
procedure MoveW(q, z : Pointer; l : Word);
procedure Color(col : Char);
procedure TextMode(Mode : Byte);
procedure ClrScr(x1, y1, x2, y2 : Word);
procedure HinterGrund(col : TChar2; KZeichen, MZeichen : Char);
procedure GotoCursor(x, y : Byte);
procedure Rahmen(x1, y1, x2, y2, Art : Byte; Schatten : Boolean);
procedure Zeichen(x, y : Word; Zei : Char);
procedure ZeichenKette(x, y, l : Word; Zei : Char);
procedure OutTextXY(x, y : Word; s : String);
procedure Bildspeichern(x1, y1, x2, y2 : Byte);
procedure Bildholen;
procedure Blinken(b : Boolean);
procedure ScrollUp(x1, y1, x2, y2, anz : Byte);

function Hex(Dez : Word) : TString4;

implementation

type
  BildArray = Array[0..$FFFE] of Byte;

var
  BildPtr          : Array[0..20] of ^BildArray;
  BildNr           : Byte;

{ --- Funktion f�r Tastatur --- }

function KeyPressed : Boolean; assembler;
asm
        push    ds              { DS auf Stack sichern }
        mov     ds, Seg0040
        mov     si, 1ah         { Tastaturbufferanfang in SI laden  (1Ah) }
        lodsb
        mov     bl, al          { Anfangspos von AL in BL }
        inc     si              { Tastaturbufferende in SI laden    (1Ch) }
        lodsb
        mov     bh, al          { Endepos von AL in BH }
        xor     ax, ax          { AX auf False }
        cmp     bl, bh          { Positionen vergleichen }
        jz      @Ende           { wenn <> Zeichen in Tastaturbuffer }
        Inc     ax              { AX auf True }
@Ende:  pop     ds              { DS von Stack holen }
end;

Const
  Merker : Byte = 0;

function ReadKey : Char;
var
  _ah, _al : Byte;
begin
  if Merker = 0 then begin
    asm
      mov ah, 00
      int 16h
      mov _al, al
      mov _ah, ah
    end;
    if _al = 0 then begin
      ReadKey := #0;
      Merker := _ah;
    end else ReadKey := chr(_al);
  end else begin
    ReadKey := chr(Merker);
    Merker := 0;
  end;
end;

function AltTaste;
begin
  case UpCase(ch) of
    'Q' : AltTaste := #16;
    'W' : AltTaste := #17;
    'E' : AltTaste := #18;
    'R' : AltTaste := #19;
    'T' : AltTaste := #20;
    'Y' : AltTaste := #21;
    'U' : AltTaste := #22;
    'I' : AltTaste := #23;
    'O' : AltTaste := #24;
    'P' : AltTaste := #25;
    'A' : AltTaste := #30;
    'S' : AltTaste := #31;
    'D' : AltTaste := #32;
    'F' : AltTaste := #33;
    'G' : AltTaste := #34;
    'H' : AltTaste := #35;
    'J' : AltTaste := #36;
    'K' : AltTaste := #37;
    'L' : AltTaste := #38;
    'Z' : AltTaste := #44;
    'X' : AltTaste := #45;
    'C' : AltTaste := #46;
    'V' : AltTaste := #47;
    'B' : AltTaste := #48;
    'N' : AltTaste := #49;
    'M' : AltTaste := #50;
    '1' : AltTaste := #120;
    '2' : AltTaste := #121;
    '3' : AltTaste := #122;
    '4' : AltTaste := #123;
    '5' : AltTaste := #124;
    '6' : AltTaste := #125;
    '7' : AltTaste := #126;
    '8' : AltTaste := #127;
    '9' : AltTaste := #128;
    '0' : AltTaste := #129;
    else AltTaste := #255;
  end;
end;

procedure Exec;
begin
  Dos.Exec(s1, s2);
  TextMode(AktVModus);
  Blinken(False);
end;

procedure Delay;
var
  alt : LongInt;
begin
  alt := MemL[Seg0040:$006C];
  repeat
  until MemL[Seg0040:$006C] >= alt + Z;
end;

{ --- Funktion f�r Bildschirmausgabe --- }

procedure MoveW; assembler;
asm
        push    ds
        lds     si, q
        les     di, z
        mov     cx, l
        rep     movsw           { Quell nach Ziel kopieren }
        pop     ds
end;

procedure Color; assembler;
asm
        mov     bl, col
        mov     TextAttr, bl
end;

procedure TextMode; assembler;
asm
        mov     ah, 00h
        mov     al, Mode
        int     10h
end;

procedure ClrScr; assembler;
asm
        mov     dx, x1          { laenge berechnen }
        sub     x2, dx
        Inc     x2              { x2 f�r l�nge missbrauchen }
        mov     dx, y1          { hoehe berechnen }
        sub     y2, dx
        Inc     y2              { y2 f�r h�he missbrauchen }
        xor     bh, bh          { BH = 0 }
        mov     bl, maxX
        shl     bx, 1           { BX verdoppeln }
        shl     x1, 1           { x1 verdoppeln }
        mov     ax, y1
        xor     dh, dh          { Ofs = y * maxX * 2 + x * 2 }
        mul     bl              { AX mit BL mutiplizieren }
        add     ax, x1          { dazu x1 addieren }
        shr     x1, 1           { x1 halbieren }
        mov     es, VioSeg      { Segment setzen }
        mov     di, ax          { AX in Offset laden }
        mov     ah, TextAttr    { Attribut setzen }
        mov     al, 00          { Zeichen setzen }
        mov     cx, y2          { H�he in Z�hlregister setzen }
        cmp     cx, 60          { Pr�fen ob h�he >= 60 }
        jae     @Ende
        jcxz    @Ende           {    "       h�he = 0  }
@L:     push    cx              { Z�hler f�r Y auf Stack sichern }
        push    di              { Offset auf Stack sichern }
        mov     cx, x2          { L�nge in Z�hlregister setzen }
        Rep     stosw
        pop     di              { Altes Offset laden }
        add     di, bx          { und mit maxX addieren }
        pop     cx
        loop    @L              { wenn CX <> 0 then goto @L }
@Ende:
end;

procedure HinterGrund;
var
  y : Byte;
begin
  Color(col[1]);
  ZeichenKette(0, 0, maxX, KZeichen);
  ZeichenKette(0, maxY - 1, maxX, KZeichen);
  Color(col[2]);
  ZeichenKette(0, 1, maxX * (maxY - 2), MZeichen);
end;

procedure GotoCursor;
begin
  PortW[$3D4] := $0E + ((y * maxX + x) shr 8    )shl 8;
  PortW[$3D4] := $0F + ((y * maxX + x) mod $100) shl 8;
end;

{procedure GotoCursor; assembler;
asm
        mov     ah, 02h
        mov     bh, 00h
        mov     dh, y
        mov     dl, x
        int     10h
end;}

procedure Zeichen; assembler;
asm
        mov     ax, y           { Offset berechnen }
        mul     maxX
        add     ax, x
        mov     di, ax
        shl     di, 1
        mov     es, VioSeg
        mov     ah, TextAttr
        mov     al, Zei
        stosw
end;

procedure ZeichenKette; assembler;
asm
        mov     ax, y           { Offset berechnen }
        mul     maxX
        add     ax, x
        mov     di, ax
        shl     di, 1
        mov     es, VioSeg
        mov     ah, TextAttr
        mov     al, Zei
        mov     cx, l
        cmp     cx, 10000       { Pr�fen ob Anzahlzeichen >= 10000 }
        jae     @Ende           { wenn ja Goto Ende }
        Rep     stosw
@Ende:
end;

procedure OutTextXY; assembler;
asm
        mov     bl, textattr    { Attribut in BL sichern }
        push    ds              { Datensegment auf Stack sichern }
        mov     ax, y           { AX = y }
        mul     maxX            { AX = AX * maxX }
        add     ax, x           { AX = AX + x }
        mov     di, ax          { Offset = AX }
        shl     di, 1           { Offset verdoppeln }
        mov     es, VioSeg      { Segment = VioSeg }
        lds     si, s
        xor     ch, ch
        mov     cl, ds:[si]
        cmp     cl, 0           { if Str[0] = 0 then }
        je      @Ende           { Goto @Ende         }
        inc     si
        mov     ah, bl          { Attribut in ah laden }
@L:     lodsb                   { N�chstes zeichen in al laden }
        stosw                   { AX in Vio-Ram schreiben }
        loop    @L
@Ende:  pop     ds              { Datensegment von Stack holen }
end;


procedure Rahmen;

  procedure Attribut(x, y, l : Word); assembler;  { f�r - Schatten }
  asm
        mov     ax, y           { Offset berechnen }
        mul     maxX
        add     ax, x
        mov     di, ax
        shl     di, 1
        mov     es, VioSeg
        mov     al, 8
        mov     cx, l
  @L:   inc     di
        stosb
        loop    @L
  end;

type
  TZ = Array[1..6] of Char;

var
  z    : TZ;
  i    : Word;
  x, y : Byte;

const
  RArt : Array[0..3] of TZ = (#0#0#0#0#0#0, '�Ŀ���', '�ͻȺ�', '������');

begin
  z := RArt[Art];
  Zeichen(x1, y1, z[1]);
  ZeichenKette(x1 + 1, y1, x2 - x1 - 1, z[2]);
  Zeichen(x2, y1, z[3]);
  for y := y1 + 1 to y2 - 1 do begin
    Zeichen(x1, y, z[5]);
    Zeichen(x2, y, z[5]);
  end;
  Zeichen(x1, y2, z[4]);
  ZeichenKette(x1 + 1, y2, x2 - x1 - 1, z[2]);
  Zeichen(x2, y2, z[6]);
  if Schatten then begin
    Inc(x2);
    if x2 < maxX - 1 then
      for i := y1 + 1 to y2 + 1 do Attribut(x2, i, 2);
    Attribut(x1 + 2, y2 + 1, x2 - x1 - 2);
  end;
end;

procedure Bildspeichern;
var
  g    : Word;
  y, l : Byte;
begin
  l := (x2 - x1 + 1) shl 1;
  GetMem(BildPtr[BildNr], l * (y2 - y1 + 1) + 4);
  BildPtr[BildNr]^[0] := x1; BildPtr[BildNr]^[1] := y1;
  BildPtr[BildNr]^[2] := x2; BildPtr[BildNr]^[3] := y2;
  g := 4;
  for y := y1 to y2 do begin
    MoveW(Ptr(VioSeg, (maxX * y + x1) shl 1), @BildPtr[BildNr]^[g], l shr 1);
    Inc(g, l);
  end;
  Inc(BildNr);
end;

procedure Bildholen;
var
  ko : record
    x1, y1, x2, y2, y, l : Byte;
  end;
  g : Word;
begin
  Dec(BildNr);
  MoveW(@BildPtr[BildNr]^, @ko, 2);
  with ko do begin
    g := 4; l := x2 - x1 + 1;
    for y := y1 to y2 do begin
      MoveW(@BildPtr[BildNr]^[g], Ptr(VioSeg, (maxX * y + x1) shl 1), l);
      Inc(g, l shl 1);
    end;
  end;
  FreeMem(BildPtr[BildNr], g);
end;

procedure Blinken; assembler;
asm
        mov     ax, 1003h
        mov     bl, b
        int     10h
end;

procedure ScrollUp(x1, y1, x2, y2, anz : Byte);
var
  y : Byte;
begin
  for y := y1 to y2 - anz do begin
    MoveW(Ptr(VioSeg, ((y + anz) * 80 + x1) * 2),
          Ptr(VioSeg, (y * 80 + x1) * 2), x2 - x1 + 1);
  end;
  ZeichenKette(x1, y2, x2 - x1 + 1, #00);
end;


{ - Hauptprogramm - }

function Hex; assembler;  { Gibt ein WORD als Hex-String aus }
asm
        les     di, [bp + 8]
        mov     al, 4
        stosb
        mov     ax, [bp + 6]
        mov     cx, 0404h
@L1:    rol     ax, cl
        mov     bx, ax
        and     al, 0fh
        add     al, 90h
        daa
        adc     al, 40h
        daa
        stosb
        mov     ax, bx
        dec     ch
        jnz     @L1
end;

{ --- Hauptprogramm ------------------------------------------- }

begin
  asm
    int 11h
    mov i, ax
  end;
  if i and 48 = 48 then begin
    Monocrom := True;
    VioSeg := SegB000;
    AktVModus := $07;
  end else begin
    Monocrom := False;
    VioSeg := SegB800;
    AktVModus := $03;
  end;
  TextMode(AktVModus);
  Blinken(False);
end.