16/xw/modex/DEMO04.PAS

   1 (*\r
   2     DEMO04 - Multiple textures and triple buffering (3 pages)\r
   3     (c) 1994 by Alessandro Scotti\r
   4 *)\r
   5 uses Crt, Modex, Threed;\r
   6 \r
   7 const\r
   8   MAXVTX = 256;\r
   9   MAXCUB = 2;\r
  10   MAXTXT = 2;\r
  11   Trans : TPoint = ( X:0; Y:0; Z:0 );\r
  12   TxtSunDial: array[ 0..7 ] of word = (\r
  13     $7F80,$0080, $0080,$0080, $0080,$7E80, $7F80,$7E80 );\r
  14   TxtSapphire : array[ 0..7 ] of word = (\r
  15     $0080,$0080, $0080,$1F80, $1F80,$1F80, $1F80,$0080 );\r
  16   TxtMarble: array[ 0..7 ] of word = (\r
  17     $0080,$8080, $0080,$FD80, $7F80,$FD80, $7F80,$8080 );\r
  18 type\r
  19   T2DPoint = record\r
  20     X, Y: integer;\r
  21   end;\r
  22   TTexture = record\r
  23     Desc   : array[ 0..3 ] of record X, Y: word end;\r
  24     Width  : word;\r
  25     Data   : pointer;\r
  26   end;\r
  27   TQuad = record\r
  28     Vtx    : array[ 0..3 ] of word;\r
  29     Texture: word;\r
  30   end;\r
  31   TCube    = record\r
  32     Face   : array[ 0..5 ] of TQuad;\r
  33     Base   : integer;\r
  34   end;\r
  35 var\r
  36   Vtx, XVtx: array[ 0..MAXVTX ] of TPoint;\r
  37   VVtx     : array[ 0..MAXVTX ] of T2DPoint;\r
  38   Cube     : array[ 0..MAXCUB ] of TCube;\r
  39   ZList    : array[ 0..MAXCUB ] of integer;\r
  40   VtxCnt   : word;\r
  41   Txts     : array[ 0..MAXTXT ] of TTexture;\r
  42   Page     : word;\r
  43   Palette  : array[ byte ] of record R, G, B: byte; end;\r
  44   TxtDat1, TxtDat2: pointer;\r
  45 \r
  46 (* Add a new entry to the vertex array *)\r
  47 procedure AddVtx( PX, PY, PZ: longint );\r
  48 begin\r
  49   with Vtx[VtxCnt] do begin X:=PX*$10000; Y:=PY*$10000; Z:=PZ*$10000; end;\r
  50   Inc( VtxCnt );\r
  51 end;\r
  52 \r
  53 procedure MakeCube( var C: TCube; X1,Y1,Z1, X2,Y2,Z2, TX,TY,TZ, Texture: integer );\r
  54 const\r
  55   FaceIdx: array[ 0..23 ] of integer = (\r
  56     0,1,2,3, 0,4,5,1, 1,5,6,2, 2,6,7,3, 3,7,4,0, 6,5,4,7 );\r
  57 var\r
  58   I, VC: integer;\r
  59 begin\r
  60   VC := VtxCnt;\r
  61   C.Base := VC;\r
  62   AddVtx( X1+TX, Y1+TY, Z1+TZ );\r
  63   AddVtx( X2+TX, Y1+TY, Z1+TZ );\r
  64   AddVtx( X2+TX, Y2+TY, Z1+TZ );\r
  65   AddVtx( X1+TX, Y2+TY, Z1+TZ );\r
  66   AddVtx( X1+TX, Y1+TY, Z2+TZ );\r
  67   AddVtx( X2+TX, Y1+TY, Z2+TZ );\r
  68   AddVtx( X2+TX, Y2+TY, Z2+TZ );\r
  69   AddVtx( X1+TX, Y2+TY, Z2+TZ );\r
  70   for I:=0 to 23 do C.Face[I shr 2].Vtx[I and 3] := VC+FaceIdx[I];\r
  71   for I:=0 to 5 do C.Face[I].Texture := Texture;\r
  72 end;\r
  73 \r
  74 procedure MakeTexture( Idx: integer; var VtxData );\r
  75 var\r
  76   P: ^word;\r
  77   I: integer;\r
  78 begin\r
  79   P := @VtxData;\r
  80   with Txts[Idx] do begin\r
  81     for I:=0 to 3 do begin\r
  82       Desc[I].X := P^; Inc( P );\r
  83       Desc[I].Y := P^; Inc( P );\r
  84     end;\r
  85     Width := 129;\r
  86     Data := TxtDat1;\r
  87   end;\r
  88 end;\r
  89 \r
  90 procedure Init;\r
  91 var\r
  92   I: integer;\r
  93   V: integer;\r
  94   F: file;\r
  95   P: array[ 1..768 ] of byte;\r
  96 begin\r
  97   (* Initialize objects *)\r
  98   VtxCnt := 0;\r
  99   MakeCube( Cube[0], -64,-64,8, 64,64,-8, 0,0,0, 1 );   (* Sundial *)\r
 100   Cube[0].Face[0].Texture := 0;\r
 101   V := VtxCnt;\r
 102   MakeCube( Cube[1], -16,-16,16, 16,16,-16, 0,0,0, 2 ); (* Sapphire *)\r
 103   tdSetTranslation( Trans );\r
 104   tdSetRotation( 32, 32, 00 );\r
 105   tdRotate( Vtx[V], XVtx[V], 8 );       (* Got to rotate this cube *)\r
 106   for I:=V to V+7 do begin\r
 107     Vtx[I].X := XVtx[I].X;\r
 108     Vtx[I].Y := XVtx[I].Y;\r
 109     Vtx[I].Z := XVtx[I].Z + 100*$10000;\r
 110   end;\r
 111   MakeCube( Cube[2], -64,-4,48, 64,4,-48, 0,68,56, 1 ); (* Marble *)\r
 112   (* Load texture and palette *)\r
 113   Assign( F, 'DEMO04.DAT' );\r
 114   Reset( F, 1 );\r
 115   BlockRead( F, P, SizeOf(P) );\r
 116   mxSetPalette( @P, 0, 256 );\r
 117   GetMem( TxtDat1, 63*1024 );\r
 118   BlockRead( F, TxtDat1^, 129*286 );\r
 119   Close( F );\r
 120   TxtDat2 := Ptr( Seg(TxtDat1^), Ofs(TxtDat1^)+129*254 );\r
 121   (* Init textures *)\r
 122   MakeTexture( 0, TxtSundial );\r
 123   MakeTexture( 1, TxtMarble );\r
 124   MakeTexture( 2, TxtSapphire );\r
 125   Txts[2].Data := TxtDat2;\r
 126 end;\r
 127 \r
 128 (* Sort procedure, not worth optimizing with only a few objects *)\r
 129 procedure SortObjects;\r
 130 var\r
 131   I, J, K: integer;\r
 132   ZMax: array[ 0..MAXCUB ] of longint;\r
 133   ZI: integer;\r
 134   L: longint;\r
 135 begin\r
 136   for I:=0 to MAXCUB do begin\r
 137     L := XVtx[Cube[I].Base].Z;\r
 138     for J:=1 to 7 do\r
 139       if( L > XVtx[Cube[I].Base+J].Z ) then L := XVtx[Cube[I].Base+J].Z;\r
 140     ZMax[I] := L;\r
 141     ZList[I] := I;\r
 142   end;\r
 143   for I:=0 to MAXCUB-1 do begin\r
 144     ZI := I;\r
 145     for J:=I+1 to MAXCUB do\r
 146       if( ZMax[ZList[J]] > ZMax[ZList[ZI]] ) then ZI := J;\r
 147     if( ZI <> I ) then begin\r
 148       K := ZList[I];\r
 149       ZList[I] := ZList[ZI];\r
 150       ZList[ZI] := K;\r
 151     end;\r
 152   end;\r
 153 end;\r
 154 \r
 155 var\r
 156   AX, AY, AZ: byte;\r
 157   I, J, K: word;\r
 158 begin\r
 159   mxInit;\r
 160   mxSetMode( MX_320x240 );\r
 161   Init;\r
 162   Page := 240;          (* Start with hidden page *)\r
 163 \r
 164   (* Init 3D transforms, perspective is intentionally exaggerated *)\r
 165   AX := 0; AY := 0; AZ := 0;\r
 166   tdSetTranslation( Trans );\r
 167   tdSetPerspective( 600*$10000, $10000, $10000 );\r
 168   (* Main loop, all magic here! *)\r
 169   while( not KeyPressed ) do begin\r
 170     tdSetRotation( AX, AY, AZ );                (* Set new angles *)\r
 171     tdTransform( Vtx, XVtx, VtxCnt );           (* 3D transform points *)\r
 172     tdTransformToImage( XVtx, VVtx, VtxCnt, 160, 120+Page );\r
 173     Inc( AX, 1 );                               (* Bump angles *)\r
 174     Inc( AY, 2 );\r
 175     Inc( AZ, 1 );\r
 176     mxSetClipRegion( 0, Page, 320, 240 );       (* Set clip to new page *)\r
 177     mxSetClip( TRUE );\r
 178     mxFillBox( 0, Page, 320, 240, 0, OP_MOVE ); (* Clear screen *)\r
 179     (* Draw objects *)\r
 180     SortObjects;\r
 181     for I:=0 to MAXCUB do with Cube[ZList[I]] do begin\r
 182       for J:=0 to 5 do begin\r
 183         K := Face[J].Texture;\r
 184         mxTexturePoly( 4, Face[J].Vtx, VVtx, Txts[K].Desc, Txts[K].Data^, Txts[K].Width );\r
 185       end;\r
 186     end;\r
 187     (* Flip page: at 320x240 the Start Address Register Low is always zero *)\r
 188     case Page of\r
 189       0  : begin PortW[$3D4] := $000C; Page := 240; end;\r
 190       240: begin PortW[$3D4] := $4B0C; Page := 480; end;\r
 191       480: begin PortW[$3D4] := $960C; Page := 0; end;\r
 192     end;\r
 193     mxWaitRetrace; (* If the frame rate seems low, try to remove this line *)\r
 194   end;\r
 195 \r
 196   mxSetMode( MX_TEXT );\r
 197   mxTerm;\r
 198 end.\r