{ Grabbed from the net... thanks, anonymous programmer. - Ro' }

UNIT NewCrt;

INTERFACE

var
  lastmode: word;            { text mode of CRT }
  textattr: byte;            { text and background colour }
  windmin, windmax: word;    { window position }


Procedure clreol;
Procedure clrscr;
Procedure GotoXY(x, y: byte);
Function KeyPressed: boolean;
Function ReadKey: char;
Procedure TextBackground(bgcolor: byte);
Procedure TextColor(color: byte);
Procedure TextMode(mode: integer);
Function WhereX: byte;
Function WhereY: byte;

Procedure Write_Line(line: string; field_size: byte);
Procedure Write_Num(num: longint; field_size: byte);
Procedure Write_Real(num: real; field_size, decimal: byte);

Procedure Window(x1, y1, x2, y2: byte);



IMPLEMENTATION

Procedure clreol; assembler;
ASM
  PUSH ES
  mov AX, 0B800h
  mov ES, AX
  mov AX, 0300h  { get cursor position }
  xor BX, BX
  int 10h        { cursor X = DL  Y = DH }
  xor AX, AX
  mov AL, DH     { AX = Y }
  xor BX, BX     { clear BX }
  xor CX, CX
  mov CL, DL     { CX = X }
  mov BL, 160    { bytes per line }
  MUL BL         { AX = Y * bytes per line }
  add AX, CX     { AX = Y offset + ( 2 * X) }
  add AX, CX

  mov DI, AX     { ES:DI points to cursor }
  mov AL, 32
  mov AH, textattr

  mov DX, windmax
  xor DH, DH          { ignoure Y }
  @clreol_start:
    CMP CX, DX
    JG @clreol_done
    STOSW
    inc CX
    JMP @clreol_start

  @clreol_done:
  POP ES
END;


Procedure clrscr; assembler;
ASM
   mov AH, 06h
   mov AL, 0
   mov BH, textattr
   mov CX, windmin
   dec CH
   dec CL
   mov DX, windmax
   dec DH
   dec DL
   int 10h

   mov AX, 0200h
   xor BX, BX
   mov DX, windmin
   dec DL
   dec DH
   int 10h
END;




Procedure GotoXY(x, y: byte); assembler;
ASM
  mov CX, windmin
  mov AH, 02
  xor AL, AL
  xor BX, BX    { display page 0 }
  mov DL, x
  dec DL        { convert Pascal to ASM }
  add DL, CL    { add min window value }
  dec DL

  mov DH, y
  dec DH        { convert Pascal to ASM }
  add DH, CH    { add min window position }
  dec DH
  int 10h
END;



Function KeyPressed: boolean; assembler;
ASM
  mov AX, 0B00h
  int 21h
END;


Function ReadKey: char; assembler;
ASM
  mov AX, 0800h
  int 21h
END;



Procedure TextBackground(bgcolor: byte); assembler;
ASM
  mov AL, textattr
  mov BL, bgcolor
  shl BL, 1
  shl BL, 1
  shl BL, 1
  shl BL, 1

  AND AL, 0Fh
  OR AL, BL
  mov textattr, AL
END;



Procedure TextColor(color: byte); assembler;
ASM
  mov AL, textattr
  mov BL, color
  AND AL, 0F0h
  OR AL, BL
  mov textattr, AL
END;




Procedure TextMode(mode: integer); assembler;
ASM
  xor AX, AX
  mov windmin, AX
  mov AX, 1950h
  mov windmax, AX
  mov AL, 7
  mov textattr, AL


  mov AH, 06h
  mov AL, 0
  mov BH, textattr
  mov CX, windmin
  mov DX, windmax
  int 10h

  mov AX, 0200h
  xor BX, BX
  mov DX, windmin
  int 10h
END;





Function WhereX: byte; assembler;
ASM
  mov AX, 0300h  { get cursor position }
  xor BX, BX     { display page 0 }
  int 10h        { X position in DL }
  mov AL, DL
  mov CX, windmin
  sub AL, CL
  inc AL
END;


Function WhereY: byte; assembler;
ASM
  mov AX, 0300h  { get cursor position }
  xor BX, BX     { display page }
  int 10h        { Y position returned in DH }
  mov AL, DH
  mov CX, windmin
  sub AL, CH
  inc AL
  inc AL
END;



Procedure Scroll_Up; assembler;
ASM
  mov AX, windmax
  mov BX, windmin
  sub AH, BH         { number of lins to scroll in AH }

  mov AL, AH
  mov AH, 6
  mov AH, textattr
  mov CX, windmin
  dec CH
  dec CL
  mov DX, windmax
  dec DH
  dec DL
  int 10h


END;




Procedure Print_Char(letter: char); assembler;
ASM
  mov AH, 0Eh
  mov AL, letter;
  xor BX, BX
  mov BL, textattr
  int 10h
END;



Procedure Write_Line(line: string; field_size: byte);
var
  len: byte;
  count: byte;
  x, y: byte;
begin
  if field_size <> 0 then
    begin
      len := length(line);
      while len < field_size do
        begin
          line := ' ' + line;
          inc(len);
        end;
    end;
  len := length(line);
  for count := 1 to len do
    begin
      print_char(line[count]);
      x := whereX;
      y := whereY;
      if x > ( LO(windmax) - LO(windmin) ) then
        begin
          x := 1;
          inc(y);
          if y > ( HI(windmax) - HI(windmin) )then
            begin
              scroll_up;
              dec(y);
            end;
          gotoxy(x, y);
        end;
    end;

END;




Procedure Write_Num(num: longint; field_size: byte);
var
  line: string;

begin
  str(num, line);
  Write_Line(line, field_size);
End;




Procedure Write_Real(num: real; field_size, decimal: byte);
var
  line: string;
begin
  str(num: field_size: decimal, line);
  Write_Line(line, field_size + decimal);
END;




Procedure Window(x1, y1, x2, y2: byte); assembler;
ASM
  mov AH, y1
  mov AL, x1
  mov windmin, AX

  mov AH, y2
  mov AL, x2
  mov windmax, AX
END;



Begin
  textattr := 7;
  windmin := 0;
  windmax := $1950;
  lastmode := 3;
End.