Mercurial > rg
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.
