diff 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 diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/porting.pas	Sun Dec 08 19:39:15 2013 +0100
@@ -0,0 +1,167 @@
+{ 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.
\ No newline at end of file