Unit xCrt;
{ расширение Crt для поддержания графических режимов }

INTERFACE

const

{ CRT modes }

  BW40          = 0;            { 40x25 B/W on Color Adapter }
  CO40          = 1;            { 40x25 Color on Color Adapter }
  BW80          = 2;            { 80x25 B/W on Color Adapter }
  CO80          = 3;            { 80x25 Color on Color Adapter }
  Mono          = 7;            { 80x25 on Monochrome Adapter }
  Font8x8       = 256;          { Add-in for ROM font }

{ Mode constants for 3.0 compatibility }

  C40           = CO40;
  C80           = CO80;

{ Foreground and background color constants }

  Black         = 0;
  Blue          = 1;
  Green         = 2;
  Cyan          = 3;
  Red           = 4;
  Magenta       = 5;
  Brown         = 6;
  LightGray     = 7;

{ Foreground color constants }

  DarkGray      = 8;
  LightBlue     = 9;
  LightGreen    = 10;
  LightCyan     = 11;
  LightRed      = 12;
  LightMagenta  = 13;
  Yellow        = 14;
  White         = 15;

{ Add-in for blinking }

  Blink         = 128;

type
  TWindow=record
    X,Y:Byte;
  end;

var
{ Interface variables }

  CheckBreak: Boolean;    { Enable Ctrl-Break }
  CheckEOF: Boolean;      { Enable Ctrl-Z }
  DirectVideo: Boolean;   { Enable direct video addressing }
  CheckSnow: Boolean;     { Enable snow filtering }
  LastMode: Word;         { Current text mode }
  TextAttr: Byte;         { Current text attribute }
  WindMin: TWindow;          { Window upper left coordinates }
  WindMax: TWindow;          { Window lower right coordinates }

{ Interface procedures }

procedure AssignCrt(var F: Text);
function KeyPressed: Boolean;
function ReadKey: Char;
procedure TextMode(Mode: Integer);
procedure Window(X1,Y1,X2,Y2: Byte);
procedure GotoXY(X,Y: Byte);
function WhereX: Byte;
function WhereY: Byte;
procedure ClrScr;
procedure ClrEol;
procedure InsLine;
procedure DelLine;
procedure TextColor(Color: Byte);
procedure TextBackground(Color: Byte);
procedure LowVideo;
procedure HighVideo;
procedure NormVideo;
procedure Delay(MS: Word);
procedure Sound(Hz: Word);
procedure NoSound;

function PresentVideoModeIsGraphics:boolean; { Разрушающая изображение функция }


IMPLEMENTATION
  Uses VideoBios, BiosData, Dos {$IfDef DPMI}, SE {$EndIf Def DPMI};



type
  TCrtFlag=(fGraphMode);
  TCrtFlags=set of TCrtFlag;

const
  asciiBell	=$07;
  asciiBs	=$08;
  asciiTab	=$09;
  asciiLf	=$0A;
  asciiCr	=$0D;
  asciiEof	=$1A;
  asciiEsc	=$1B;
  asciiDel	=$7F;


var
  DelayCnt:{word} array[0..2] of word; {patch for Run error 200 at PII 300}
  CurCrtSize:TWindow;
  NormAttr:byte;
  ScanCode:byte;
  BreakFlag:byte;

  GraphNormAttr:byte; { Аттрибуты для графического режима }
  GraphTextAttr:byte;

  CrtFlags:TCrtFlags; { флаги графического режима }

const
  DOSint=$21;
  DPMI=$31;
  dosSetInt=$25;

function PresentVideoModeIsGraphics:boolean;
begin
  PresentVideoModeIsGraphics:=(fGraphMode in CrtFlags)
end;

procedure SetupTexAttributeForGraphModes; near; assembler;
{ Устанавливает правильные атрибуты текста для графических режимов }
asm
  MOV	AL,TextAttr
  MOV	AH,NormAttr
  test CrtFlags,(1 shl fGraphMode); jz @TextMode
{  cmp IsAlphaMode,True; je @TextMode}
    shr al,4
    shr ah,4
  @TextMode:
  MOV	GraphTextAttr,al
  MOV	GraphNormAttr,ah
end;


procedure Video; near; forward;

procedure CrtInit; near; assembler;
asm
{; Initialize CRT
; In	AL = Requested mode
;	AH = Requested font
}

  push ax { Сохранение AX }
  and CrtFlags,not(1 shl fGraphMode);
  {push ax; call  IsTextVideoMode} { Проверка пределение типа видеорежима }
  call  IsPresentVideoModeText
  or al,al; jnz @TextMode
   or CrtFlags,(1 shl fGraphMode);
  @TextMode:
{  mov IsAlphaMode,al}
  pop ax { Восстановление AX }

  MOV	ES,Seg0040
{  AND	ES:CrtInfo,0FEH}
  AND	ES:DataOfBios([0]).VideoEgaVgaControl,0FEH { что-то с курсором делают}
{  CMP	AL,7 Проверка текстовых видеорежимов отключена
  JE	@@1
  CMP	AL,4
  JB	@@1
  MOV	AL,3
@@1:}

  PUSH	AX
  MOV	AH,0
  CALL	Video
  POP	AX
  OR	AH,AH
  JE	@@2
  MOV	AX,1112H { INT 10 1112 - VIDEO - Realtek RTVGA - SET ROM 8x8 DOUBLE-DOT CHARACTERS
		 Copied from Ralf Brown's Interrupt List}
  MOV	BL,0
  CALL	Video
  MOV	AX,1130H { INT 10 1130 - VIDEO - GET FONT INFORMATION (EGA, MCGA, VGA)
		 Copied from Ralf Brown's Interrupt List}
  MOV	BH,0     { BH = pointer specifier: 00h INT 1Fh pointer
		 Copied from Ralf Brown's Interrupt List}
  MOV	DL,0
  CALL	Video
  CMP	DL,42    { DL    = highest character row on screen
		 Copied from Ralf Brown's Interrupt List}
  JNE	@@2
{  OR	ES:CrtInfo,1}
  OR	ES:DataOfBios([0]).VideoEgaVgaControl,1 { что-то с курсором делают}
  MOV	AX,100H { INT 10 01-- - VIDEO - SET TEXT-MODE CURSOR SHAPE
		Copied from Ralf Brown's Interrupt List}
  MOV	CX,600H { CH = cursor start and options
		  CL = bottom scan line containing cursor (bits 0-4)
		Copied from Ralf Brown's Interrupt List}
  CALL	Video
  MOV	AH,12H { INT 10 12-- - VIDEO - ALTERNATE FUNCTION SELECT (PS,EGA,VGA,MCGA) - ALTERNATE PRTSC
	       Copied from Ralf Brown's Interrupt List}
  MOV	BL,20H
  CALL	Video
@@2:
end;

procedure CrtSetup; near; assembler;
{; Setup CRT variables according to selected mode}
asm
  MOV	AH,0FH { INT 10 0F-- - VIDEO - GET CURRENT VIDEO MODE
	       Return: AH = number of character columns
		AL = display mode
		BH = active page
		Copied from Ralf Brown's Interrupt List}
  CALL	Video
  PUSH	AX
  MOV	AX,1130H { INT 10 1130 - VIDEO - GET FONT INFORMATION (EGA, MCGA, VGA)}
  MOV	BH,0   {BH = pointer specifier: 00h INT 1Fh pointer}
  MOV	DL,0   {Return: ES:BP = specified pointer
			CX    = bytes/character of on-screen font (not the requested font!)
			DL    = highest character row on screen
		Copied from Ralf Brown's Interrupt List }
  CALL	Video
  POP	AX
  MOV	CL,0
  OR	DL,DL
  JNE	@@1
  MOV	DL,24
  CMP	AL,3
  JA	@@1
  MOV	CL,1
@@1:
  MOV	DH,DL
  MOV	DL,AH
  DEC	DL
  MOV	AH,0
  CMP	DH,24
  JBE	@@2
  MOV	AH,1
@@2:
  MOV	LastMode,AX
  MOV	CurCrtSize,DX
  MOV	CheckSnow,CL

  MOV	DirectVideo,0
  test CrtFlags,(1 shl fGraphMode); jnz @GraphMode
    MOV	DirectVideo,1
  @GraphMode:
{  mov al,IsAlphaMode }   { изменено для поддержки графических режимов}
{  MOV	DirectVideo,al} { изменено для поддержки графических режимов}
{  MOV	DirectVideo,1}

  XOR	AX,AX
  MOV	WindMin,AX
  MOV	WindMax,DX
end;

procedure DelayLoop; near; assembler;
{; Delay one timer tick or by iterations}
asm
  @Loop:
    SUB	AX,1; SBB DX,0;
    sbb cx,0; {patch for Run error 200 at PII 300}
    JC @Exit
    CMP	BL,ES:[DI]
  JE @Loop
@Exit:
end;

procedure CtrlBreak; assembler;
{; Ctrl-Break interrupt handler}
asm
{$IfDef DPMI}
  CMP	ES:CheckBreak,0
  JE	@@1
  MOV	ES:BreakFlag,1
@@1:
  CLD
  LODSW
  MOV	ES:RealModeCallbackRegisters([DI]).realIP,AX
  LODSW
  MOV	ES:RealModeCallbackRegisters([DI]).realCS,AX
  LODSW
  MOV	ES:RealModeCallbackRegisters([DI]).realFlags,AX
  ADD	ES:RealModeCallbackRegisters([DI]).realSP,6
{$ELSE}
  PUSH	AX
  PUSH	DS
  MOV	AX,SEG DATA
  MOV	DS,AX
  CMP	CheckBreak,0
  JE	@@1
  MOV	BreakFlag,1
@@1:
  POP	DS
  POP	AX
{$ENDIF}
IRET
end;

procedure Initialize; near; assembler;
asm
  and CrtFlags,not (1 shl fGraphMode) { инициализация флага текстового режима }
{  mov IsAlphaMode,True}

  MOV	AH,0FH
  CALL	Video
  CMP	AL,7
  JE	@@1
  CMP	AL,3
  JBE	@@1
{  MOV	AX,3  - установка только текстовых выдеорежимов отключена }
  xor ah,ah
  CALL	CrtInit
@@1:
  CALL	CrtSetup
  MOV	AH,8
  XOR	BH,BH
  CALL	Video
  MOV	AL,AH
  AND	AL,7FH

  or al,al; jnz @OkColorPresent
    mov al,7
  @OkColorPresent:

  MOV	NormAttr,AL
  MOV	TextAttr,AL
  call	SetupTexAttributeForGraphModes

  XOR	AX,AX
  MOV	CheckEOF,AL
  MOV	ScanCode,AL
  MOV	BreakFlag,AL

  INC	AX
  MOV	CheckBreak,AL

  MOV	ES,Seg0040
  MOV	DI,OFFSET DataOfBios([0]).TimerTicksSinceMidnight
  MOV	AX,-28
  CWD
  mov 	cx,dx
  MOV	BL,ES:[DI]
  @loop:
    CMP	BL,ES:[DI]
  JE	@loop
  MOV	BL,ES:[DI]
{  MOV	AX,-28
  CWD}
  CALL	DelayLoop
  NOT	AX
  NOT	DX
  not	cx    {patch for Run error 200 at PII 300}
{  MOV	CX,55}
{  DIV	CX}

  {patch for Run error 200 at PII 300}
  mov	di,OFFSET word(DelayCnt)[4]
  mov	bx,ds; mov es,bx
  mov	bx,55
  std
  mov	si,dx
  xchg	ax,cx
  xor	dx,dx
  div	bx
  stosw

  mov	ax,si
  div	bx
  stosw

  mov	ax,cx
  div	bx
  stosw
  cld
  {- patch for Run error 200 at PII 300}

{$IfDef DPMI}
  MOV	AX,dpmiGetRMCB
  MOV	SI,OFFSET CtrlBreak
  MOV	DI,OFFSET RealModeRegs
  PUSH	DS
  POP	ES
  PUSH	CS
  POP	DS
  INT	DPMI
  PUSH	ES
  POP	DS
  MOV	AX,dpmiSetRealInt
  MOV	BL,1BH
  INT	DPMI
{$ELSE}
  PUSH	DS
  PUSH	CS
  POP	DS
  MOV	DX,OFFSET CtrlBreak
  MOV	AX,dosSetInt*256+1BH
  INT	DOSint
  POP	DS
{$ENDIF}
end;

type
  PtrRec= record
    ofs,seg:word;
  end;

procedure CrtOpen(var F: Text); far; forward;

procedure AssignCrt(var F: Text); assembler;
{; Assign CRT to textfile}
asm
  PUSH	DS
  LDS	DI,F
  MOV	TextRec([DI]).Mode,fmClosed
  MOV	TextRec([DI]).BufSize,128
  LEA	AX,TextRec([DI]).Buffer
  MOV	PtrRec(TextRec([DI]).BufPtr).&ofs,AX
  MOV	PtrRec(TextRec([DI]).BufPtr).&seg,DS
  MOV	PtrRec(TextRec([DI]).OpenFunc).&ofs,OFFSET CrtOpen
  MOV	PtrRec(TextRec([DI]).OpenFunc).&seg,CS
  MOV	byte(TextRec([DI]).Name),0
  POP	DS
end;


procedure CrtRead(var F: Text); far; forward;
procedure CrtReturn{(var F: Text)}; far; forward;
procedure CrtWrite(var F: Text);  far; forward;
procedure WriteChar; near; forward;
procedure WriteCrLf; near; forward;

procedure CrtOpen(var F: Text); assembler;
{; CRT file open procedure}
asm
{  MOV	BX,SP}
  PUSH	DS
{  LDS	DI,SS:[BX+4]}
  LDS	DI,F
  MOV	AX,OFFSET CrtRead
  MOV	BX,OFFSET CrtReturn
  MOV	CX,BX
  CMP	TextRec([DI]).Mode,fmInput
  JE	@@1
  MOV	TextRec([DI]).Mode,fmOutput
  MOV	AX,OFFSET CrtWrite
  MOV	BX,AX
@@1:
  MOV	PtrRec(TextRec([DI]).InOutFunc).&ofs,AX
  MOV	PtrRec(TextRec([DI]).InOutFunc).&seg,CS
  MOV	PtrRec(TextRec([DI]).FlushFunc).&ofs,BX
  MOV	PtrRec(TextRec([DI]).FlushFunc).&seg,CS
  MOV	PtrRec(TextRec([DI]).CloseFunc).&ofs,CX
  MOV	PtrRec(TextRec([DI]).CloseFunc).&seg,CS
  XOR	AX,AX
  POP	DS
end;

procedure CrtRead(var F: Text); assembler;
{; CRT file read procedure}
asm
{  LES	DI,FileP}
  LES	DI,F
  MOV	DX,ES:TextRec([DI]).BufSize
  DEC	DX
  DEC	DX
  MOV	SI,ES:TextRec([DI]).BufPos
  LES	DI,ES:TextRec([DI]).BufPtr
  XOR	BX,BX
@@1:
  MOV	ScanCode,0
  PUSH	CS
  CALL	ReadKey
  MOV	CX,1
  CMP	AL,asciiBs
  JE	@@2
  CMP	AL,'S'-64
  JE	@@2
  CMP	AL,'D'-64
  JE	@@3
  DEC	CX
  CMP	AL,asciiEsc
  JE	@@2
  CMP	AL,'A'-64
  JE	@@2
  CMP	AL,'F'-64
  JE	@@3
  CMP	AL,asciiEof
  JE	@@4
  CMP	AL,asciiCr
  JE	@@5
  CMP	AL,' '
  JB	@@1
  CMP	BX,DX
  JE	@@1
  MOV	ES:[DI+BX],AL
  INC	BX
  CALL	WriteChar
  CMP	BX,SI
  JBE	@@1
  MOV	SI,BX
  JMP	@@1
@@2:
    OR		BX,BX
  JE	@@1
    MOV		AL,asciiBs
    CALL	WriteChar
    MOV		AL,' '
    CALL	WriteChar
    MOV		AL,asciiBs
    CALL	WriteChar
    DEC		BX
  LOOP	@@2
  JMP	@@1
@@3:
  CMP	BX,SI
  JE	@@1
  MOV	AL,ES:[DI+BX]
  CMP	AL,' '
  JB	@@1
  CALL	WriteChar
  INC	BX
  LOOP	@@3
  JMP	@@1
@@4:
  CMP	CheckEOF,0
  JE	@@1
  MOV	ES:[DI+BX],AL
  INC	BX
  JMP	@@6
@@5:
  CALL	WriteCrLf
  MOV	WORD PTR ES:[DI+BX],asciiCr+asciiLf*256
  INC	BX
  INC	BX
@@6:
  LES	DI,F
  XOR	AX,AX
  MOV	ES:TextRec([DI]).BufPos,AX
  MOV	ES:TextRec([DI]).BufEnd,BX
end;

procedure WriteString; near; forward;
procedure BreakCheck; near; forward;

procedure CrtWrite(var F: Text); assembler;
{; CRT file write procedure}
asm
{	MOV	BX,SP
	LES	DI,SS:[BX+4]}
  LES	DI,F
  MOV	CX,ES:TextRec([DI]).BufPos
  SUB	ES:TextRec([DI]).BufPos,CX
  JCXZ	@@3
  LES	DI,ES:TextRec([DI]).BufPtr
  CMP	DirectVideo,0
  JNE	@@2
  {}
@@1:
  MOV	AL,ES:[DI]
  CALL	WriteChar
  INC	DI
  LOOP	@@1
  JMP	@@3
@@2:
  CALL	WriteString
@@3:
  CALL	BreakCheck
  XOR	AX,AX
{	RETF	4}
end;

procedure LineFeed; near; forward;

procedure DirectWrite; near; assembler;
{; Do pending direct write string
; In	BX    = Cursor position
;	ES:SI = String start address
;	ES:DI = String end address
; Uses	AX,BX,SI}
asm
  CMP	SI,DI
  JE	@@8
  PUSH	CX
  PUSH	DX
  PUSH	DI
  PUSH	DS
  PUSH	ES
  MOV	CX,DI
  SUB	CX,SI
  PUSH	DS
  MOV	DS,Seg0040
  MOV	AL,BH
{	MUL	DS:CrtWidth}
  MUL	DS:byte(DataOfBios([0]).VideoColumnsOnScreen)
{	MOV	AL,BH
	xor	ah,ah; cwd
	MUL	DS:DataOfBios([0]).VideoColumnsOnScreen - размер
	VideoColumnsOnScreen, поэтому был бы более правилен этот фрагмент }
  XOR	BH,BH
  ADD	AX,BX
  SHL	AX,1
  MOV	DI,AX
{	MOV	DX,DS:Addr6845}
  MOV	DX,DS:DataOfBios([0]).VideoCRTcontrollerBaseAddress
  ADD	DX,6
{	CMP	DS:CrtMode,7}
  CMP	DS:DataOfBios([0]).VideoCurrentMode,7
  POP	DS
  MOV	AX,SegB800
  JNE	@@1
  MOV	AX,SegB000
@@1:
  MOV	BL,CheckSnow
  MOV	BH,TextAttr
  PUSH	ES
  POP	DS
  MOV	ES,AX
  CLD
  OR	BL,BL
  JE	@@5
@@2:
  LODSB
  MOV	BL,AL
@@3:
  IN	AL,DX
  TEST	AL,1
  JNE	@@3
  CLI
@@4:
  IN	AL,DX
  TEST	AL,1
  JE	@@4
  MOV	AX,BX
  STOSW
  STI
  LOOP	@@2
  JMP	@@7
@@5:
  MOV	AH,BH
@@6:
  LODSB
  STOSW
  LOOP	@@6
@@7:
  POP	ES
  POP	DS
  POP	DI
  POP	DX
  POP	CX
@@8:
end;

type
  TA=array[1..10] of char;
  PA=^TA;

procedure WriteString; assembler;
{; Write character string directly to CRT
; In	CX    = Character count
;	DX    = Position
;	ES:DI = String pointer
; Uses	AX,BX,CX,DX,SI,DI,ES
}
asm
  PUSH	DS
  MOV	DS,Seg0040
{	MOV	DX,DS:Cursor}
  MOV	DX,DS:word(DataOfBios([0]).VideoCursorPosition)
  POP	DS
  MOV	BX,DX
  MOV	SI,DI
@@1:
  MOV	AL,ES:[DI]
  CMP	AL,asciiBell
  JE	@@2
  CMP	AL,asciiBS
  JE	@@3
  CMP	AL,asciiLF
  JE	@@4
  CMP	AL,asciiCR
  JE	@@5
  INC	DI
  INC	DL
  CMP	DL,WindMax.X
  JBE	@@8
  CALL	DirectWrite
  CALL	LineFeed
  MOV	DL,WindMin.X
  JMP	@@7
@@2:
  CALL	DirectWrite
  PUSH	CX
  PUSH	DX
  MOV	AX,14*256+asciiBell
  CALL	Video
  POP	DX
  POP	CX
  JMP	@@6
@@3:
  CALL	DirectWrite
  CMP	DL,WindMin.X
  JE	@@6
  DEC	DL
  JMP	@@6
@@4:
  CALL	DirectWrite
  CALL	LineFeed
  JMP	@@6
@@5:
  CALL	DirectWrite
  MOV	DL,WindMin.X
@@6:
  INC	DI
@@7:
  MOV	SI,DI
  MOV	BX,DX
@@8:
  LOOP	@@1
  CALL	DirectWrite
  PUSH	DS
  MOV	DS,Seg0040
{	MOV	DS:Cursor,DX}
  MOV	DS:word(DataOfBios([0]).VideoCursorPosition),DX
  MOV	AL,DH
{	MUL	DS:CrtWidth}
  MUL	DS:DataOfBios([0]).VideoColumnsOnScreen
  XOR	DH,DH
  ADD	AX,DX
  MOV	CX,AX
{	MOV	DX,DS:Addr6845}
  MOV	DX,DS:DataOfBios([0]).VideoCRTcontrollerBaseAddress
  MOV	AL,14
  OUT	DX,AL
  JMP	@Next
  @Next:
  MOV	AL,CH
  INC	DX
  OUT	DX,AL
  JMP	@Next1
  @Next1:
  DEC	DX
  MOV	AL,15
  OUT	DX,AL
  JMP	@Next2
  @Next2:
  MOV	AL,CL
  INC	DX
  OUT	DX,AL
  POP	DS
end;

procedure CrtReturn{(var F: Text)}; assembler;
{; CRT file no-op procedure}
asm
  XOR	AX,AX
  RETF	4
end;

procedure WriteCrLf; assembler;
{; Write CR/LF on CRT
; Uses	AX}
asm
  MOV	AL,asciiCR
  CALL	WriteChar
  MOV	AL,asciiLF
  jmp   WriteChar
end;

procedure GetCursor; near; assembler;
{; Get cursor position
; Out	DX = Cursor position
; Uses	AX,BX,CX,DX,ES}
asm
  MOV	AH,3
  XOR	BH,BH
  JMP	Video
end;

procedure SetCursor; near; assembler;
{; Set cursor position
; In	DX = Cursor position
; Uses	AX,BX,CX,DX,ES}
asm
  MOV	AH,2
  XOR	BH,BH
  JMP	Video
end;

(*procedure AdjustTexAttributeForGraphModes; near; assembler;
{ Устанавливает в BH правильные атрибуты текста для графических режимов
Return BH:= text attribute}
asm
  MOV	BH,TextAttr
  cmp IsAlphaMode,True; je @TextMode
    shr bh,4
  @TextMode:
end;
*)

procedure WriteChar; assembler;
{; Write character on CRT
; In	AL = Character
; Uses	AX}
asm
  PUSH	BX
  PUSH	CX
  PUSH	DX
  PUSH	ES
  PUSH	AX
  CALL	GetCursor
  POP	AX
  CMP	AL,asciiBell
  JE	@@1
  CMP	AL,asciiBS
  JE	@@2
  CMP	AL,asciiCR
  JE	@@3
  CMP	AL,asciiLF
  JE	@@4
  MOV	AH,9
{  call	AdjustTexAttributeForGraphModes
  mov bl,bh}
  MOV	BL,TextAttr
  XOR	BH,BH
  MOV	CX,1
  PUSH	DX
  CALL	Video
  POP	DX
  INC	DL
  CMP	DL,WindMax.X
  JBE	@@5
  MOV	DL,WindMin.X
  JMP	@@4
@@1:
  MOV	AH,14
  CALL	Video
  JMP	@@5
@@2:
  CMP	DL,WindMin.X
  JE	@@5
  DEC	DL
  JMP	@@5
@@3:
  MOV	DL,WindMin.X
  JMP	@@5
@@4:
  CALL	LineFeed
@@5:
  CALL	SetCursor
  POP	ES
  POP	DX
  POP	CX
  POP	BX
end;

procedure LineFeed; assembler;
{; Do line-feed operation
; In	DX = Cursor position
; Uses	AX,BX}
asm
  INC	DH
  CMP	DH,WindMax.Y
  JBE	@@1
  DEC	DH
  PUSH	CX
  PUSH	DX
  MOV	AX,6*256+1

  MOV	BH,GraphTextAttr

  MOV	CX,WindMin
  MOV	DX,WindMax
  CALL	Video
  POP	DX
  POP	CX
@@1:
end;

function ReadKey:char; assembler;
{; Read character from keyboard
; Out	AL = Character}
asm
  MOV	AL,ScanCode
  MOV	ScanCode,0
  OR	AL,AL
  JNE	@@1
  XOR	AH,AH
  INT	16H
  OR	AL,AL
  JNE	@@1
  MOV	ScanCode,AH
  OR	AH,AH
  JNE	@@1
  MOV	AL,'C'-64
@@1:
  CALL	BreakCheck
end;

function KeyPressed:boolean; assembler;
{; Return true if key is available}
asm
  CMP	ScanCode,0
  JNE	@@1
  MOV	AH,1
  INT	16H
  MOV	AL,0
  JE	@@2
@@1:
  MOV	AL,1
@@2:	{RETF}
end;

procedure TextMode(Mode: Integer); assembler;
{; Set CRT text mode}
asm
{	MOV	BX,SP
	MOV	AX,SS:[BX+4]}
	push Mode; call SetVideoMode
	MOV	AX,Mode
	CALL	CrtInit
	CALL	CrtSetup
	MOV	AL,NormAttr
	MOV	TextAttr,AL
	call SetupTexAttributeForGraphModes
	{RETF	2}
end;

procedure Window(X1,Y1,X2,Y2: Byte); assembler;
{; Define output window}
asm
{	MOV	BX,SP
	MOV	DL,SS:[BX+10]
	MOV	DH,SS:[BX+8]
	MOV	CL,SS:[BX+6]
	MOV	CH,SS:[BX+4]}
   MOV	DL,X1
   MOV	DH,Y1
   MOV	CL,X2
   MOV	CH,Y2
   CMP	DL,CL
   JA	@@1
   CMP	DH,CH
   JA	@@1
   DEC	DL
   JS	@@1
   DEC	DH
   JS	@@1
   DEC	CL
   CMP	CL,CurCrtSize.X
   JA	@@1
   DEC	CH
   CMP	CH,CurCrtSize.Y
   JA	@@1
   MOV	WindMin,DX
   MOV	WindMax,CX
   CALL	SetCursor
@@1:
end;

procedure GotoXY(X,Y: Byte); assembler;
{; Position cursor}
asm
{	MOV	BX,SP
	MOV	DL,SS:[BX+6]
	MOV	DH,SS:[BX+4]}
  MOV	DL,X
  MOV	DH,Y
  DEC	DL
  ADD	DL,WindMin.X
  JC	@@1
  CMP	DL,WindMax.X
  JA	@@1
  DEC	DH
  ADD	DH,WindMin.Y
  JC	@@1
  CMP	DH,WindMax.Y
  JA	@@1
  CALL	SetCursor
@@1:
end;

function WhereX: Byte; assembler;
{; Return cursor X coordinate}
asm
  CALL	GetCursor
  MOV	AL,DL
  SUB	AL,WindMin.X
  INC	AL
end;

function WhereY: Byte; assembler;
{; Return cursor Y coordinate}
asm
  CALL	GetCursor
  MOV	AL,DH
  SUB	AL,WindMin.Y
  INC	AL
end;

procedure ClrScr; assembler;
{; Clear screen}
asm
  MOV	AX,6*256
{  MOV	BH,TextAttr}
  MOV	BH,GraphTextAttr
{  call AdjustTexAttributeForGraphModes}

  MOV	CX,WindMin
  MOV	DX,WindMax
  CALL	Video
  MOV	DX,WindMin
  CALL	SetCursor
end;

procedure ClrEol; assembler;
{; Clear to end-of-line}
asm
  CALL	GetCursor
  MOV	AX,6*256
{  MOV	BH,TextAttr}
  MOV	BH,GraphTextAttr
{  call AdjustTexAttributeForGraphModes}

  MOV	CX,DX
  MOV	DL,WindMax.X
  CALL	Video
end;

procedure InsDelLine; far; assembler;
asm
  PUSH	AX
  CALL	GetCursor
  POP	AX
{  MOV	BH,TextAttr}
  MOV	BH,GraphTextAttr
{  call AdjustTexAttributeForGraphModes}

  MOV	CL,WindMin.X
  MOV	CH,DH
  MOV	DX,WindMax
  CMP	CH,DH
  JNE	@@1
  XOR	AL,AL
@@1:
  CALL	Video
end;

procedure DelLine; assembler;
asm
  MOV	AX,6*256+1
  jmp	InsDelLine
end;

procedure InsLine; assembler;
asm
  MOV	AX,7*256+1
  JMP	InsDelLine
end;

procedure TextColor(Color: Byte); assembler;
{; Set text color (color modes)}
asm
{	MOV	BX,SP
	MOV	AL,SS:[BX+4]}
  MOV	AL,Color
  TEST	AL,0F0H
  JE	@@1
  AND	AL,0FH
  OR	AL,80H
@@1:
  AND	TextAttr,70H
  OR	TextAttr,AL
  call SetupTexAttributeForGraphModes
{	RETF	2}
end;

procedure TextBackground(Color: Byte); assembler;
{; Set text background (color modes)}
asm
{	MOV	BX,SP
	MOV	AL,SS:[BX+4]}
  MOV	AL,Color
  AND	AL,7
  MOV	CL,4
  SHL	AL,CL
  AND	TextAttr,8FH
  OR	TextAttr,AL
  call SetupTexAttributeForGraphModes
{	RETF	2}
end;

procedure LowVideo; assembler;
{; Select low intensity}
asm
  AND	TextAttr,0F7H
  call SetupTexAttributeForGraphModes
end;

procedure HighVideo; assembler;
{; Select high intensity}
asm
  OR	TextAttr,8
  call SetupTexAttributeForGraphModes
end;

procedure NormVideo; assembler;
{; Select normal intensity}
asm
  MOV	AL,NormAttr
  MOV	TextAttr,AL
  call SetupTexAttributeForGraphModes
end;

procedure Delay(MS: Word); assembler;
{; Delay specified number of milliseconds}
asm
{  MOV	CX,MS
  JCXZ	@End }
  cmp MS,0; je @End
  MOV	ES,Seg0040
  XOR	DI,DI
  MOV	BL,ES:[DI]
  @Loop:
{	MOV	AX,DelayCnt
	XOR	DX,DX}
	{patch for Run error 200 at PII 300}
	MOV	AX,word(DelayCnt)
	MOV	DX,word(DelayCnt)[2]
	mov	cx,word(DelayCnt)[4]
	CALL	DelayLoop
	dec MS
  jnz @Loop
{  LOOP	@Loop}
  @End:
end;

procedure Sound(Hz: Word); assembler;
{; Start sound generator}
asm
{	MOV	BX,SP
	MOV	BX,SS:[BX+4]}
  MOV	BX,Hz
  MOV	AX,34DDH
  MOV	DX,0012H
  CMP	DX,BX
  JNC	@@2
  DIV	BX
  MOV	BX,AX
  IN	AL,61H
  TEST	AL,3
  JNZ	@@1
  OR	AL,3
  OUT	61H,AL
  MOV	AL,0B6H
  OUT	43H,AL
@@1:
  MOV	AL,BL
  OUT	42H,AL
  MOV	AL,BH
  OUT	42H,AL
@@2:
end;

procedure NoSound; assembler;
{; Turn off sound generator}
asm
  IN	AL,61H
  AND	AL,0FCH
  OUT	61H,AL
end;

procedure Break;
begin
  Halt(255);
end;

procedure BreakCheck; assembler;
{; Check for Ctrl-Break}
asm
  CMP	BreakFlag,0
  JNE	@@1
  RET
@@1:
  MOV	BreakFlag,0
@@2:
  MOV	AH,1
  INT	16H
  JE	@@3
  MOV	AH,0
  INT	16H
  JMP	@@2
@@3:
  MOV	AL,'^'
  CALL	WriteChar
  MOV	AL,'C'
  CALL	WriteChar
  CALL	WriteCrLf
  JMP	Break
end;

procedure Video; assembler;
asm
  PUSH	SI
  PUSH	DI
  PUSH	BP
  PUSH	ES
  INT	10H
  POP	ES
  POP	BP
  POP	DI
  POP	SI
end;

begin
  Initialize;
  AssignCrt(Input); Reset(Input);
  AssignCrt(Output); Rewrite(Output);
end.