{                      ModeX Turbo Pascal Demo Program                       }
{                  Converted to Turbo Pascal by Scott Wyatt                  }
{          Original program written in QuickBasic by Matt Prichard           }
{                       Released to the Public Domain                        }
{                                                                            }
{          Thanks to Matt Prichard for his *EXCELLENT* ModeX Library         }
{		   Additional Comments by Matt Pritchard							 }

NEWTYPE CHAR : byte;
NEWTYPE BOOLEAN : byte;
NEWTYPE POINTER : dword;
NEWTYPE STRING  : DWORD;
NEWTYPE Sprite
	Xpos : INTEGER;
	Ypos : INTEGER;
	XDir : INTEGER;
	YDir : INTEGER;
	Shape : INTEGER;
	LastX : INTEGER;
	LastY : INTEGER;
     ENDTYPE;


CONST MaxShapes = 32;
      Circle_16[16,16]:byte =
      ((  0,  0,  0,  0,  0,  0, 20, 20, 20, 20,  0,  0,  0,  0,  0,  0),
       (  0,  0,  0,  0, 20, 20, 20, 20, 20, 20, 20, 20,  0,  0,  0,  0),
       (  0,  0,  0, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,  0,  0,  0),
       (  0,  0, 20, 20, 20, 20,  0,  0,  0,  0, 20, 20, 20, 20,  0,  0),
       (  0, 20, 20, 20, 20,  0,  0,  0,  0,  0,  0, 20, 20, 20, 20,  0),
       (  0, 20, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0, 20, 20, 20,  0),
       ( 20, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 20, 20, 20),
       ( 20, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 20, 20, 20),
       ( 20, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 20, 20, 20),
       ( 20, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 20, 20, 20),
       (  0, 20, 20, 20,  0,  0,  0,  0,  0,  0,  0,  0, 20, 20, 20,  0),
       (  0, 20, 20, 20, 20,  0,  0,  0,  0,  0,  0, 20, 20, 20, 20,  0),
       (  0,  0, 20, 20, 20, 20,  0,  0,  0,  0, 20, 20, 20, 20,  0,  0),
       (  0,  0,  0, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,  0,  0,  0),
       (  0,  0,  0,  0, 20, 20, 20, 20, 20, 20, 20, 20,  0,  0,  0,  0),
       (  0,  0,  0,  0,  0,  0, 20, 20, 20, 20,  0,  0,  0,  0,  0,  0));
      Square_16[16,16]:byte =
      (( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21,  0,  0,  0,  0,  0,  0,  0,  0, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21),
       ( 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21));
       Diamond[8,8]:byte =
      ((  0,  0,  0, 22, 22,  0,  0,  0),
       (  0,  0, 22, 22, 22, 22,  0,  0),
       (  0, 22, 22,  0,  0, 22, 22,  0),
       ( 22, 22,  0,  0,  0,  0, 22, 22),
       ( 22, 22,  0,  0,  0,  0, 22, 22),
       (  0, 22, 22,  0,  0, 22, 22,  0),
       (  0,  0, 22, 22, 22, 22,  0,  0),
       (  0,  0,  0, 22, 22,  0,  0,  0));
       Rectangle[8,3]:byte =
      (( 23, 23, 23),
       ( 23, 23, 23),
       ( 23, 23, 23),
       ( 23, 23, 23),
       ( 23, 23, 23),
       ( 23, 23, 23),
       ( 23, 23, 23),
       ( 23, 23, 23));

	   { Global Variables ? }

Var
  XCenter,X1,Y1,X2,Y2,Z,Colr,XChars,YChars,X,Y,N,Gap : Integer;
  s : string;
  s1[35]:Char;
  ch : Char;
  obj[64]:Sprite;
  ScreenX,ScreenY : Integer;
  c, dc, SpriteX, SpriteY, CurrentPage, LastPage : Integer;
  SetColor, SDir, PrevColor, PDir : Byte;
  XView, YView : Integer;
  XView_Change, YView_Change : Integer;
  Right : Boolean;
  Number_Of_Shapes : Byte;


	{ Error Handler - Returns to Text Mode & Displays Error }

Procedure ERROR_OUT(st : string);
  Begin
  mode03;
  WriteLn(s);
  Halt;
END;

	{ Routine to Print a PASCAL string using Print_Str }

Procedure Print_Text(st : string; Xp,Yp,BColor,FColor : integer);
Var
  st1[135] : Char;
  i : byte;
Begin
  For i = 0 to Length(st) DO
    st1[i] = memb [st+i] ;
  Print_Str(offset (st1),Length(st),Xp,Yp,BColor,FColor);
End;

	{ Routine to Transparently Print a PASCAL string using TPrint_Str }

Procedure Tprint_Text(st : string; Xp,Yp,Color : integer);
Var
  st1[135] : Char;
  i : byte;
Begin
  For i = 0 to Length(st) DO
    st1[i] = memb [st+i] ;
  Tprint_Str(offset (st1),Length(st),Xp,Yp,Color);
End;

	{ Routines to show test patterns for a given mode }


Procedure Demo_Res(Mode, Xmax, Ymax : integer);
const
        err = 'Unable to SET_MODEX ';
        string1 = 'Line Test';
        string2 = 'Fill Test';
        string3 = 'Pixel Test';
        string4 = 'READ_PIXEL Failure';
        string5 = ' This is a MODE X demo ';
        string6 = 'Screen Resolution is     by    ';
        string7 = 'Press <ANY KEY> to Continue';

Begin

  If Set_ModeX(Mode) = 0 Then
    Error_Out(offset (err));
  Clear_VGA_Screen(0);


  XCenter = Xmax / 2;
  X1 = 10;
  Y1 = 10;
  X2 = Xmax - 1;
  Y2 = Ymax - 1;

  FOR Z = 0 TO 4 DO
    Begin
      Colr = 31 - Z * 2;
      Draw_Line(X1 + Z, Y1 + Z, X2 - Z, Y1 + Z, Colr);
      Draw_Line(X1 + Z, Y1 + Z, X1 + Z, Y2 - Z, Colr);
      Draw_Line(X1 + Z, Y2 - Z, X2 - Z, Y2 - Z, Colr);
      Draw_Line(X2 - Z, Y1 + Z, X2 - Z, Y2 - Z, Colr);
    End;

  XChars = Xmax / 10;
  YChars = Ymax / 10;

  FOR X = 0 TO XChars  DO
    Begin
      TGPRINTC(48 + ((X + 1) MOD 10), X * 10 + 1, 1, 9 + ((X / 8) MOD 7));
      DRAW_LINE(X * 10 + 9, 0, X * 10 + 9, 3, 15);
    End;
  FOR Y = 0 TO YChars  DO
    Begin
      TGPRINTC(48 + ((Y + 1) MOD 10), 1, Y * 10 + 1, 9 + ((Y / 10) MOD 7));
      DRAW_LINE(0, Y * 10 + 9, 3, Y * 10 + 9, 15);
    End;

   { Test Line Drawing }

  FOR X = 0 TO 64 DO
    Begin
      N = 15 + ((X * 3) / 4);
      SET_DAC_REGISTER(64 + X, N, N, N);
      SET_DAC_REGISTER(128 + X, 0, N, N);
      DRAW_LINE(103 - X, 60, 40 + X, 123, 64 + X);
      DRAW_LINE(40, 60 + X, 103, 123 - X, 128 + X);
    End;
  PRINT_Text(offset (string1),37,130,1,0);

  { Test Block Fills }

  Y = 60;
  Gap = 0;
  FOR X = 0 TO 9 DO
    Begin
      FILL_BLOCK(120, Y, 120 + X, Y + Gap, 64 + X);
      FILL_BLOCK(140 - (15 - X), Y, 150 + X, Y + Gap, 230 + X);
      FILL_BLOCK(170 - (15 - X), Y, 170, Y + Gap, 128 + X);
      Y = Y + Gap + 2;
      Gap = Gap + 1;
    End;

  Print_Text(offset (string2),110, 46, 2,0);

  { Test Pixel Write and Read }

  FOR X = 190 TO 250 DO
    FOR Y = 60 TO 122 DO
      SET_POINT( X, Y, X + Y + X + Y);

  Print_Text(offset (string3),182, 130, 3,0);


  FOR X = 190 TO 250 DO
    FOR Y = 60 TO 122 DO
      IF READ_POINT(X, Y) <> ((X + Y + X + Y) & 255) THEN
        WriteLn(offset (string4));

        { Display rest of screen }

  Print_Text(offset (string5),XCenter - (Length(offset (string5)) * 4), 20, 3, 1);
  X = XCenter - (Length(offset (string6)) * 4);
  Print_Text(offset (string6),X,30,4,0);


  FOR X = 0 TO 16 DO
    Begin
      SET_DAC_REGISTER( 230 + X, 63 - X * 4, 0, 15 + X * 3);
      DRAW_LINE(30 + X, Ymax - 6 - X, Xmax - 20 - X, Ymax - 6 - X, 230 + X);
    End;
  TPrint_Str(offset (string7), length(offset (string7)), XCenter - (26 * 4), Ymax - 18, 5);
  repeat until kbhit > 1;
  kbhit = 0;
End;


	{ Initialize Sprites for Sprite Demo }

Procedure Init_Sprites;
Var i : byte;
Begin
  For i = 0 to 64 DO
    Begin
      Obj[i].XPos = Random(300)+10;
      Obj[i].YPos = Random(200)+20;
      Obj[i].XDir = Random(10)-5;
      Obj[i].YDir = Random(10)-5;
      If (Obj[i].XDir = 0) AND (Obj[i].YDir = 0) Then
        Begin
          Obj[i].XDir = Random(5) + 1;
          Obj[i].YDir = Random(5) + 1;
        End;
      Obj[i].Shape = Random(4)+1;
      Obj[i].LastX = obj[i].XPos;
      Obj[i].LastY = obj[i].YPos;
    End;
End;

Procedure Set_Sprites(number : byte);
Var i : Byte;
Begin
  For i = 0 to number DO
    Begin
      obj[i].LastX = obj[i].XPos;
      obj[i].LastY = obj[i].YPos;
      obj[i].XPos = obj[i].XPos + obj[i].XDir;
      obj[i].YPos = obj[i].YPos + obj[i].YDir;
      If (obj[i].XPos > 335) OR (obj[i].XPos < 5 ) Then
        obj[i].XDir = -(obj[i].XDir);
      If (obj[i].YPos > 220) OR (obj[i].YPos < 5) Then
        obj[i].YDir = -(obj[i].YDir);
    End;
  For i = 0 to number DO
    Case obj[i].Shape of
      1 : TDraw_Bitmap(offset (Circle_16),obj[i].XPos,obj[i].YPos,16,16);
      2 : TDraw_Bitmap(offset (Square_16),obj[i].XPos,obj[i].YPos,16,16);
      3 : TDraw_Bitmap(offset (Diamond),obj[i].XPos,obj[i].YPos,8,8);
      4 : TDraw_Bitmap(offset (Rectangle),obj[i].XPos,obj[i].YPos,3,8)
    End;
End;

Procedure Remove_Sprites(p,number : byte);
Var i : byte;
Begin
  For i = 0 to number+1 DO
    Copy_Bitmap(2,obj[i].LastX,obj[i].LastY,obj[i].LastX+16,obj[i].LastY+16,p,Obj[i].LastX,Obj[i].LastY);
End;

Procedure Page_Demo;
const
        err = 'Unable to SET_VGA_MODEX';
    string1 = 'This is a Test of the Following Functions:';
    string2 = 'SET_ACTIVE_PAGE';
    string3 = 'SET_DISPLAY_PAGE';
    string4 = 'SET_DAC_REGISTER';
    string5 = 'CLEAR_VGA_SCREEN';
    string6 = 'TDRAW_BITMAP';
    string7 = 'COPY_PAGE';
    string8 = 'COPY_BITMAP';
    string9 = 'GPRINTC';
    string10= 'TGPRINTC';
    string11= 'SYNC_DISPLAY';
    string12= 'SET_WINDOW';
    string13= 'VIRTUAL SCREEN SIZES';
    string14= '    SMOOTH SCROLLING';
    string15= '    SPRITE ANIMATION';
    string16= '       PAGE FLIPPING';
    string17= '       COLOR CYCLING';
    string18= 'Press <ESC> to Continue';
    string19= '<+> = Fewer Shapes  <-> = More Shapes';
    True = 1;
    False = 0;
Begin
  Number_Of_Shapes = 64;
  XView_Change = 1;
  YView_Change = 1;
  XView = 1;
  YView = 1;
  Right = 1;
  ScreenX = 360;
  ScreenY = 240;
  PrevColor = 0;
  SetColor = 3;
  SDir = 1;
  PDir = 1;

  IF SET_VGA_MODEX(0, ScreenX, ScreenY, 3) = 0 THEN
    ERROR_OUT(offset (err));

  SET_ACTIVE_PAGE(0);
  CLEAR_VGA_SCREEN(0);
  PRINT_TEXT(offset (string1), 10, 9, 15, 0);
  DRAW_LINE( 10, 18, 350, 18, 4);
  Print_Text(offset (string2), 10, 20, 1, 0);
  Print_Text(offset (string3), 10, 30, 3,0);
  Print_Text(offset (string4), 10, 40, 3, 0);
  Print_Text(offset (string5), 10, 50, 13, 0);
  Print_Text(offset (string6), 10, 60, 14, 0);
  Print_Text(offset (string7), 10, 70, 3, 0);
  Print_Text(offset (string8), 10, 80, 13, 0);
  Print_Text(offset (string9), 10, 90, 1, 0);
  Print_Text(offset (string10), 10, 100, 3, 0);
  Print_Text(offset (string11), 10, 110, 3, 0);
  Print_Text(offset (string12), 10, 120, 14, 0);
  Print_Text(offset (string13), 190, 20, 1, 0);
  Print_Text(offset (string14), 190, 30, 3, 0);
  Print_Text(offset (string15), 190, 40, 13, 0);
  Print_Text(offset (string16), 190, 50, 3, 0);
  Print_Text(offset (string17), 190, 60, 14, 0);


  FOR X = 0 TO 61 DO
    Begin
      SET_DAC_REGISTER( 50 + X, 3 + X, 0, 60 - X);
      SET_DAC_REGISTER( 150 + X, 3 + X, 0, 60 - X);
    End;

  c = 0;
  DC = 1;
  FOR X = 0 TO ScreenX / 2 DO
    Begin
      DRAW_LINE( ScreenX / 2 - 1, ScreenY / 4, X, ScreenY - 1, c + 50);
      DRAW_LINE( ScreenX / 2, ScreenY / 4, ScreenX - X - 1, ScreenY - 1, c + 50);
      c = c + DC;
      IF (c = 0) OR (c = 60) THEN DC = -DC;
    End;

  TPrint_Text(offset (string18), 82, 190, 15);
  TPrint_Text(offset (string19), 32, 204, 12);
  copy_bitmap (0,0,0,360,240,0,0,240);
  copy_bitmap (0,0,0,360,240,0,0,480);

  CurrentPage = 1;
  LastPage = 0;
  Set_Sprites(Number_Of_Shapes);
  For c = 1 to 4 DO
    Set_Dac_Register(19+c,63-(c*10),0,0);

  While inkey[1] <> 1 DO
    Begin
      Set_Active_Page(currentpage);
      Set_Sprites(Number_Of_Shapes);
      If Right = 1 Then
        Begin
          XView = XView + XView_Change;
          If (XView > 38) OR (XView < 2) Then
            Begin
              XView_Change = -(XView_Change);
              Right = 0;
            End;
         end
      Else
        Begin
          YView = YView + YView_Change;
          If (YView > 38) OR (YView < 2) Then
            Begin
              YView_Change = -(YView_Change);
              Right = 1;
            End;
       end;

      Set_Window(currentpage,XView,YView);
      Set_Dac_Register(50 + PrevColor, 3 + PrevColor, 0, 60 - PrevColor);
      Set_Dac_Register(50 + SetColor, SetColor, 10, 63 - SetColor);
      Set_Dac_Register(150 + PrevColor, 3 + PrevColor, 0, 60 - PrevColor);
      Set_Dac_Register(150 + SetColor, 63, 63, SetColor);
      SetColor = SetColor + SDir;
      IF (SetColor = 60) OR (SetColor = 0) THEN SDir = -SDir;
      PrevColor = PrevColor + PDir;
      IF (PrevColor = 60) OR (PrevColor = 0) THEN PDir = -PDir;
      Remove_Sprites(lastpage,Number_Of_Shapes);

            if inkey[12] = 1 then
               If Number_Of_Shapes > 1 Then
                    Begin
                      c = Number_Of_Shapes - 1;
                      Copy_Bitmap(2,obj[c].XPos,obj[c].YPos,obj[c].XPos+16,obj[c].YPos+16,
                         currentpage,obj[c].XPos,obj[c].YPos);
                      Number_Of_Shapes = Number_Of_Shapes - 1;
                    End;
             if inkey[13] = 1 then
               If Number_Of_Shapes < 64 Then Number_Of_Shapes = Number_Of_Shapes + 1;
      lastpage = (lastpage+1) MOD 2;
      currentpage = (currentpage+1) MOD 2;
    End;
END;

Begin

  Init_Sprites;

  kbhit = 0;
  Demo_Res(0, 320, 200);
  Demo_Res(1, 320, 400);
  Demo_Res(2, 360, 200);
  Demo_Res(3, 360, 400);
  Demo_Res(4, 320, 240);
  Demo_Res(5, 320, 480);
  Demo_Res(6, 360, 240);
  Demo_Res(7, 360, 480);
  Page_Demo;

  mode03;
END.

