1 { ModeX Turbo Pascal Demo Program }
\r
2 { Converted to Turbo Pascal by Scott Wyatt }
\r
3 { Original program written in QuickBasic by Matt Prichard }
\r
4 { Released to the Public Domain }
\r
6 { Thanks to Matt Prichard for his *EXCELLENT* ModeX Library }
\r
7 { Additional Comments by Matt Pritchard }
\r
11 {$L modex2.obj} { This file is the external ModeX Library .OBJ }
\r
14 { Mode Setting Routines }
\r
16 Function SET_VGA_MODEX (Mode,MaxXpos,MaxYpos,Pages : integer) : integer; external;
\r
17 Function SET_MODEX (Mode:integer) : Integer; external;
\r
19 { Graphics Primitives }
\r
21 Procedure CLEAR_VGA_SCREEN (Color:integer); external;
\r
22 Procedure SET_POINT (Xpos,Ypos,Color : integer); external;
\r
23 Function READ_POINT (Xpos,Ypos:integer) : integer; external;
\r
24 Procedure FILL_BLOCK (Xpos1,Ypos1,Xpos2,Ypos2,Color:integer); external;
\r
25 Procedure DRAW_LINE (Xpos1,Ypos1,Xpos2,Ypos2,Color:integer); external;
\r
27 { VGA DAC Routines }
\r
29 Procedure SET_DAC_REGISTER (RegNo,Red,Green,Blue:integer); external;
\r
30 Procedure GET_DAC_REGISTER (RegNo,Red,Green,Blue:integer); external;
\r
32 { Page and Window Control Routines }
\r
34 Procedure SET_ACTIVE_PAGE (PageNo:integer); external;
\r
35 Function GET_ACTIVE_PAGE : integer; external;
\r
36 Procedure SET_DISPLAY_PAGE (PageNo:integer); external;
\r
37 Function GET_DISPLAY_PAGE : integer; external;
\r
38 Procedure SET_WINDOW (DisplayPage,XOffset,YOffset : integer); external;
\r
39 Function GET_X_OFFSET : integer; external;
\r
40 Function GET_Y_OFFSET : integer; external;
\r
41 Procedure SYNC_DISPLAY; external;
\r
43 { Text Display Routines }
\r
45 Procedure GPRINTC (CharNum,Xpos,Ypos,ColorF,ColorB:integer); external;
\r
46 Procedure TGPRINTC ( CharNum,Xpos,Ypos,ColorF : integer); external;
\r
47 Procedure PRINT_STR (Var Text;MaxLen,Xpos,Ypos,ColorF,ColorB:integer); external;
\r
48 Procedure TPRINT_STR (Var Text;MaxLen,Xpos,Ypos,ColorF:integer); external;
\r
49 Procedure SET_DISPLAY_FONT (Var FontData;FontNumber:integer); external;
\r
51 { Sprite and VGA memory -> Vga memory Copy Routines }
\r
53 Procedure DRAW_BITMAP (Var Image;Xpos,Ypos,Width,Height:integer); external;
\r
54 Procedure TDRAW_BITMAP (Var Image;Xpos,Ypos,Width,Height:integer); external;
\r
55 Procedure COPY_PAGE (SourcePage,DestPage:integer); external;
\r
56 Procedure COPY_BITMAP (SourcePage,X1,Y1,X2,Y2,DestPage,DestX1,DestY1:integer); external;
\r
61 TYPE Sprite = Record
\r
72 CONST MaxShapes = 32;
\r
73 Circle_16 : Array[1..16,1..16] of byte =
\r
74 (( 0, 0, 0, 0, 0, 0, 20, 20, 20, 20, 0, 0, 0, 0, 0, 0),
\r
75 ( 0, 0, 0, 0, 20, 20, 20, 20, 20, 20, 20, 20, 0, 0, 0, 0),
\r
76 ( 0, 0, 0, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 0, 0, 0),
\r
77 ( 0, 0, 20, 20, 20, 20, 0, 0, 0, 0, 20, 20, 20, 20, 0, 0),
\r
78 ( 0, 20, 20, 20, 20, 0, 0, 0, 0, 0, 0, 20, 20, 20, 20, 0),
\r
79 ( 0, 20, 20, 20, 0, 0, 0, 0, 0, 0, 0, 0, 20, 20, 20, 0),
\r
80 ( 20, 20, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 20, 20),
\r
81 ( 20, 20, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 20, 20),
\r
82 ( 20, 20, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 20, 20),
\r
83 ( 20, 20, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 20, 20),
\r
84 ( 0, 20, 20, 20, 0, 0, 0, 0, 0, 0, 0, 0, 20, 20, 20, 0),
\r
85 ( 0, 20, 20, 20, 20, 0, 0, 0, 0, 0, 0, 20, 20, 20, 20, 0),
\r
86 ( 0, 0, 20, 20, 20, 20, 0, 0, 0, 0, 20, 20, 20, 20, 0, 0),
\r
87 ( 0, 0, 0, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 0, 0, 0),
\r
88 ( 0, 0, 0, 0, 20, 20, 20, 20, 20, 20, 20, 20, 0, 0, 0, 0),
\r
89 ( 0, 0, 0, 0, 0, 0, 20, 20, 20, 20, 0, 0, 0, 0, 0, 0));
\r
90 Square_16 : Array[1..16,1..16] of byte =
\r
91 (( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
92 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
93 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
94 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
95 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
96 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
97 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
98 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
99 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
100 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
101 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
102 ( 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21),
\r
103 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
104 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
105 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
\r
106 ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21));
\r
107 Diamond : Array[1..8,1..8] of byte =
\r
108 (( 0, 0, 0, 22, 22, 0, 0, 0),
\r
109 ( 0, 0, 22, 22, 22, 22, 0, 0),
\r
110 ( 0, 22, 22, 0, 0, 22, 22, 0),
\r
111 ( 22, 22, 0, 0, 0, 0, 22, 22),
\r
112 ( 22, 22, 0, 0, 0, 0, 22, 22),
\r
113 ( 0, 22, 22, 0, 0, 22, 22, 0),
\r
114 ( 0, 0, 22, 22, 22, 22, 0, 0),
\r
115 ( 0, 0, 0, 22, 22, 0, 0, 0));
\r
116 Rectangle : Array[1..8,1..3] of byte =
\r
126 { Global Variables ? }
\r
129 XCenter,X1,Y1,X2,Y2,Z,Colr,XChars,YChars,X,Y,N,Gap : Integer;
\r
131 s1 : Array[1..35] of Char;
\r
133 obj : Array[1..64] of Sprite;
\r
134 ScreenX,ScreenY : Integer;
\r
135 c, dc, SpriteX, SpriteY, CurrentPage, LastPage : Integer;
\r
136 SetColor, SDir, PrevColor, PDir : Byte;
\r
137 XView, YView : Integer;
\r
138 XView_Change, YView_Change : Integer;
\r
140 Number_Of_Shapes : Byte;
\r
143 { Error Handler - Returns to Text Mode & Displays Error }
\r
145 Procedure ERROR_OUT(s : string);
\r
156 { Routine to Print a PASCAL string using Print_Str }
\r
158 Procedure Print_Text(s : string; X,Y,BColor,FColor : integer);
\r
160 s1 : Array[1..135] of Char;
\r
163 For i := 1 to Length(s) DO
\r
165 Print_Str(s1,Length(s),X,Y,BColor,FColor);
\r
168 { Routine to Transparently Print a PASCAL string using TPrint_Str }
\r
170 Procedure TPrint_Text(s : string; X,Y,Color : integer);
\r
172 s1 : Array[1..135] of Char;
\r
175 For i := 1 to Length(s) DO
\r
177 TPrint_Str(s1,Length(s),X,Y,Color);
\r
180 { Routines to show test patterns for a given mode }
\r
182 Procedure Demo_Res(Mode, Xmax, Ymax : integer);
\r
186 If Set_ModeX(Mode) = 0 Then
\r
187 Error_Out('Unable to SET_MODEX '+s);
\r
188 Clear_VGA_Screen(0);
\r
190 XCenter := Xmax div 2;
\r
198 Colr := 31 - Z * 2;
\r
199 Draw_Line(X1 + Z, Y1 + Z, X2 - Z, Y1 + Z, Colr);
\r
200 Draw_Line(X1 + Z, Y1 + Z, X1 + Z, Y2 - Z, Colr);
\r
201 Draw_Line(X1 + Z, Y2 - Z, X2 - Z, Y2 - Z, Colr);
\r
202 Draw_Line(X2 - Z, Y1 + Z, X2 - Z, Y2 - Z, Colr);
\r
205 XChars := Xmax div 10;
\r
206 YChars := Ymax div 10;
\r
208 FOR X := 0 TO XChars - 1 DO
\r
210 TGPRINTC(48 + ((X + 1) MOD 10), X * 10 + 1, 1, 9 + ((X div 8) MOD 7));
\r
211 DRAW_LINE(X * 10 + 9, 0, X * 10 + 9, 3, 15);
\r
213 FOR Y := 0 TO YChars - 1 DO
\r
215 TGPRINTC(48 + ((Y + 1) MOD 10), 1, Y * 10 + 1, 9 + ((Y div 10) MOD 7));
\r
216 DRAW_LINE(0, Y * 10 + 9, 3, Y * 10 + 9, 15);
\r
219 { Test Line Drawing }
\r
221 FOR X := 0 TO 63 DO
\r
223 N := 15 + ((X * 3) div 4);
\r
224 SET_DAC_REGISTER(64 + X, N, N, N);
\r
225 SET_DAC_REGISTER(128 + X, 0, N, N);
\r
226 DRAW_LINE(103 - X, 60, 40 + X, 123, 64 + X);
\r
227 DRAW_LINE(40, 60 + X, 103, 123 - X, 128 + X);
\r
230 PRINT_Text(s,37,130,1,0);
\r
232 { Test Block Fills }
\r
238 FILL_BLOCK(120, Y, 120 + X, Y + Gap, 64 + X);
\r
239 FILL_BLOCK(140 - (15 - X), Y, 150 + X, Y + Gap, 230 + X);
\r
240 FILL_BLOCK(170 - (15 - X), Y, 170, Y + Gap, 128 + X);
\r
245 Print_Text(s,110, 46, 2,0);
\r
247 { Test Pixel Write and Read }
\r
249 FOR X := 190 TO 250 DO
\r
250 FOR Y := 60 TO 122 DO
\r
251 SET_POINT( X, Y, X + Y + X + Y);
\r
254 Print_Text(s,182, 130, 3,0);
\r
256 FOR X := 190 TO 250 DO
\r
257 FOR Y := 60 TO 122 DO
\r
258 IF READ_POINT(X, Y) <> ((X + Y + X + Y) AND 255) THEN
\r
259 WriteLn('READ_PIXEL Failure');
\r
261 { Display rest of screen }
\r
263 s := ' This is a MODE X demo ';
\r
264 Print_Text(s,XCenter - (Length(s) * 4), 20, 3, 1);
\r
265 s := 'Screen Resolution is by ';
\r
266 X := XCenter - (Length(s) * 4);
\r
267 Print_Text(s,X,30,4,0);
\r
269 Print_Text(s, X + 8 * 21, 30, 8, 0);
\r
271 Print_Text(s, X + 8 * 28, 30, 15, 0);
\r
273 FOR X := 0 TO 15 DO
\r
275 SET_DAC_REGISTER( 230 + X, 63 - X * 4, 0, 15 + X * 3);
\r
276 DRAW_LINE(30 + X, Ymax - 6 - X, Xmax - 20 - X, Ymax - 6 - X, 230 + X);
\r
278 s := 'Press <ANY KEY> to Continue';
\r
279 For x := 1 to length(s) DO
\r
281 TPrint_Str(s1, length(s), XCenter - (26 * 4), Ymax - 18, 5);
\r
285 Error_Out('Abort');
\r
290 { Initialize Sprites for Sprite Demo }
\r
292 Procedure Init_Sprites;
\r
295 For i := 1 to 64 DO
\r
297 Obj[i].XPos := Random(300)+10;
\r
298 Obj[i].YPos := Random(200)+20;
\r
299 Obj[i].XDir := Random(10)-5;
\r
300 Obj[i].YDir := Random(10)-5;
\r
301 If (Obj[i].XDir = 0) AND (Obj[i].YDir = 0) Then
\r
303 Obj[i].XDir := Random(5) + 1;
\r
304 Obj[i].YDir := Random(5) + 1;
\r
306 Obj[i].Shape := Random(4)+1;
\r
307 Obj[i].LastX := obj[i].XPos;
\r
308 Obj[i].LastY := obj[i].YPos;
\r
312 Procedure Set_Sprites(number : byte);
\r
315 For i := 1 to number DO
\r
317 obj[i].LastX := obj[i].XPos;
\r
318 obj[i].LastY := obj[i].YPos;
\r
319 obj[i].XPos := obj[i].XPos + obj[i].XDir;
\r
320 obj[i].YPos := obj[i].YPos + obj[i].YDir;
\r
321 If (obj[i].XPos > 335) OR (obj[i].XPos < 5 ) Then
\r
322 obj[i].XDir := -(obj[i].XDir);
\r
323 If (obj[i].YPos > 220) OR (obj[i].YPos < 5) Then
\r
324 obj[i].YDir := -(obj[i].YDir);
\r
326 For i := 1 to number DO
\r
327 Case obj[i].Shape of
\r
328 1 : TDraw_Bitmap(Circle_16,obj[i].XPos,obj[i].YPos,16,16);
\r
329 2 : TDraw_Bitmap(Square_16,obj[i].XPos,obj[i].YPos,16,16);
\r
330 3 : TDraw_Bitmap(Diamond,obj[i].XPos,obj[i].YPos,8,8);
\r
331 4 : TDraw_Bitmap(Rectangle,obj[i].XPos,obj[i].YPos,3,8);
\r
335 Procedure Remove_Sprites(p,number : byte);
\r
338 For i := 1 to number DO
\r
339 Copy_Bitmap(2,obj[i].LastX,obj[i].LastY,obj[i].LastX+16,obj[i].LastY+16,p,Obj[i].LastX,Obj[i].LastY);
\r
342 Procedure Page_Demo;
\r
344 Number_Of_Shapes := 64;
\r
358 IF SET_VGA_MODEX(0, ScreenX, ScreenY, 3) = 0 THEN
\r
359 ERROR_OUT('Unable to SET_VGA_MODEX' + S);
\r
361 SET_ACTIVE_PAGE(0);
\r
362 CLEAR_VGA_SCREEN(0);
\r
363 PRINT_TEXT('This is a Test of the Following Functions:', 10, 9, 15, 0);
\r
364 DRAW_LINE( 10, 18, 350, 18, 4);
\r
365 Print_Text('SET_ACTIVE_PAGE', 10, 20, 1, 0);
\r
366 Print_Text('SET_DISPLAY_PAGE', 10, 30, 3,0);
\r
367 Print_Text('SET_DAC_REGISTER', 10, 40, 3, 0);
\r
368 Print_Text('CLEAR_VGA_SCREEN', 10, 50, 13, 0);
\r
369 Print_Text('TDRAW_BITMAP', 10, 60, 14, 0);
\r
370 Print_Text('COPY_PAGE', 10, 70, 3, 0);
\r
371 Print_Text('COPY_BITMAP', 10, 80, 13, 0);
\r
372 Print_Text('GPRINTC', 10, 90, 1, 0);
\r
373 Print_Text('TGPRINTC', 10, 100, 3, 0);
\r
374 Print_Text('SYNC_DISPLAY', 10, 110, 3, 0);
\r
375 Print_Text('SET_WINDOW', 10, 120, 14, 0);
\r
376 Print_Text('VIRTUAL SCREEN SIZES', 190, 20, 1, 0);
\r
377 Print_Text(' SMOOTH SCROLLING', 190, 30, 3, 0);
\r
378 Print_Text(' SPRITE ANIMATION', 190, 40, 13, 0);
\r
379 Print_Text(' PAGE FLIPPING', 190, 50, 3, 0);
\r
380 Print_Text(' COLOR CYCLING', 190, 60, 14, 0);
\r
382 FOR X := 0 TO 60 DO
\r
384 SET_DAC_REGISTER( 50 + X, 3 + X, 0, 60 - X);
\r
385 SET_DAC_REGISTER( 150 + X, 3 + X, 0, 60 - X);
\r
390 FOR X := 0 TO ScreenX div 2 DO
\r
392 DRAW_LINE( ScreenX div 2 - 1, ScreenY div 4, X, ScreenY - 1, c + 50);
\r
393 DRAW_LINE( ScreenX div 2, ScreenY div 4, ScreenX - X - 1, ScreenY - 1, c + 50);
\r
395 IF (c = 0) OR (c = 60) THEN DC := -DC;
\r
398 TPrint_Text('Press <ESC> to Continue', 82, 190, 15);
\r
399 TPrint_Text('<+> = Fewer Shapes <-> = More Shapes', 32, 204, 12);
\r
406 Set_Sprites(Number_Of_Shapes);
\r
408 Set_Dac_Register(19+c,63-(c*10),0,0);
\r
412 Set_Active_Page(currentpage);
\r
413 Set_Sprites(Number_Of_Shapes);
\r
416 XView := XView + XView_Change;
\r
417 If (XView > 38) OR (XView < 2) Then
\r
419 XView_Change := -(XView_Change);
\r
425 YView := YView + YView_Change;
\r
426 If (YView > 38) OR (YView < 2) Then
\r
428 YView_Change := -(YView_Change);
\r
433 Set_Window(currentpage,XView,YView);
\r
434 Set_Display_Page(currentpage);
\r
435 Set_Dac_Register(50 + PrevColor, 3 + PrevColor, 0, 60 - PrevColor);
\r
436 Set_Dac_Register(50 + SetColor, SetColor, 10, 63 - SetColor);
\r
437 Set_Dac_Register(150 + PrevColor, 3 + PrevColor, 0, 60 - PrevColor);
\r
438 Set_Dac_Register(150 + SetColor, 63, 63, SetColor);
\r
439 SetColor := SetColor + SDir;
\r
440 IF (SetColor = 60) OR (SetColor = 0) THEN SDir := -SDir;
\r
441 PrevColor := PrevColor + PDir;
\r
442 IF (PrevColor = 60) OR (PrevColor = 0) THEN PDir := -PDir;
\r
443 Remove_Sprites(lastpage,Number_Of_Shapes);
\r
449 '-' : If Number_Of_Shapes > 1 Then
\r
451 c := Number_Of_Shapes;
\r
452 Copy_Bitmap(2,obj[c].XPos,obj[c].YPos,obj[c].XPos+16,obj[c].YPos+16,
\r
453 currentpage,obj[c].XPos,obj[c].YPos);
\r
454 Dec(Number_Of_Shapes);
\r
456 '+' : If Number_Of_Shapes < 64 Then Inc(Number_Of_Shapes);
\r
459 lastpage := (lastpage+1) MOD 2;
\r
460 currentpage := (currentpage+1) MOD 2;
\r
464 { MAIN ROUTINE - Run Through Demos and Exit }
\r
471 Demo_Res(0, 320, 200);
\r
472 Demo_Res(1, 320, 400);
\r
473 Demo_Res(2, 360, 200);
\r
474 Demo_Res(3, 360, 400);
\r
475 Demo_Res(4, 320, 240);
\r
476 Demo_Res(5, 320, 480);
\r
477 Demo_Res(6, 360, 240);
\r
478 Demo_Res(7, 360, 480);
\r
486 WriteLn('THIS MODE X DEMO IS FINISHED');
\r