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