view porting.pas @ 0:62966dd383ed default tip

initial
author Radomir Dopieralski <sheep-devel@sheep.art.pl>
date Sun, 08 Dec 2013 19:39:15 +0100
parents
children
line wrap: on
line source

{ All system-dependant procedures should be here. }

UNIT Porting;

INTERFACE

CONST	pal_changed:BOOLEAN=FALSE;	{ Is palette changed? }

	KEYCHR_DIR1=#131;		{ Key codes for special keys. }
	KEYCHR_DIR2=#132;
	KEYCHR_DIR3=#133;
	KEYCHR_DIR4=#134;
	KEYCHR_DIR5=#135;
	KEYCHR_DIR6=#136;
	KEYCHR_DIR7=#137;
	KEYCHR_DIR8=#138;
	KEYCHR_DIR9=#139;	
	KEYCHR_CR=#13;
	KEYCHR_BS=#8;
	KEYCHR_TAB=#9;

TYPE 	PalAry=ARRAY[0..15] OF RECORD r,g,b:BYTE END;

PROCEDURE PutChar(x,y:BYTE;chr:CHAR;atr:BYTE);	{ Displays specified character on the screen. }
PROCEDURE GotoXY(x,y:BYTE);			{ Moves cursor. }
FUNCTION  GetChr: CHAR;				{ Reads a key from standard input. }
PROCEDURE ChPal(Pal:PalAry);			{ Changes color palette, remembers the old one. }
PROCEDURE ResetPal;				{ Changes palette to the old one. }
PROCEDURE ScrollWin(x1,y1,x2,y2:BYTE);		{ Scrolls part of screen. }

IMPLEMENTATION

TYPE	ScrChr=RECORD
		chr: CHAR;
		atr: BYTE;
	END;

VAR	Screen: ARRAY[0..24,0..79] OF ScrChr ABSOLUTE $B800:0000;	{ Video memory. }
	OldPal: ARRAY[0..15] OF BYTE;
	OldRGB: ARRAY[0..15] OF RECORD r,g,b: BYTE END;

PROCEDURE SetPal(i:WORD;p:BYTE);ASSEMBLER;
ASM
	MOV AH, 10h
	MOV AL, 00h
	MOV BX, i
	MOV BH, p
	INT 10h
END;

FUNCTION GetPal(i:BYTE):BYTE;ASSEMBLER;
ASM
	MOV AH, 10h
	MOV AL, 07h
	MOV BL, i
	INT 10h
	MOV AL,BH
END;

PROCEDURE GetRGB(i:WORD; VAR r,g,b: BYTE);
VAR	sr,sg,sb: BYTE;
BEGIN
	ASM
		MOV AH, 10h
		MOV AL, 15h
		MOV BX, i
		INT 10h
		MOV sr, DH
		MOV sg, CH
		MOV sb, CL
	END;
	r:=sr;
	g:=sg;
	b:=sb;
END;

PROCEDURE SetRGB(i:WORD;r,g,b:BYTE);ASSEMBLER;
ASM
	MOV AH, 10h
	MOV AL, 10h
	MOV BX, i
	MOV DH, r
	MOV CH, g
	MOV CL, b
	INT 10h
END;

FUNCTION GetChr: CHAR;
VAR	l:CHAR;
	h:BYTE;
BEGIN
	ASM
		MOV AH,00h
		INT 16h
		MOV l,AL
		MOV h,AH
	END;
	IF l=#0 THEN CASE h OF
		71: l:=KEYCHR_DIR7;
		72: l:=KEYCHR_DIR8;
		73: l:=KEYCHR_DIR9;

		75: l:=KEYCHR_DIR4;
		76: l:=KEYCHR_DIR5;
		77: l:=KEYCHR_DIR6;

		79: l:=KEYCHR_DIR1;
		80: l:=KEYCHR_DIR2;
		81: l:=KEYCHR_DIR3;
	END;
	GetChr:=l;
END;

PROCEDURE PutChar(x,y:BYTE;chr:CHAR;atr:BYTE);
BEGIN
	IF (x>79) OR (y>24) THEN Exit;
	Screen[y,x].chr:=chr;
	Screen[y,x].atr:=atr;
END;

PROCEDURE GotoXY(x,y:BYTE);
BEGIN
	IF (x>79) OR (y>24) THEN Exit;
	ASM
		MOV AH,02h
		MOV BH,00h
		MOV DL,x
		MOV DH,y
		INT 10h
	END;
END;

PROCEDURE ChPal(Pal:PalAry);
VAR i: BYTE;
BEGIN
	pal_changed:=TRUE;
	FOR i:=0 TO 15 DO BEGIN
		OldPal[i]:=GetPal(i);
		SetPal(i,i);
		GetRGB(i,OldRGB[i].r,OldRGB[i].g,OldRGB[i].b);
		SetRGB(i,Pal[i].r,Pal[i].g,Pal[i].b);
	END;
END;

PROCEDURE ResetPal;
VAR	i:INTEGER;
BEGIN
	IF NOT pal_changed THEN Exit;
	FOR i:=0 TO 15 DO BEGIN
		SetPal(i,OldPal[i]);
		SetRGB(i,OldRGB[i].r,OldRGB[i].g,OldRGB[i].b);
	END;
END;

PROCEDURE ScrollWin(x1,y1,x2,y2:BYTE); ASSEMBLER;
ASM			
	MOV AH,06h
	MOV AL,01h
	MOV BH,$07;
	MOV CL,x1
	MOV CH,y1
	MOV DL,x2
	MOV DH,y2
	INT 10h
END;

END.