--- /dev/null
+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 MII2<MII1 THEN MIN:=MII2 ELSE MIN:=MII1;
+END; {MIN}
+
+FUNCTION MAX(MAI1,MAI2:INTEGER):INTEGER;
+BEGIN {RETURN_LARGEST_VALUE}
+ IF MAI2>MAI1 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)<ZEI1 DO ZES1:='0'+ZES1;
+ ZERO:=ZES1;
+END; {ZERO}
+
+FUNCTION POW(POI1:LONGINT;POI2:INTEGER):LONGINT;
+VAR POI3:INTEGER; POI4:LONGINT;
+BEGIN {POWER}
+ POI4:=1; FOR POI3:=1TO POI2 DO POI4:=POI4*POI1; POW:=POI4;
+END; {POW}
+
+FUNCTION FPR(FPR1:REAL;FPI1,FPI2:BYTE):STRING;
+BEGIN {FLOATING_POINT_TO_STRING}
+ FPR:=ZERO(TRUNC(FPR1),FPI1)+'.'+ZERO(ROUND(FRAC(FPR1)*POW(10,FPI2)),FPI2);
+END; {FP}
+
+FUNCTION FP(FPR1:REAL;FPI1,FPI2:BYTE):STRING;
+BEGIN {FLOATING_POINT_TO_STRING}
+ FP:=ZERO(TRUNC(FPR1),FPI1)+'.'+ZERO(TRUNC(FRAC(FPR1)*POW(10,FPI2)),FPI2);
+END; {FP}
+
+FUNCTION PSET(PSS1:STRING;PSI1:WORD):STRING;
+BEGIN {PLACE_DOTS}
+ IF(LENGTH(PSS1)>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 LINE1<SXY THEN BEGIN
+ INC(X,DX2); INC(Y,DY2);
+ END {STRAIGT_AHEAD} ELSE BEGIN
+ LINE1:=LINE1-SXY;
+ INC(X,DX1); INC(Y,DY1);
+ END; {NEXT_STEP}
+ END; {DRAW_THE_LINE}
+END; {LINE}
+
+PROCEDURE XLINE(X,Y,XX,YY:INTEGER;COL:BYTE);
+VAR LINE1,LINE2,SX,SY,SXY,SYX,DX1,DX2,DY1,DY2:INTEGER;
+BEGIN
+ 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
+ PUTXPIX(X,Y,COL);
+ LINE1:=LINE1+SYX;
+ IF LINE1<SXY THEN BEGIN
+ INC(X,DX2); INC(Y,DY2);
+ END {STRAIGT_AHEAD} ELSE BEGIN
+ LINE1:=LINE1-SXY;
+ INC(X,DX1); INC(Y,DY1);
+ END; {NEXT_STEP}
+ END; {DRAW_THE_LINE}
+END; {LINE}
+
+PROCEDURE FLIP(SOURCE,DEST:WORD); ASSEMBLER;
+ASM {FLIPS_AN_MCGA_SCREEN_FROM_SOURCE_TO_DEST}
+ PUSH DS
+ MOV AX,[DEST]
+ MOV ES,AX
+ MOV AX,[SOURCE]
+ MOV DS,AX
+ XOR SI,SI
+ XOR DI,DI
+ MOV CX,32000
+ REP MOVSW
+ POP DS
+END; {FLIP}
+
+PROCEDURE FLIPSCR(SOURCE,DEST:WORD); ASSEMBLER;
+ASM {FLIPS_A_PART_OF_AN_MCGA_SCREEN_FROM_SOURCE_TO_DEST}
+ PUSH DS
+ MOV AX,[DEST]
+ MOV ES,AX
+ MOV AX,[SOURCE]
+ MOV DS,AX
+ MOV SI,3200
+ MOV DI,3200
+ MOV CX,25600
+ REP MOVSW
+ POP DS
+END; {FLIP}
+
+
+END. {THAT'S_ALL_FOLKS!}
\ No newline at end of file
git.shiar.nl / wormy.git / commitdiff