From: Mischa Poslawsky Date: Sat, 8 Sep 2001 11:57:58 +0000 (+0200) Subject: personal pascal include X-Git-Url: http://git.shiar.nl/wormy.git/commitdiff_plain/e220cf6556aa0bfe7baa7e3549915d71be72d104?ds=sidebyside personal pascal include --- diff --git a/shiar.pas b/shiar.pas new file mode 100644 index 0000000..0386d6d --- /dev/null +++ b/shiar.pas @@ -0,0 +1,895 @@ +UNIT SHIAR; {YEAH!! {ITS_ALL_YOU'LL_EVER_NEED} +{$G+} + +INTERFACE {WHAT_HAVE_WE_GOT_HERE?} + +USES DOS,CRT; {LET'S_USE_THESE_TOO} + +CONST + MOUSEINTR = $33; {MOUSE_INTERRUPT_NUMBER} + TIMERINTR = 8; {TIMER_INTERRUPT_NUMBER} + PIT_FREQ = $1234DD; {PIT_FREQUENCY} + VGA = $A000; {ADRESS_OF_THE_VGA_SCREEN} + MODESETS:ARRAY[0..15,0..20]OF WORD = {VIDEO_RESOLUTION_SETTING} + {320X200} ((2,320,200,0,$0014,$E317,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), + {320X240} (10,320,240,$E3,$2C11,$0D06,$3E07,$4109,$EA10,$DF12,$0014,$E715, + $0616,$E317,0,0,0,0,0,0,0), + {360X200} (8,360,200,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$0014,$E317, + 0,0,0,0,0,0,0,0,0), + {360X240} (16,360,240,$E7,$AC11,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$0D06, + $3E07,$4109,$EA10,$DF12,$0014,$E715,$0616,$E317,0), + {376X282} (17,376,282,$E7,$6E00,$5D01,$5E02,$9103,$6204,$8F05,$6206, + $F007,$6109,$3710,$8911,$3312,$2F13,$0014,$3C15,$5C16,$E317), + {320X400} (3,320,400,$E3,$4009,$0014,$E317,0,0,0,0,0,0,0,0,0,0,0,0,0,0), + {320X480} (10,320,480,$E3,$AC11,$0D06,$3E07,$4009,$EA10,$DF12,$0014,$E715, + $0616,$E317,0,0,0,0,0,0,0), + {360X400} (9,360,400,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$4009,$0014, + $E317,0,0,0,0,0,0,0,0), + {360X480} (17,360,480,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$0D06,$3E07, + $4009,$EA10,$AC11,$DF12,$2D13,$0014,$E715,$0616,$E317), + {360X360} (15,360,360,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$4009,$8810, + $8511,$6712,$2D13,$0014,$6D15,$BA16,$E317,0,0), + {376X308} (17,376,308,$E7,$6E00,$5D01,$5E02,$9103,$6204,$8F05,$6206,$0F07, + $4009,$3710,$8911,$3312,$2F13,$0014,$3C15,$5C16,$E317), + {376X564} (17,376,564,$E7,$6E00,$5D01,$5E02,$9103,$6204,$8F05,$6206,$F007, + $6009,$3710,$8911,$3312,$2F13,$0014,$3C15,$5C16,$E317), + {256X200} (8,256,200,$E3,$5F00,$3F01,$4202,$9F03,$4C04,$0005,$0014,$E317, + 0,0,0,0,0,0,0,0,0), + {256X224} (17,256,224,$E3,$5F00,$3F01,$4002,$8203,$4A04,$9A05,$0B06,$3E07, + $4109,$DA10,$9C11,$BF12,$2013,$0014,$C715,$0416,$E317), + {256X240} (16,256,240,$E3,$5F00,$3F01,$4202,$9F03,$4C04,$0005,$0D06,$3E07, + $4109,$EA10,$AC11,$DF12,$0014,$E715,$0616,$E317,0), + {256X256} (17,256,256,$E3,$5F00,$3F01,$4002,$8203,$4E04,$9A05,$2306,$B207, + $0008,$6109,$0A10,$AC11,$FF12,$4014,$0715,$1716,$A317)); + +TYPE + VIRT = ARRAY[1..64000]OF BYTE; {TO_STORE_BITMAP_FILES} + VIRPTR = ^VIRT; {POINTER_TO_VIRTUAL} + PALETTE = ARRAY[0..255]OF RECORD R,G,B:BYTE; END; {TO_STORE_MCGA_PALETTE} + TSOUND = RECORD {USE_TO_STORE_SOUNDS} + DATA:POINTER; {POINTER_TO_THE_SND_DATA} + SIZE:WORD; {SIZE_OF_THE_SOUND_DATA} + END; {TSOUND} + +VAR WIDTH:INTEGER; {WIDTH_GRAPHICAL_SCREEN} + VALID_OP_CODE:BOOLEAN; {USED_FOR_CHECKING_CPU} + MAXTIME:INTEGER; {TRIGGER_TIME} + BIOSTIMERHANDLER:PROCEDURE; {} + CLOCKTICKS:LONGINT; {TIMER_TICKS_EXPIRED} + TIMEEXPIRED:BOOLEAN; {TRUE_IF_TIME_HAS_EXPIRED} + +FUNCTION FILEEXIST(FIS1:STRING):BOOLEAN; +PROCEDURE COFF; +PROCEDURE CLRKEY; +FUNCTION KEY:INTEGER; +FUNCTION MIN(MII1,MII2:INTEGER):INTEGER; +FUNCTION MAX(MAI1,MAI2:INTEGER):INTEGER; +FUNCTION ZERO(ZEF1:LONGINT;ZEI1:WORD):STRING; +FUNCTION POW(POI1:LONGINT;POI2:INTEGER):LONGINT; +FUNCTION FPR(FPR1:REAL;FPI1,FPI2:BYTE):STRING; +FUNCTION FP(FPR1:REAL;FPI1,FPI2:BYTE):STRING; +FUNCTION PSET(PSS1:STRING;PSI1:WORD):STRING; +FUNCTION DRPSET(PSS1:STRING;PSI1:WORD):STRING; +FUNCTION CC(CCC1:CHAR;CCI1:BYTE):STRING; +FUNCTION UPCS(UPS1:STRING):STRING; +FUNCTION LOCS(LOS1:STRING):STRING; +FUNCTION PARAMETER(PAS1:STRING):BOOLEAN; +FUNCTION ACTIVE:BYTE; +FUNCTION SGN(SGN1:REAL):INTEGER; +FUNCTION COMP8088:BOOLEAN; +FUNCTION COMP80186:BOOLEAN; +FUNCTION COMP80286:BOOLEAN; +FUNCTION COMP80386:BOOLEAN; +FUNCTION COMP80486:BOOLEAN; +FUNCTION EMSTAT(VAR VERS:BYTE;VAR SIZE,FREE:WORD):BOOLEAN; +FUNCTION XMSTAT(VAR VERS:WORD;VAR SIZE,FREE:WORD):BOOLEAN; +PROCEDURE GETMOUSEPOS(VAR X,Y:WORD;VAR BUTTON1,BUTTON2:BOOLEAN); +PROCEDURE MOUSE(AI:WORD;VAR A,B,C,D:WORD); +FUNCTION BYTE2HEX(B:BYTE):STRING; +FUNCTION WORD2HEX(W:WORD):STRING; +FUNCTION DWORD2HEX(L:LONGINT):STRING; +PROCEDURE SETTIMER(TIMERHANDLER:POINTER;FREQUENCY:WORD); +PROCEDURE SHUTDOWNTIMER; +PROCEDURE TIMERHANDLER; INTERRUPT; + +PROCEDURE SETVIDEO(X,Y:WORD); +PROCEDURE XMODE(MODE:BYTE); +PROCEDURE SETXVID(X,Y,COL:WORD); +PROCEDURE SETMCGA; +PROCEDURE SETVGA; +PROCEDURE SETTEXT; +FUNCTION TESTVESA(VAR X,Y:WORD):BOOLEAN; +FUNCTION TESTATI:BOOLEAN; +PROCEDURE SCREENOFF; +PROCEDURE SCREENON; +PROCEDURE CLS(COL:BYTE;WHERE:WORD); +PROCEDURE XCLS(COL:BYTE;WHERE:WORD); +PROCEDURE WAITRETRACE; +PROCEDURE SETPAL(COL,R,G,B:BYTE); +PROCEDURE GETPAL(COL:BYTE;VAR R,G,B:BYTE); +PROCEDURE FADECURS; +PROCEDURE FADEDOWN; +PROCEDURE FADEOUT; +{PROCEDURE PUTPIXEL(X,Y:INTEGER;COL:BYTE;WHERE:WORD);{} +PROCEDURE PUTXPIX(X,Y:INTEGER;COL:BYTE); +PROCEDURE PUTPIX(X:INTEGER;COL:BYTE;WHERE:WORD); +PROCEDURE XPUTPIX(X:INTEGER;COL:BYTE); +FUNCTION GETPIXEL(X,Y:INTEGER;WHERE:WORD):BYTE; +FUNCTION GETXPIX(X,Y:INTEGER;WHERE:WORD):BYTE; +PROCEDURE BLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD); +PROCEDURE XBLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD); +PROCEDURE BAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE;WHERE:WORD); +PROCEDURE XBAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE); +PROCEDURE HLINE(X,XX,Y:INTEGER;COL:BYTE;WHERE:WORD); +PROCEDURE XHLINE(X,XX,Y:INTEGER;COL:BYTE); +PROCEDURE LINE(X,Y,XX,YY:INTEGER;COL:BYTE;WHERE:WORD); +PROCEDURE XLINE(X,Y,XX,YY:INTEGER;COL:BYTE); +PROCEDURE FLIP(SOURCE,DEST:WORD); +PROCEDURE FLIPSCR(SOURCE,DEST:WORD); + + +IMPLEMENTATION {THE_CODE} + +FUNCTION FILEEXIST(FIS1:STRING):BOOLEAN; +VAR FIF1:FILE; +BEGIN {DOES_FILE_EXISTS} + ASSIGN(FIF1,FIS1); {$I-} RESET(FIF1); CLOSE(FIF1); {$I+} + FILEEXIST:=(IORESULT=0)AND(FIS1<>''); +END; {FILEEXIST} + +PROCEDURE COFF; ASSEMBLER; +ASM {CURSOR_OFF} +{ CAR1.AH:=1; CAR1.BH:=0; INTR($10,CAR1); + CAR1.AH:=3; CAR1.CH:=0; INTR($10,CAR1);} + MOV AH,1 + MOV BH,0 + INT 10H + MOV AH,3 + MOV CH,0 + INT 10H +END; {COFF} + +PROCEDURE CLRKEY; +VAR CLC1:CHAR; +BEGIN {CLEAR_ALL_KEYS} + WHILE KEYPRESSED DO CLC1:=READKEY; +END; {CLRKEY} + +FUNCTION KEY:INTEGER; +VAR KEC1:CHAR; KEC2:INTEGER; +BEGIN {READ_CHAR} + KEC2:=-1; + IF KEYPRESSED THEN BEGIN + KEC1:=READKEY; KEC2:=ORD(KEC1); + IF KEC1=CHR(0)THEN BEGIN KEC1:=READKEY; KEC2:=ORD(KEC1)+256; END; {EXTENDED} + END; {KEY_IS_PRESSED} + KEY:=KEC2; +END; {KEY} + +FUNCTION MIN(MII1,MII2:INTEGER):INTEGER; +BEGIN {RETURN_SMALLEST_VALUE} + IF MII2MAI1 THEN MAX:=MAI2 ELSE MAX:=MAI1; +END; {MAX} + +FUNCTION ZERO(ZEF1:LONGINT;ZEI1:WORD):STRING; +VAR ZES1:STRING; +BEGIN {PLACE_ZEROES} + STR(ZEF1:0,ZES1); WHILE LENGTH(ZES1)PSI1)AND(PSI1>3)THEN BEGIN + WHILE LENGTH(PSS1)>PSI1-3 DO DELETE(PSS1,LENGTH(PSS1),1); + PSS1:=PSS1+'...'; + END; {TOO LARGE} + PSET:=PSS1; +END; {PSET} + +FUNCTION DRPSET(PSS1:STRING;PSI1:WORD):STRING; +BEGIN {PLACE_DOTS_KEEP_DRIVE_LETTER} + IF LENGTH(PSS1)>PSI1 THEN BEGIN + INSERT('...',PSS1,4); WHILE LENGTH(PSS1)>PSI1 DO DELETE(PSS1,7,1); + END; {TOO LARGE} + DRPSET:=PSS1; +END; {DRPSET} + +FUNCTION CC(CCC1:CHAR;CCI1:BYTE):STRING; +VAR CCS1:STRING; CCI2:BYTE; +BEGIN {COPY_CHAR} + CCS1:=''; FOR CCI2:=1TO CCI1 DO CCS1:=CCS1+CCC1; CC:=CCS1; +END; {CC} + +FUNCTION UPCS(UPS1:STRING):STRING; +VAR UPI1:INTEGER; +BEGIN {UPCASE} + FOR UPI1:=1TO LENGTH(UPS1)DO UPS1[UPI1]:=UPCASE(UPS1[UPI1]); UPCS:=UPS1; +END; {UPCS} + +FUNCTION LOCS(LOS1:STRING):STRING; +VAR LOI1:INTEGER; +BEGIN {LOCASE} + FOR LOI1:=1TO LENGTH(LOS1)DO BEGIN + LOS1[LOI1]:=UPCASE(LOS1[LOI1]); + IF(LOS1[LOI1]>='A')AND(LOS1[LOI1]<='Z')THEN LOS1[LOI1]:=CHR(ORD(LOS1[LOI1])+32); + END; {MAKE LOWER CASE} + LOCS:=LOS1; +END; {LOCS} + +FUNCTION PARAMETER(PAS1:STRING):BOOLEAN; +VAR PAI1:INTEGER; PAS2:STRING; +BEGIN {PARAMETER} + PARAMETER:=FALSE; + IF PARAMCOUNT>0THEN FOR PAI1:=1TO PARAMCOUNT DO BEGIN + PAS2:=UPCS(PARAMSTR(PAI1)); + IF(PAS2='/'+UPCS(PAS1))OR(PAS2='-'+UPCS(PAS1))OR(PAS2=UPCS(PAS1)) + OR(PAS2='>'+UPCS(PAS1))THEN PARAMETER:=TRUE; + END; {FOR} +END; {PARAMETER} + +FUNCTION ACTIVE:BYTE; ASSEMBLER; +ASM + MOV AH,2 + INT 16H + MOV AH,0 +{Bits: $01=RSH $02=LSH $04=CTL $08=ALT $10=SCR $20=NUM $40=CAP $80=INS + Example: IF(ACTIVE AND$01<>0)THEN WRITELN('RIGHT SHIFT PRESSED');} +END; + +FUNCTION SGN(SGN1:REAL):INTEGER; +BEGIN + IF SGN1>0THEN SGN:=1 ELSE IF SGN1<0THEN SGN:=-1 ELSE SGN:=0; +END; {SGN} + +PROCEDURE INTR6HANDLER; INTERRUPT; +BEGIN + VALID_OP_CODE:=FALSE; + ASM ADD WORD PTR SS:[BP+18],3 END; {A_SINGLE_ASSEMBLER_CODE} +END; {INTR6HANDLER} + +FUNCTION COMP8088:BOOLEAN; ASSEMBLER; +ASM {RETURNS_TRUE_IF_8088_COMPATIBLE_FOUND} + MOV AX,SP + PUSH SP + POP BX + CMP AX,BX + JZ @@1 + XOR AX,AX +@@1: + MOV AX,1 +END; {COMP8088} + +FUNCTION COMP80186:BOOLEAN; +VAR X:PROCEDURE; +BEGIN + IF COMP8088 THEN COMP80186:=FALSE ELSE BEGIN + VALID_OP_CODE:=TRUE; + GETINTVEC(6,@X); + SETINTVEC(6,ADDR(INTR6HANDLER)); + INLINE($C1/$E2/$05); {SHL DX,5} + SETINTVEC(6,@X); + COMP80186 :=VALID_OP_CODE; + END; +END; + +FUNCTION COMP80286:BOOLEAN; ASSEMBLER; +ASM {RETURNS_TRUE_IF_COMPUTER_IS_286_COMPATIBLE} + PUSHF + POP BX + AND BX,0FFFH + PUSH BX + POPF + PUSHF + POP BX + AND BX,0F000H + XOR AX,AX + CMP BX,0F000H + JZ @@1 + INC AX +@@1: +END; {COMP80286} + +FUNCTION COMP80386:BOOLEAN; +VAR X:PROCEDURE; +BEGIN {RETURNS_TRUE_IF_COMPUTER_IS_80386_COMPATIBLE} + IF NOT COMP8088 THEN COMP80386:=FALSE ELSE BEGIN + VALID_OP_CODE:=TRUE; + GETINTVEC(6,@X); + SETINTVEC(6,ADDR(INTR6HANDLER)); + INLINE($0F/$20/$C2); {MOV EDX,CR0} + SETINTVEC(6,@X); + COMP80386:=VALID_OP_CODE; + END; {8088_COMPATIBLE>RUN_TEST} +END; {COMP80386} + +FUNCTION COMP80486:BOOLEAN; +VAR X:PROCEDURE; +BEGIN {RETURNS_TRUE_IF_CPU_IS_80486_COMPATIBLE} + IF NOT COMP8088 THEN COMP80486:=FALSE ELSE BEGIN + VALID_OP_CODE:=TRUE; + GETINTVEC(6,@X); + SETINTVEC(6,ADDR(INTR6HANDLER)); + INLINE($0F/$C1/$D2); {XADD DX,DX} + SETINTVEC(6,@X); + COMP80486:=VALID_OP_CODE; + END; {8088_COMPATIBLE>RUN_TEST} +END; {COMP80486} + +FUNCTION EMSTAT(VAR VERS:BYTE;VAR SIZE,FREE:WORD):BOOLEAN; +TYPE ARTYPE=ARRAY[1..8]OF CHAR; +VAR P:^ARTYPE; + REG:REGISTERS; +BEGIN {RETURN_EMS_STATS} + EMSTAT:=FALSE; GETINTVEC($67,POINTER(P)); P:=PTR(SEG(P^),$0A); + IF P^='EMMXXXX0'THEN BEGIN + REG.AH:=$40; INTR($67,REG); + IF REG.AH<>0THEN HALT ELSE BEGIN + REG.AH:=$46; INTR($67,REG); IF REG.AH<>0THEN HALT; + VERS:=REG.AL; {VERSION_IS_(REG.AL SHR 4).(REG.AL AND $F)} + REG.AH:=$42; INTR($67,REG); IF REG.AH<>0THEN HALT; + SIZE:=REG.DX; FREE:=REG.BX; {SIZE_UNIT_IS_64_BYTES_OR_(2^4)_KB} + EMSTAT:=TRUE; + END; {NO_ERRORS} + END; {EMM_INSTALLED} +END; {EMSTAT} + +FUNCTION XMSTAT(VAR VERS:WORD;VAR SIZE,FREE:WORD):BOOLEAN; +VAR P:LONGINT; + REG:REGISTERS; + VER:WORD; +BEGIN + XMSTAT:=FALSE; REG.AX:=$4300; INTR($2F,REG); + IF REG.AL=$80THEN BEGIN + XMSTAT:=TRUE; + ASM {GET_VERSION_NUMBER} + MOV AX,4310h + INT 2Fh + MOV WORD PTR [P],BX + MOV WORD PTR [P+2],ES + MOV AH,00h + CALL [P] + MOV [VER],AX + END; {ASM} + VERS:=VER; + END; {XMS_FOUND} +END; {XMSTAT} + +PROCEDURE GETMOUSEPOS(VAR X,Y:WORD;VAR BUTTON1,BUTTON2:BOOLEAN); +VAR REGS:REGISTERS; +BEGIN {RETURNS_POSITION_OF_MOUSE_AND_PRESS-STATUS_OF_BUTTONS} + REGS.AX:=3; INTR(MOUSEINTR,REGS); X:=REGS.CX; Y:=REGS.DX; + BUTTON1:=(REGS.BX AND 1)<>0; BUTTON2:=(REGS.BX AND 2)<>0; +END; {GETMOUSEPOS} + +PROCEDURE MOUSE(AI:WORD;VAR A,B,C,D:WORD); +VAR AA,BB,CC,DD:WORD; +BEGIN + BB:=B; CC:=C; DD:=D; + ASM + MOV AX,[AI] + MOV BX,[BB] + MOV CX,[CC] + MOV DX,[DD] + INT 33H + MOV [AA],BX + MOV [BB],BX + MOV [CC],CX + MOV [DD],DX + END; {DO_IT} + A:=AA; B:=BB; C:=CC; D:=DD; +END; {MOUSE} + +PROCEDURE _HEXBYTE; ASSEMBLER; +ASM {USED_FOR_HEX_CONVERT_FUNCTIONS_BELOW} + MOV CX,2 +@@1: + PUSH CX + MOV CL,4 + ROL DL,CL + MOV AL,DL + AND AL,0Fh + DAA + ADD AL,0F0h + ADC AL,40h + STOSB + POP CX + LOOP @@1 +END; {_HEXBYTE} + +FUNCTION BYTE2HEX(B:BYTE):STRING; ASSEMBLER; +ASM {CONVERTS_A_HEX_REPRESENTATION_OF_THE_BYTE_INTO_A_STRING} + CLD + LES DI,@RESULT + MOV AL,2 + STOSB + MOV DL,[B] + CALL _HEXBYTE +END; {BYTE2HEX} + +FUNCTION WORD2HEX(W:WORD):STRING; ASSEMBLER; +ASM {CONVERT_THE_HEXADECIMAL_VALUE_OF_A_WORD_TO_A_STRING} + CLD + LES DI,@RESULT + MOV AL,4 + STOSB + MOV DX,[W] + MOV CX,2 +@@1: + PUSH CX + XCHG DL,DH + CALL _HEXBYTE + POP CX + LOOP @@1 +END; {WORD2HEX} + +FUNCTION DWORD2HEX(L:LONGINT):STRING; ASSEMBLER; +ASM {CONVERTS_A_LONGINT_HEX_VALUE_INTO_A_STRING} + CLD + LES DI,@RESULT + MOV AL,8 + STOSB + MOV BX,SP + MOV DS,SS:[BX+6] + MOV BX,SS:[BX+8] + MOV CX,2 +@@1: + PUSH CX + XCHG DX,BX + MOV CX,2 +@@2: + PUSH CX + XCHG DL,DH + CALL _HEXBYTE + POP CX + LOOP @@2 + POP CX + LOOP @@1 +END; {DWORD2HEX} + +PROCEDURE SETTIMER(TIMERHANDLER:POINTER;FREQUENCY:WORD); +VAR COUNTER:LONGINT; +BEGIN + CLOCKTICKS:=0; TIMEEXPIRED:=FALSE; COUNTER:=$1234DD DIV FREQUENCY; {@INIT} + GETINTVEC(TIMERINTR,@BIOSTIMERHANDLER); SETINTVEC(TIMERINTR,TIMERHANDLER); + PORT[$43]:=$34; PORT[$40]:=COUNTER MOD 256; PORT[$40]:=COUNTER SHR 8; +END; {SETTIMER} + +PROCEDURE SHUTDOWNTIMER; +BEGIN {RESTORE_EVERYTHING_AS_IT_WAS} + PORT[$43]:=$34; PORT[$40]:=$00; PORT[$40]:=$00; {@RESTORE_NORMAL_CLOCK_FREQUENCY} + SETINTVEC(TIMERINTR,@BIOSTIMERHANDLER); {RESTORE_NORMAL_TICKER_HANDLER} +END; {SHUTDOWNTIMER} + +PROCEDURE TIMERHANDLER; +BEGIN + INC(CLOCKTICKS); + IF CLOCKTICKS>=MAXTIME THEN BEGIN + TIMEEXPIRED:=TRUE; CLOCKTICKS:=0; + ASM PUSHF END; {PUSH_ALL_VALUES} BIOSTIMERHANDLER; + END {TIME_EXPIRED} ELSE PORT[$20]:=$20; {@ACKNOWLEDGE_THE_INTERRUPT} +END; {TIMERHANDLER} + + +PROCEDURE SETVIDEO(X,Y:WORD); ASSEMBLER; +ASM {SET_CUSTOM_VIDEO_MODE} + MOV AX,[X] + MOV BX,[Y] + INT 10H +END; {SETVIDEO} + +PROCEDURE XMODE(MODE:BYTE); +VAR MTEMP:BYTE; +BEGIN + ASM + MOV AX,0013h + INT 10h + END; {GET_INTO_MCGA_MODE} + PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]OR$20; PORTW[$03C4]:=$0604; + IF MODESETS[MODE,3]<>0THEN PORT[$03C2]:=BYTE(MODESETS[MODE,3]); + FOR MTEMP:=4TO MODESETS[MODE,0]+3DO PORTW[$03D4]:=MODESETS[MODE,MTEMP]; + WIDTH:=MODESETS[MODE,1]SHR 2; PORTW[$03C4]:=$0F02; + FILLCHAR(MEM[$A000:0],$8000,0); FILLCHAR(MEM[$A000:$8000],$8000,0); + DELAY(100); PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]AND$DF; +END; {XMODE} + +PROCEDURE SETXVID(X,Y,COL:WORD); +BEGIN {SET_CUSTON_UNCHAINED_VIDEO_MODE} + ASM + MOV AX,[X] + MOV BX,[Y] + INT 10H + END; + PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]OR$20; {@TURN_VGA_SCREEN_OFF} + PORTW[$03C4]:=$0604; {@TURN_OFF_CHAIN-4_BIT} + PORTW[$03D4]:=$E317; {@TURN_OFF_WORD_MODE} + PORTW[$03D4]:=$0014; {@TURN_OFF_DOUBLEWORD_MODE} + PORTW[$03D4]:=$000C; PORTW[$03D4]:=$000D; {@OFFSET} + PORTW[$03C4]:=$0F02; {@CLEAR_ENTIRE_VIDEO_MEMORY} + FILLCHAR(MEM[$A000:1],$FFFF,0); MEM[$A000:0]:=0; + WIDTH:=COL SHR 2; DELAY(100); {@GIVE_A_SMALL_DELAY} + PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]AND$DF; {@TURN_SCREEN_BACK_ON} +END; {SETXVID} + +PROCEDURE SETMCGA; +BEGIN {SETS_VIDEO_TO_NORMAL_320x200x256} + ASM + MOV AX,0013H + INT 10H + END; {ASSEMBLER_TRICK} + PORTW[$03C4]:=$0A04; {@TURN_OFF_CHAIN-4_BIT} +END; {SETMCGA} + +PROCEDURE SETVGA; ASSEMBLER; +ASM {SET_SCREEN_MODE_TO_640x480x256} + MOV AX,4F02H + MOV BX,0100H + INT 10H +END; {SETVGA} + +PROCEDURE SETTEXT; ASSEMBLER; +ASM {SET_SCREEN_MODE_TO_TEXT} + MOV AX,0003H + INT 10H +END; {SETTEXT} + +FUNCTION TESTVESA(VAR X,Y:WORD):BOOLEAN; +TYPE ARTYPE=ARRAY[0..255]OF BYTE; +VAR P:^ARTYPE; + R:REGISTERS; +BEGIN {RETURNS_PRESENT_VESA_CARD_VERSION_IF_PRESENT} + TESTVESA:=FALSE; GETMEM(P,SIZEOF(P)); X:=0; + R.AH:=$4F; R.AL:=$00; R.ES:=SEG(P^); R.DI:=OFS(P^); INTR($10,R); + IF(R.AX=$004F)AND(P^[0]=ORD('V'))AND(P^[1]=ORD('E'))AND(P^[2]=ORD('S')) + AND(P^[3]=ORD('A'))THEN BEGIN + TESTVESA:=TRUE; X:=P^[5]*$100+P^[4]; END; {FOUND} + FREEMEM(P,SIZEOF(P)); +END; {TESTVESA} + +FUNCTION TESTATI:BOOLEAN; +VAR P:STRING[9]; +BEGIN {RETURNS_TRUE_IF_ATI_VIDEO_CARD_IS_PRESENT} + MOVE(MEM[$C000:$0031],P,9); + IF P='761295520'THEN TESTATI:=TRUE ELSE TESTATI:=FALSE; +END; {TESTATI} + +PROCEDURE SCREENOFF; +BEGIN + PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]OR$20; +END; {SCREENOFF} + +PROCEDURE SCREENON; +BEGIN + PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]AND$DF; +END; {SCREENON} + +PROCEDURE CLS(COL:BYTE;WHERE:WORD); +BEGIN {CLEARS_SCREEN_TO_ONE_COLOR} + FILLCHAR(MEM[WHERE:0],64000,COL); +END; {CLS} + +PROCEDURE XCLS(COL:BYTE;WHERE:WORD); +BEGIN {CLEARS_THE_UNCHAINED_SCREEN_TO_A_SINGLE_COLOR} + PORTW[$03C4]:=$0F02; FILLCHAR(MEM[WHERE:0],64000,COL); +END; {XCLS} + +PROCEDURE WAITRETRACE;ASSEMBLER; +ASM {WAIT_FOR_A_VERTICAL_SCREEN_RETRACE} + MOV DX,3DAH +@@1: + IN AL,DX + AND AL,08h + JNZ @@1 +@@2: + IN AL,DX + AND AL,08H + JZ @@2 +END; {WAITRETRACE} + +PROCEDURE SETPAL(COL,R,G,B:BYTE); ASSEMBLER; +ASM {SET_A_PALETTE_COLOR} + MOV DX,3C8H + MOV AL,[COL] + OUT DX,AL + INC DX + MOV AL,[R] + OUT DX,AL + MOV AL,[G] + OUT DX,AL + MOV AL,[B] + OUT DX,AL +END; {SETPAL} + +PROCEDURE GETPAL(COL:BYTE;VAR R,G,B:BYTE); +VAR RT,GT,BT:BYTE; +BEGIN {GET_A_PALETTE_COLOR} + ASM + MOV DX,3C7H + MOV AL,[COL] + OUT DX,AL + INC DX + INC DX + IN AL,DX + MOV [RT],AL + IN AL,DX + MOV [GT],AL + IN AL,DX + MOV [BT],AL + END; + R:=RT; G:=GT; B:=BT; +END; {GETPAL} + +PROCEDURE FADECURS; +VAR R,G,B:BYTE; +BEGIN {FADE_OUT_COLOR_SEVEN} + GETPAL(7,R,G,B); + REPEAT + WAITRETRACE; IF G>0THEN DEC(G); IF B>0THEN DEC(B); IF R>0THEN DEC(R); + SETPAL(7,R,G,B); + UNTIL R+G+B<3; {FADE_TO_BLACK} +END; {FADECURS} + +PROCEDURE FADEDOWN; +VAR FADETEMP,FADECTEMP:INTEGER; + FADETMP,FADETMP2:ARRAY[1..3]OF BYTE; + FADECOL:ARRAY[1..255,1..3]OF BYTE; + FADECOLI:ARRAY[1..255,1..3]OF REAL; +BEGIN {NATURALLY_FADES_OUT_THE_256_COLOR_PALETTE} + FOR FADECTEMP:=1TO 255DO BEGIN + GETPAL(FADECTEMP,FADECOL[FADECTEMP,1],FADECOL[FADECTEMP,2],FADECOL[FADECTEMP,3]); + FADECOLI[FADECTEMP,1]:=FADECOL[FADECTEMP,1]/32; + FADECOLI[FADECTEMP,2]:=FADECOL[FADECTEMP,2]/32; + FADECOLI[FADECTEMP,3]:=FADECOL[FADECTEMP,3]/32; + END; {CALCULATE_STEPS_FOR_EACH_COLOR} + FOR FADETEMP:=0TO 31DO BEGIN + REPEAT UNTIL TIMEEXPIRED; TIMEEXPIRED:=FALSE; + FOR FADECTEMP:=1TO 255DO BEGIN + SETPAL(FADECTEMP,FADECOL[FADECTEMP,1]-ROUND(FADECOLI[FADECTEMP,1]*FADETEMP), + FADECOL[FADECTEMP,2]-ROUND(FADECOLI[FADECTEMP,2]*FADETEMP), + FADECOL[FADECTEMP,3]-ROUND(FADECOLI[FADECTEMP,3]*FADETEMP)); + END; {CHANGE_ALL_COLORS} + END; {FADE_OUT_ALL_COLORS} + WAITRETRACE; FOR FADECTEMP:=1TO 255DO SETPAL(FADECTEMP,0,0,0); +END; {FADEDOWN} + +PROCEDURE FADEOUT; +VAR FADETEMP,FADECTEMP:INTEGER; + FADETMP:ARRAY[1..3]OF BYTE; +BEGIN {FADE_ALL_256_COLORS_BY_DECREASING_THEM_UNTIL_THEY_REACH_ZERO} + FOR FADETEMP:=0TO 63DO BEGIN + REPEAT UNTIL TIMEEXPIRED; TIMEEXPIRED:=FALSE; + FOR FADECTEMP:=1TO 255DO BEGIN + GETPAL(FADECTEMP,FADETMP[1],FADETMP[2],FADETMP[3]); + IF FADETMP[1]>0THEN DEC(FADETMP[1]); + IF FADETMP[2]>0THEN DEC(FADETMP[2]); + IF FADETMP[3]>0THEN DEC(FADETMP[3]); + SETPAL(FADECTEMP,FADETMP[1],FADETMP[2],FADETMP[3]); + END; {CHANGE_ALL_COLORS} + END; {FADE_OUT_ALL_COLORS} +END; {FADEOUT} + +PROCEDURE PUTPIXEL(X,Y:INTEGER;COL:BYTE;WHERE:WORD); +BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN} + ASM + MOV AX,[WHERE] + MOV ES,AX + MOV BX,[X] + MOV DX,[Y] + MOV DH,DL + XOR DL,DL + ADD BX,DX + SHR DX,2 + ADD BX,DX + MOV AL,[COL] + MOV ES:[BX],AL + END; {ASSEMBLER_VERSION} +END; {PUTPIXEL} + +PROCEDURE PUTXPIX(X,Y:INTEGER;COL:BYTE); +BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN} + PORTW[$03C4]:=$100SHL(X AND 3)+2; {@SET_MAP_MASK_TO_SELECT_PROPER_PLANE} + MEM[VGA:Y*WIDTH+X SHR 2]:=COL; +{ MOV DX,03C4H + MOV AL,02H + OUT DX,AL + INC DX + MOV AL,1 + MOV CX,[X] + AND CL,03H + SHL AL,CL + OUT DX,AL + MOV ES,[VGA] + MOV BX,[WIDTH] + MOV AX,[Y] + MUL BL + MOV BX,[X] + SHR BX,2 + ADD BX,AX + MOV AL,[COL] + MOV ES:[BX],AL} +END; {PUTXPIX} + +PROCEDURE PUTPIX(X:INTEGER;COL:BYTE;WHERE:WORD); ASSEMBLER; +ASM {DISPLAYS_A_PIXEL_AT_PRECALCULATED_COORDINATES} + MOV AX,[WHERE] + MOV ES,AX + MOV AX,[X] + MOV DI,AX + MOV AL,[COL] + STOSB +END; {PUTPIX} + +PROCEDURE XPUTPIX(X:INTEGER;COL:BYTE); +BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN} + PORTW[$03C4]:=$100SHL(X AND 3)+2; {@SET_MAP_MASK_TO_SELECT_PROPER_PLANE} + MEM[VGA:X SHR 2]:=COL; +END; {XPUTPIX} + +FUNCTION GETPIXEL(X,Y:INTEGER;WHERE:WORD):BYTE; ASSEMBLER; +ASM {GET_A_PIXEL_FROM_A_CHAINED_SCREEN} + MOV AX,[WHERE] + MOV ES,AX + MOV BX,[X] + MOV DX,[Y] + MOV DH,DL + XOR DL,DL + ADD BX,DX + SHR DX,1 + SHR DX,1 + ADD BX,DX + MOV AL,ES:[BX] +END; {GETPIXEL} + +FUNCTION GETXPIX(X,Y:INTEGER;WHERE:WORD):BYTE; +BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN} + PORT[$03CE]:=4; + PORT[$03CF]:=X AND 3; + GETXPIX:=MEM[WHERE:WIDTH*Y+X SHR 2]; +END; {PUTPIXEL} + +PROCEDURE BLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD); +VAR BLB1,BLB2:INTEGER; +BEGIN {DRAW_A_BAR_WITH_COLOR_ZERO} + FOR BLB1:=Y1 TO Y2 DO FOR BLB2:=X1 TO X2 DO + PUTPIXEL(BLB2,BLB1,0,WHERE); +END; {BLACKBAR} + +PROCEDURE XBLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD); +VAR BLB1,BLB2:INTEGER; +BEGIN + FOR BLB1:=Y1 TO Y2 DO FOR BLB2:=X1 TO X2 DO + PUTXPIX(BLB2,BLB1,0); +END; {BLACKBAR} + +PROCEDURE BAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE;WHERE:WORD); +VAR BLB1:INTEGER; +BEGIN {DRAWS_A_BAR_WITH_SPECIFIED_COLOR} + FOR BLB1:=Y1 TO Y2 DO HLINE(X1,X2,BLB1,COL,WHERE); +END; {BAR} + +PROCEDURE XBAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE); +VAR BLB1,BLB2:INTEGER; +BEGIN + FOR BLB1:=Y1 TO Y2 DO XHLINE(X1,X2,BLB1,COL); +END; {XBAR} + +PROCEDURE HLINE(X,XX,Y:INTEGER;COL:BYTE;WHERE:WORD); ASSEMBLER; +ASM {DRAWS_A_HORIZONTAL_LINE} + MOV AX,[WHERE] + MOV ES,AX + MOV DX,[X] + MOV DI,DX + MOV AX,[Y] + MOV AH,AL + XOR AL,AL + ADD DI,AX + MOV AL,[COL] + MOV AH,AL + MOV CX,[XX] + SUB CX,DX + SHR CX,1 + JNC @@1 + STOSB +@@1: + REP STOSW +END; {HLINE} + +PROCEDURE XHLINE(X,XX,Y:INTEGER;COL:BYTE); +VAR I:INTEGER; +BEGIN {DRAWS_A_HORIZONTAL_LINE_FROM_(X,Y)_TO_(XX,Y)_AT_COLOR_PCOL_ON_VGA} + FOR I:=X TO XX DO PUTXPIX(I,Y,COL); +END; {XHLINE} + +PROCEDURE LINE(X,Y,XX,YY:INTEGER;COL:BYTE;WHERE:WORD); +VAR LINE1,LINE2,SX,SY,SXY,SYX,DX1,DX2,DY1,DY2:INTEGER; +BEGIN {JUST_A_SIMPLE_LINE_PROCEDURE} + SX:=XX-X; SY:=YY-Y; DX1:=SGN(SX); DX2:=DX1; DY1:=SGN(SY); DY2:=0; + SXY:=ABS(SX); SYX:=ABS(SY); + IF SYX>SXY THEN BEGIN + DY2:=DY1; DX2:=0; LINE1:=SXY; SXY:=SYX; SYX:=LINE1; + END; {VERTICAL_LINE} + LINE1:=SXY SHR 1; + FOR LINE2:=0TO SXY DO BEGIN + PUTPIXEL(X,Y,COL,WHERE); + LINE1:=LINE1+SYX; + IF LINE1SXY THEN BEGIN + DY2:=DY1; DX2:=0; LINE1:=SXY; SXY:=SYX; SYX:=LINE1; + END; {VERTICAL_LINE} + LINE1:=SXY SHR 1; + FOR LINE2:=0TO SXY DO BEGIN + PUTXPIX(X,Y,COL); + LINE1:=LINE1+SYX; + IF LINE1