1 UNIT SHIAR; {YEAH!! {ITS_ALL_YOU'LL_EVER_NEED}
4 INTERFACE {WHAT_HAVE_WE_GOT_HERE?}
6 USES DOS,CRT; {LET'S_USE_THESE_TOO}
9 MOUSEINTR = $33; {MOUSE_INTERRUPT_NUMBER}
10 TIMERINTR = 8; {TIMER_INTERRUPT_NUMBER}
11 PIT_FREQ = $1234DD; {PIT_FREQUENCY}
12 VGA = $A000; {ADRESS_OF_THE_VGA_SCREEN}
13 MODESETS:ARRAY[0..15,0..20]OF WORD = {VIDEO_RESOLUTION_SETTING}
14 {320X200} ((2,320,200,0,$0014,$E317,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
15 {320X240} (10,320,240,$E3,$2C11,$0D06,$3E07,$4109,$EA10,$DF12,$0014,$E715,
16 $0616,$E317,0,0,0,0,0,0,0),
17 {360X200} (8,360,200,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$0014,$E317,
19 {360X240} (16,360,240,$E7,$AC11,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$0D06,
20 $3E07,$4109,$EA10,$DF12,$0014,$E715,$0616,$E317,0),
21 {376X282} (17,376,282,$E7,$6E00,$5D01,$5E02,$9103,$6204,$8F05,$6206,
22 $F007,$6109,$3710,$8911,$3312,$2F13,$0014,$3C15,$5C16,$E317),
23 {320X400} (3,320,400,$E3,$4009,$0014,$E317,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
24 {320X480} (10,320,480,$E3,$AC11,$0D06,$3E07,$4009,$EA10,$DF12,$0014,$E715,
25 $0616,$E317,0,0,0,0,0,0,0),
26 {360X400} (9,360,400,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$4009,$0014,
27 $E317,0,0,0,0,0,0,0,0),
28 {360X480} (17,360,480,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$0D06,$3E07,
29 $4009,$EA10,$AC11,$DF12,$2D13,$0014,$E715,$0616,$E317),
30 {360X360} (15,360,360,$E7,$6B00,$5901,$5A02,$8E03,$5E04,$8A05,$4009,$8810,
31 $8511,$6712,$2D13,$0014,$6D15,$BA16,$E317,0,0),
32 {376X308} (17,376,308,$E7,$6E00,$5D01,$5E02,$9103,$6204,$8F05,$6206,$0F07,
33 $4009,$3710,$8911,$3312,$2F13,$0014,$3C15,$5C16,$E317),
34 {376X564} (17,376,564,$E7,$6E00,$5D01,$5E02,$9103,$6204,$8F05,$6206,$F007,
35 $6009,$3710,$8911,$3312,$2F13,$0014,$3C15,$5C16,$E317),
36 {256X200} (8,256,200,$E3,$5F00,$3F01,$4202,$9F03,$4C04,$0005,$0014,$E317,
38 {256X224} (17,256,224,$E3,$5F00,$3F01,$4002,$8203,$4A04,$9A05,$0B06,$3E07,
39 $4109,$DA10,$9C11,$BF12,$2013,$0014,$C715,$0416,$E317),
40 {256X240} (16,256,240,$E3,$5F00,$3F01,$4202,$9F03,$4C04,$0005,$0D06,$3E07,
41 $4109,$EA10,$AC11,$DF12,$0014,$E715,$0616,$E317,0),
42 {256X256} (17,256,256,$E3,$5F00,$3F01,$4002,$8203,$4E04,$9A05,$2306,$B207,
43 $0008,$6109,$0A10,$AC11,$FF12,$4014,$0715,$1716,$A317));
46 VIRT = ARRAY[1..64000]OF BYTE; {TO_STORE_BITMAP_FILES}
47 VIRPTR = ^VIRT; {POINTER_TO_VIRTUAL}
48 PALETTE = ARRAY[0..255]OF RECORD R,G,B:BYTE; END; {TO_STORE_MCGA_PALETTE}
49 TSOUND = RECORD {USE_TO_STORE_SOUNDS}
50 DATA:POINTER; {POINTER_TO_THE_SND_DATA}
51 SIZE:WORD; {SIZE_OF_THE_SOUND_DATA}
54 VAR WIDTH:INTEGER; {WIDTH_GRAPHICAL_SCREEN}
55 VALID_OP_CODE:BOOLEAN; {USED_FOR_CHECKING_CPU}
56 MAXTIME:INTEGER; {TRIGGER_TIME}
57 BIOSTIMERHANDLER:PROCEDURE; {}
58 CLOCKTICKS:LONGINT; {TIMER_TICKS_EXPIRED}
59 TIMEEXPIRED:BOOLEAN; {TRUE_IF_TIME_HAS_EXPIRED}
61 FUNCTION FILEEXIST(FIS1:STRING):BOOLEAN;
65 FUNCTION MIN(MII1,MII2:INTEGER):INTEGER;
66 FUNCTION MAX(MAI1,MAI2:INTEGER):INTEGER;
67 FUNCTION ZERO(ZEF1:LONGINT;ZEI1:WORD):STRING;
68 FUNCTION POW(POI1:LONGINT;POI2:INTEGER):LONGINT;
69 FUNCTION FPR(FPR1:REAL;FPI1,FPI2:BYTE):STRING;
70 FUNCTION FP(FPR1:REAL;FPI1,FPI2:BYTE):STRING;
71 FUNCTION PSET(PSS1:STRING;PSI1:WORD):STRING;
72 FUNCTION DRPSET(PSS1:STRING;PSI1:WORD):STRING;
73 FUNCTION CC(CCC1:CHAR;CCI1:BYTE):STRING;
74 FUNCTION UPCS(UPS1:STRING):STRING;
75 FUNCTION LOCS(LOS1:STRING):STRING;
76 FUNCTION PARAMETER(PAS1:STRING):BOOLEAN;
78 FUNCTION SGN(SGN1:REAL):INTEGER;
79 FUNCTION COMP8088:BOOLEAN;
80 FUNCTION COMP80186:BOOLEAN;
81 FUNCTION COMP80286:BOOLEAN;
82 FUNCTION COMP80386:BOOLEAN;
83 FUNCTION COMP80486:BOOLEAN;
84 FUNCTION EMSTAT(VAR VERS:BYTE;VAR SIZE,FREE:WORD):BOOLEAN;
85 FUNCTION XMSTAT(VAR VERS:WORD;VAR SIZE,FREE:WORD):BOOLEAN;
86 PROCEDURE GETMOUSEPOS(VAR X,Y:WORD;VAR BUTTON1,BUTTON2:BOOLEAN);
87 PROCEDURE MOUSE(AI:WORD;VAR A,B,C,D:WORD);
88 FUNCTION BYTE2HEX(B:BYTE):STRING;
89 FUNCTION WORD2HEX(W:WORD):STRING;
90 FUNCTION DWORD2HEX(L:LONGINT):STRING;
91 PROCEDURE SETTIMER(TIMERHANDLER:POINTER;FREQUENCY:WORD);
92 PROCEDURE SHUTDOWNTIMER;
93 PROCEDURE TIMERHANDLER; INTERRUPT;
95 PROCEDURE SETVIDEO(X,Y:WORD);
96 PROCEDURE XMODE(MODE:BYTE);
97 PROCEDURE SETXVID(X,Y,COL:WORD);
101 FUNCTION TESTVESA(VAR X,Y:WORD):BOOLEAN;
102 FUNCTION TESTATI:BOOLEAN;
105 PROCEDURE CLS(COL:BYTE;WHERE:WORD);
106 PROCEDURE XCLS(COL:BYTE;WHERE:WORD);
107 PROCEDURE WAITRETRACE;
108 PROCEDURE SETPAL(COL,R,G,B:BYTE);
109 PROCEDURE GETPAL(COL:BYTE;VAR R,G,B:BYTE);
113 {PROCEDURE PUTPIXEL(X,Y:INTEGER;COL:BYTE;WHERE:WORD);{}
114 PROCEDURE PUTXPIX(X,Y:INTEGER;COL:BYTE);
115 PROCEDURE PUTPIX(X:INTEGER;COL:BYTE;WHERE:WORD);
116 PROCEDURE XPUTPIX(X:INTEGER;COL:BYTE);
117 FUNCTION GETPIXEL(X,Y:INTEGER;WHERE:WORD):BYTE;
118 FUNCTION GETXPIX(X,Y:INTEGER;WHERE:WORD):BYTE;
119 PROCEDURE BLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD);
120 PROCEDURE XBLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD);
121 PROCEDURE BAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE;WHERE:WORD);
122 PROCEDURE XBAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE);
123 PROCEDURE HLINE(X,XX,Y:INTEGER;COL:BYTE;WHERE:WORD);
124 PROCEDURE XHLINE(X,XX,Y:INTEGER;COL:BYTE);
125 PROCEDURE LINE(X,Y,XX,YY:INTEGER;COL:BYTE;WHERE:WORD);
126 PROCEDURE XLINE(X,Y,XX,YY:INTEGER;COL:BYTE);
127 PROCEDURE FLIP(SOURCE,DEST:WORD);
128 PROCEDURE FLIPSCR(SOURCE,DEST:WORD);
131 IMPLEMENTATION {THE_CODE}
133 FUNCTION FILEEXIST(FIS1:STRING):BOOLEAN;
135 BEGIN {DOES_FILE_EXISTS}
136 ASSIGN(FIF1,FIS1); {$I-} RESET(FIF1); CLOSE(FIF1); {$I+}
137 FILEEXIST:=(IORESULT=0)AND(FIS1<>'');
140 PROCEDURE COFF; ASSEMBLER;
142 { CAR1.AH:=1; CAR1.BH:=0; INTR($10,CAR1);
143 CAR1.AH:=3; CAR1.CH:=0; INTR($10,CAR1);}
154 BEGIN {CLEAR_ALL_KEYS}
155 WHILE KEYPRESSED DO CLC1:=READKEY;
158 FUNCTION KEY:INTEGER;
159 VAR KEC1:CHAR; KEC2:INTEGER;
162 IF KEYPRESSED THEN BEGIN
163 KEC1:=READKEY; KEC2:=ORD(KEC1);
164 IF KEC1=CHR(0)THEN BEGIN KEC1:=READKEY; KEC2:=ORD(KEC1)+256; END; {EXTENDED}
165 END; {KEY_IS_PRESSED}
169 FUNCTION MIN(MII1,MII2:INTEGER):INTEGER;
170 BEGIN {RETURN_SMALLEST_VALUE}
171 IF MII2<MII1 THEN MIN:=MII2 ELSE MIN:=MII1;
174 FUNCTION MAX(MAI1,MAI2:INTEGER):INTEGER;
175 BEGIN {RETURN_LARGEST_VALUE}
176 IF MAI2>MAI1 THEN MAX:=MAI2 ELSE MAX:=MAI1;
179 FUNCTION ZERO(ZEF1:LONGINT;ZEI1:WORD):STRING;
182 STR(ZEF1:0,ZES1); WHILE LENGTH(ZES1)<ZEI1 DO ZES1:='0'+ZES1;
186 FUNCTION POW(POI1:LONGINT;POI2:INTEGER):LONGINT;
187 VAR POI3:INTEGER; POI4:LONGINT;
189 POI4:=1; FOR POI3:=1TO POI2 DO POI4:=POI4*POI1; POW:=POI4;
192 FUNCTION FPR(FPR1:REAL;FPI1,FPI2:BYTE):STRING;
193 BEGIN {FLOATING_POINT_TO_STRING}
194 FPR:=ZERO(TRUNC(FPR1),FPI1)+'.'+ZERO(ROUND(FRAC(FPR1)*POW(10,FPI2)),FPI2);
197 FUNCTION FP(FPR1:REAL;FPI1,FPI2:BYTE):STRING;
198 BEGIN {FLOATING_POINT_TO_STRING}
199 FP:=ZERO(TRUNC(FPR1),FPI1)+'.'+ZERO(TRUNC(FRAC(FPR1)*POW(10,FPI2)),FPI2);
202 FUNCTION PSET(PSS1:STRING;PSI1:WORD):STRING;
204 IF(LENGTH(PSS1)>PSI1)AND(PSI1>3)THEN BEGIN
205 WHILE LENGTH(PSS1)>PSI1-3 DO DELETE(PSS1,LENGTH(PSS1),1);
211 FUNCTION DRPSET(PSS1:STRING;PSI1:WORD):STRING;
212 BEGIN {PLACE_DOTS_KEEP_DRIVE_LETTER}
213 IF LENGTH(PSS1)>PSI1 THEN BEGIN
214 INSERT('...',PSS1,4); WHILE LENGTH(PSS1)>PSI1 DO DELETE(PSS1,7,1);
219 FUNCTION CC(CCC1:CHAR;CCI1:BYTE):STRING;
220 VAR CCS1:STRING; CCI2:BYTE;
222 CCS1:=''; FOR CCI2:=1TO CCI1 DO CCS1:=CCS1+CCC1; CC:=CCS1;
225 FUNCTION UPCS(UPS1:STRING):STRING;
228 FOR UPI1:=1TO LENGTH(UPS1)DO UPS1[UPI1]:=UPCASE(UPS1[UPI1]); UPCS:=UPS1;
231 FUNCTION LOCS(LOS1:STRING):STRING;
234 FOR LOI1:=1TO LENGTH(LOS1)DO BEGIN
235 LOS1[LOI1]:=UPCASE(LOS1[LOI1]);
236 IF(LOS1[LOI1]>='A')AND(LOS1[LOI1]<='Z')THEN LOS1[LOI1]:=CHR(ORD(LOS1[LOI1])+32);
237 END; {MAKE LOWER CASE}
241 FUNCTION PARAMETER(PAS1:STRING):BOOLEAN;
242 VAR PAI1:INTEGER; PAS2:STRING;
245 IF PARAMCOUNT>0THEN FOR PAI1:=1TO PARAMCOUNT DO BEGIN
246 PAS2:=UPCS(PARAMSTR(PAI1));
247 IF(PAS2='/'+UPCS(PAS1))OR(PAS2='-'+UPCS(PAS1))OR(PAS2=UPCS(PAS1))
248 OR(PAS2='>'+UPCS(PAS1))THEN PARAMETER:=TRUE;
252 FUNCTION ACTIVE:BYTE; ASSEMBLER;
257 {Bits: $01=RSH $02=LSH $04=CTL $08=ALT $10=SCR $20=NUM $40=CAP $80=INS
258 Example: IF(ACTIVE AND$01<>0)THEN WRITELN('RIGHT SHIFT PRESSED');}
261 FUNCTION SGN(SGN1:REAL):INTEGER;
263 IF SGN1>0THEN SGN:=1 ELSE IF SGN1<0THEN SGN:=-1 ELSE SGN:=0;
266 PROCEDURE INTR6HANDLER; INTERRUPT;
268 VALID_OP_CODE:=FALSE;
269 ASM ADD WORD PTR SS:[BP+18],3 END; {A_SINGLE_ASSEMBLER_CODE}
272 FUNCTION COMP8088:BOOLEAN; ASSEMBLER;
273 ASM {RETURNS_TRUE_IF_8088_COMPATIBLE_FOUND}
284 FUNCTION COMP80186:BOOLEAN;
287 IF COMP8088 THEN COMP80186:=FALSE ELSE BEGIN
290 SETINTVEC(6,ADDR(INTR6HANDLER));
291 INLINE($C1/$E2/$05); {SHL DX,5}
293 COMP80186 :=VALID_OP_CODE;
297 FUNCTION COMP80286:BOOLEAN; ASSEMBLER;
298 ASM {RETURNS_TRUE_IF_COMPUTER_IS_286_COMPATIBLE}
314 FUNCTION COMP80386:BOOLEAN;
316 BEGIN {RETURNS_TRUE_IF_COMPUTER_IS_80386_COMPATIBLE}
317 IF NOT COMP8088 THEN COMP80386:=FALSE ELSE BEGIN
320 SETINTVEC(6,ADDR(INTR6HANDLER));
321 INLINE($0F/$20/$C2); {MOV EDX,CR0}
323 COMP80386:=VALID_OP_CODE;
324 END; {8088_COMPATIBLE>RUN_TEST}
327 FUNCTION COMP80486:BOOLEAN;
329 BEGIN {RETURNS_TRUE_IF_CPU_IS_80486_COMPATIBLE}
330 IF NOT COMP8088 THEN COMP80486:=FALSE ELSE BEGIN
333 SETINTVEC(6,ADDR(INTR6HANDLER));
334 INLINE($0F/$C1/$D2); {XADD DX,DX}
336 COMP80486:=VALID_OP_CODE;
337 END; {8088_COMPATIBLE>RUN_TEST}
340 FUNCTION EMSTAT(VAR VERS:BYTE;VAR SIZE,FREE:WORD):BOOLEAN;
341 TYPE ARTYPE=ARRAY[1..8]OF CHAR;
344 BEGIN {RETURN_EMS_STATS}
345 EMSTAT:=FALSE; GETINTVEC($67,POINTER(P)); P:=PTR(SEG(P^),$0A);
346 IF P^='EMMXXXX0'THEN BEGIN
347 REG.AH:=$40; INTR($67,REG);
348 IF REG.AH<>0THEN HALT ELSE BEGIN
349 REG.AH:=$46; INTR($67,REG); IF REG.AH<>0THEN HALT;
350 VERS:=REG.AL; {VERSION_IS_(REG.AL SHR 4).(REG.AL AND $F)}
351 REG.AH:=$42; INTR($67,REG); IF REG.AH<>0THEN HALT;
352 SIZE:=REG.DX; FREE:=REG.BX; {SIZE_UNIT_IS_64_BYTES_OR_(2^4)_KB}
358 FUNCTION XMSTAT(VAR VERS:WORD;VAR SIZE,FREE:WORD):BOOLEAN;
363 XMSTAT:=FALSE; REG.AX:=$4300; INTR($2F,REG);
364 IF REG.AL=$80THEN BEGIN
366 ASM {GET_VERSION_NUMBER}
370 MOV WORD PTR [P+2],ES
379 PROCEDURE GETMOUSEPOS(VAR X,Y:WORD;VAR BUTTON1,BUTTON2:BOOLEAN);
381 BEGIN {RETURNS_POSITION_OF_MOUSE_AND_PRESS-STATUS_OF_BUTTONS}
382 REGS.AX:=3; INTR(MOUSEINTR,REGS); X:=REGS.CX; Y:=REGS.DX;
383 BUTTON1:=(REGS.BX AND 1)<>0; BUTTON2:=(REGS.BX AND 2)<>0;
386 PROCEDURE MOUSE(AI:WORD;VAR A,B,C,D:WORD);
387 VAR AA,BB,CC,DD:WORD;
401 A:=AA; B:=BB; C:=CC; D:=DD;
404 PROCEDURE _HEXBYTE; ASSEMBLER;
405 ASM {USED_FOR_HEX_CONVERT_FUNCTIONS_BELOW}
421 FUNCTION BYTE2HEX(B:BYTE):STRING; ASSEMBLER;
422 ASM {CONVERTS_A_HEX_REPRESENTATION_OF_THE_BYTE_INTO_A_STRING}
431 FUNCTION WORD2HEX(W:WORD):STRING; ASSEMBLER;
432 ASM {CONVERT_THE_HEXADECIMAL_VALUE_OF_A_WORD_TO_A_STRING}
447 FUNCTION DWORD2HEX(L:LONGINT):STRING; ASSEMBLER;
448 ASM {CONVERTS_A_LONGINT_HEX_VALUE_INTO_A_STRING}
471 PROCEDURE SETTIMER(TIMERHANDLER:POINTER;FREQUENCY:WORD);
474 CLOCKTICKS:=0; TIMEEXPIRED:=FALSE; COUNTER:=$1234DD DIV FREQUENCY; {@INIT}
475 GETINTVEC(TIMERINTR,@BIOSTIMERHANDLER); SETINTVEC(TIMERINTR,TIMERHANDLER);
476 PORT[$43]:=$34; PORT[$40]:=COUNTER MOD 256; PORT[$40]:=COUNTER SHR 8;
479 PROCEDURE SHUTDOWNTIMER;
480 BEGIN {RESTORE_EVERYTHING_AS_IT_WAS}
481 PORT[$43]:=$34; PORT[$40]:=$00; PORT[$40]:=$00; {@RESTORE_NORMAL_CLOCK_FREQUENCY}
482 SETINTVEC(TIMERINTR,@BIOSTIMERHANDLER); {RESTORE_NORMAL_TICKER_HANDLER}
485 PROCEDURE TIMERHANDLER;
488 IF CLOCKTICKS>=MAXTIME THEN BEGIN
489 TIMEEXPIRED:=TRUE; CLOCKTICKS:=0;
490 ASM PUSHF END; {PUSH_ALL_VALUES} BIOSTIMERHANDLER;
491 END {TIME_EXPIRED} ELSE PORT[$20]:=$20; {@ACKNOWLEDGE_THE_INTERRUPT}
495 PROCEDURE SETVIDEO(X,Y:WORD); ASSEMBLER;
496 ASM {SET_CUSTOM_VIDEO_MODE}
502 PROCEDURE XMODE(MODE:BYTE);
508 END; {GET_INTO_MCGA_MODE}
509 PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]OR$20; PORTW[$03C4]:=$0604;
510 IF MODESETS[MODE,3]<>0THEN PORT[$03C2]:=BYTE(MODESETS[MODE,3]);
511 FOR MTEMP:=4TO MODESETS[MODE,0]+3DO PORTW[$03D4]:=MODESETS[MODE,MTEMP];
512 WIDTH:=MODESETS[MODE,1]SHR 2; PORTW[$03C4]:=$0F02;
513 FILLCHAR(MEM[$A000:0],$8000,0); FILLCHAR(MEM[$A000:$8000],$8000,0);
514 DELAY(100); PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]AND$DF;
517 PROCEDURE SETXVID(X,Y,COL:WORD);
518 BEGIN {SET_CUSTON_UNCHAINED_VIDEO_MODE}
524 PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]OR$20; {@TURN_VGA_SCREEN_OFF}
525 PORTW[$03C4]:=$0604; {@TURN_OFF_CHAIN-4_BIT}
526 PORTW[$03D4]:=$E317; {@TURN_OFF_WORD_MODE}
527 PORTW[$03D4]:=$0014; {@TURN_OFF_DOUBLEWORD_MODE}
528 PORTW[$03D4]:=$000C; PORTW[$03D4]:=$000D; {@OFFSET}
529 PORTW[$03C4]:=$0F02; {@CLEAR_ENTIRE_VIDEO_MEMORY}
530 FILLCHAR(MEM[$A000:1],$FFFF,0); MEM[$A000:0]:=0;
531 WIDTH:=COL SHR 2; DELAY(100); {@GIVE_A_SMALL_DELAY}
532 PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]AND$DF; {@TURN_SCREEN_BACK_ON}
536 BEGIN {SETS_VIDEO_TO_NORMAL_320x200x256}
540 END; {ASSEMBLER_TRICK}
541 PORTW[$03C4]:=$0A04; {@TURN_OFF_CHAIN-4_BIT}
544 PROCEDURE SETVGA; ASSEMBLER;
545 ASM {SET_SCREEN_MODE_TO_640x480x256}
551 PROCEDURE SETTEXT; ASSEMBLER;
552 ASM {SET_SCREEN_MODE_TO_TEXT}
557 FUNCTION TESTVESA(VAR X,Y:WORD):BOOLEAN;
558 TYPE ARTYPE=ARRAY[0..255]OF BYTE;
561 BEGIN {RETURNS_PRESENT_VESA_CARD_VERSION_IF_PRESENT}
562 TESTVESA:=FALSE; GETMEM(P,SIZEOF(P)); X:=0;
563 R.AH:=$4F; R.AL:=$00; R.ES:=SEG(P^); R.DI:=OFS(P^); INTR($10,R);
564 IF(R.AX=$004F)AND(P^[0]=ORD('V'))AND(P^[1]=ORD('E'))AND(P^[2]=ORD('S'))
565 AND(P^[3]=ORD('A'))THEN BEGIN
566 TESTVESA:=TRUE; X:=P^[5]*$100+P^[4]; END; {FOUND}
567 FREEMEM(P,SIZEOF(P));
570 FUNCTION TESTATI:BOOLEAN;
572 BEGIN {RETURNS_TRUE_IF_ATI_VIDEO_CARD_IS_PRESENT}
573 MOVE(MEM[$C000:$0031],P,9);
574 IF P='761295520'THEN TESTATI:=TRUE ELSE TESTATI:=FALSE;
579 PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]OR$20;
584 PORT[$03C4]:=1; PORT[$03C5]:=PORT[$03C5]AND$DF;
587 PROCEDURE CLS(COL:BYTE;WHERE:WORD);
588 BEGIN {CLEARS_SCREEN_TO_ONE_COLOR}
589 FILLCHAR(MEM[WHERE:0],64000,COL);
592 PROCEDURE XCLS(COL:BYTE;WHERE:WORD);
593 BEGIN {CLEARS_THE_UNCHAINED_SCREEN_TO_A_SINGLE_COLOR}
594 PORTW[$03C4]:=$0F02; FILLCHAR(MEM[WHERE:0],64000,COL);
597 PROCEDURE WAITRETRACE;ASSEMBLER;
598 ASM {WAIT_FOR_A_VERTICAL_SCREEN_RETRACE}
610 PROCEDURE SETPAL(COL,R,G,B:BYTE); ASSEMBLER;
611 ASM {SET_A_PALETTE_COLOR}
624 PROCEDURE GETPAL(COL:BYTE;VAR R,G,B:BYTE);
626 BEGIN {GET_A_PALETTE_COLOR}
645 BEGIN {FADE_OUT_COLOR_SEVEN}
648 WAITRETRACE; IF G>0THEN DEC(G); IF B>0THEN DEC(B); IF R>0THEN DEC(R);
650 UNTIL R+G+B<3; {FADE_TO_BLACK}
654 VAR FADETEMP,FADECTEMP:INTEGER;
655 FADETMP,FADETMP2:ARRAY[1..3]OF BYTE;
656 FADECOL:ARRAY[1..255,1..3]OF BYTE;
657 FADECOLI:ARRAY[1..255,1..3]OF REAL;
658 BEGIN {NATURALLY_FADES_OUT_THE_256_COLOR_PALETTE}
659 FOR FADECTEMP:=1TO 255DO BEGIN
660 GETPAL(FADECTEMP,FADECOL[FADECTEMP,1],FADECOL[FADECTEMP,2],FADECOL[FADECTEMP,3]);
661 FADECOLI[FADECTEMP,1]:=FADECOL[FADECTEMP,1]/32;
662 FADECOLI[FADECTEMP,2]:=FADECOL[FADECTEMP,2]/32;
663 FADECOLI[FADECTEMP,3]:=FADECOL[FADECTEMP,3]/32;
664 END; {CALCULATE_STEPS_FOR_EACH_COLOR}
665 FOR FADETEMP:=0TO 31DO BEGIN
666 REPEAT UNTIL TIMEEXPIRED; TIMEEXPIRED:=FALSE;
667 FOR FADECTEMP:=1TO 255DO BEGIN
668 SETPAL(FADECTEMP,FADECOL[FADECTEMP,1]-ROUND(FADECOLI[FADECTEMP,1]*FADETEMP),
669 FADECOL[FADECTEMP,2]-ROUND(FADECOLI[FADECTEMP,2]*FADETEMP),
670 FADECOL[FADECTEMP,3]-ROUND(FADECOLI[FADECTEMP,3]*FADETEMP));
671 END; {CHANGE_ALL_COLORS}
672 END; {FADE_OUT_ALL_COLORS}
673 WAITRETRACE; FOR FADECTEMP:=1TO 255DO SETPAL(FADECTEMP,0,0,0);
677 VAR FADETEMP,FADECTEMP:INTEGER;
678 FADETMP:ARRAY[1..3]OF BYTE;
679 BEGIN {FADE_ALL_256_COLORS_BY_DECREASING_THEM_UNTIL_THEY_REACH_ZERO}
680 FOR FADETEMP:=0TO 63DO BEGIN
681 REPEAT UNTIL TIMEEXPIRED; TIMEEXPIRED:=FALSE;
682 FOR FADECTEMP:=1TO 255DO BEGIN
683 GETPAL(FADECTEMP,FADETMP[1],FADETMP[2],FADETMP[3]);
684 IF FADETMP[1]>0THEN DEC(FADETMP[1]);
685 IF FADETMP[2]>0THEN DEC(FADETMP[2]);
686 IF FADETMP[3]>0THEN DEC(FADETMP[3]);
687 SETPAL(FADECTEMP,FADETMP[1],FADETMP[2],FADETMP[3]);
688 END; {CHANGE_ALL_COLORS}
689 END; {FADE_OUT_ALL_COLORS}
692 PROCEDURE PUTPIXEL(X,Y:INTEGER;COL:BYTE;WHERE:WORD);
693 BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN}
706 END; {ASSEMBLER_VERSION}
709 PROCEDURE PUTXPIX(X,Y:INTEGER;COL:BYTE);
710 BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN}
711 PORTW[$03C4]:=$100SHL(X AND 3)+2; {@SET_MAP_MASK_TO_SELECT_PROPER_PLANE}
712 MEM[VGA:Y*WIDTH+X SHR 2]:=COL;
733 PROCEDURE PUTPIX(X:INTEGER;COL:BYTE;WHERE:WORD); ASSEMBLER;
734 ASM {DISPLAYS_A_PIXEL_AT_PRECALCULATED_COORDINATES}
743 PROCEDURE XPUTPIX(X:INTEGER;COL:BYTE);
744 BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN}
745 PORTW[$03C4]:=$100SHL(X AND 3)+2; {@SET_MAP_MASK_TO_SELECT_PROPER_PLANE}
746 MEM[VGA:X SHR 2]:=COL;
749 FUNCTION GETPIXEL(X,Y:INTEGER;WHERE:WORD):BYTE; ASSEMBLER;
750 ASM {GET_A_PIXEL_FROM_A_CHAINED_SCREEN}
764 FUNCTION GETXPIX(X,Y:INTEGER;WHERE:WORD):BYTE;
765 BEGIN {PUTS_A_PIXEL_AT_PX,PY_COLOR_PCOL_ON_VGA_OR_VIRTUAL_SCREEN}
767 PORT[$03CF]:=X AND 3;
768 GETXPIX:=MEM[WHERE:WIDTH*Y+X SHR 2];
771 PROCEDURE BLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD);
772 VAR BLB1,BLB2:INTEGER;
773 BEGIN {DRAW_A_BAR_WITH_COLOR_ZERO}
774 FOR BLB1:=Y1 TO Y2 DO FOR BLB2:=X1 TO X2 DO
775 PUTPIXEL(BLB2,BLB1,0,WHERE);
778 PROCEDURE XBLACKBAR(X1,Y1,X2,Y2:INTEGER;WHERE:WORD);
779 VAR BLB1,BLB2:INTEGER;
781 FOR BLB1:=Y1 TO Y2 DO FOR BLB2:=X1 TO X2 DO
782 PUTXPIX(BLB2,BLB1,0);
785 PROCEDURE BAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE;WHERE:WORD);
787 BEGIN {DRAWS_A_BAR_WITH_SPECIFIED_COLOR}
788 FOR BLB1:=Y1 TO Y2 DO HLINE(X1,X2,BLB1,COL,WHERE);
791 PROCEDURE XBAR(X1,Y1,X2,Y2:INTEGER;COL:BYTE);
792 VAR BLB1,BLB2:INTEGER;
794 FOR BLB1:=Y1 TO Y2 DO XHLINE(X1,X2,BLB1,COL);
797 PROCEDURE HLINE(X,XX,Y:INTEGER;COL:BYTE;WHERE:WORD); ASSEMBLER;
798 ASM {DRAWS_A_HORIZONTAL_LINE}
818 PROCEDURE XHLINE(X,XX,Y:INTEGER;COL:BYTE);
820 BEGIN {DRAWS_A_HORIZONTAL_LINE_FROM_(X,Y)_TO_(XX,Y)_AT_COLOR_PCOL_ON_VGA}
821 FOR I:=X TO XX DO PUTXPIX(I,Y,COL);
824 PROCEDURE LINE(X,Y,XX,YY:INTEGER;COL:BYTE;WHERE:WORD);
825 VAR LINE1,LINE2,SX,SY,SXY,SYX,DX1,DX2,DY1,DY2:INTEGER;
826 BEGIN {JUST_A_SIMPLE_LINE_PROCEDURE}
827 SX:=XX-X; SY:=YY-Y; DX1:=SGN(SX); DX2:=DX1; DY1:=SGN(SY); DY2:=0;
828 SXY:=ABS(SX); SYX:=ABS(SY);
829 IF SYX>SXY THEN BEGIN
830 DY2:=DY1; DX2:=0; LINE1:=SXY; SXY:=SYX; SYX:=LINE1;
833 FOR LINE2:=0TO SXY DO BEGIN
834 PUTPIXEL(X,Y,COL,WHERE);
836 IF LINE1<SXY THEN BEGIN
837 INC(X,DX2); INC(Y,DY2);
838 END {STRAIGT_AHEAD} ELSE BEGIN
840 INC(X,DX1); INC(Y,DY1);
845 PROCEDURE XLINE(X,Y,XX,YY:INTEGER;COL:BYTE);
846 VAR LINE1,LINE2,SX,SY,SXY,SYX,DX1,DX2,DY1,DY2:INTEGER;
848 SX:=XX-X; SY:=YY-Y; DX1:=SGN(SX); DX2:=DX1; DY1:=SGN(SY); DY2:=0;
849 SXY:=ABS(SX); SYX:=ABS(SY);
850 IF SYX>SXY THEN BEGIN
851 DY2:=DY1; DX2:=0; LINE1:=SXY; SXY:=SYX; SYX:=LINE1;
854 FOR LINE2:=0TO SXY DO BEGIN
857 IF LINE1<SXY THEN BEGIN
858 INC(X,DX2); INC(Y,DY2);
859 END {STRAIGT_AHEAD} ELSE BEGIN
861 INC(X,DX1); INC(Y,DY1);
866 PROCEDURE FLIP(SOURCE,DEST:WORD); ASSEMBLER;
867 ASM {FLIPS_AN_MCGA_SCREEN_FROM_SOURCE_TO_DEST}
880 PROCEDURE FLIPSCR(SOURCE,DEST:WORD); ASSEMBLER;
881 ASM {FLIPS_A_PART_OF_AN_MCGA_SCREEN_FROM_SOURCE_TO_DEST}
895 END. {THAT'S_ALL_FOLKS!}