+++ /dev/null
-(*\r
- DEMO04 - Multiple textures and triple buffering (3 pages)\r
- (c) 1994 by Alessandro Scotti\r
-*)\r
-uses Crt, Modex, Threed;\r
-\r
-const\r
- MAXVTX = 256;\r
- MAXCUB = 2;\r
- MAXTXT = 2;\r
- Trans : TPoint = ( X:0; Y:0; Z:0 );\r
- TxtSunDial: array[ 0..7 ] of word = (\r
- $7F80,$0080, $0080,$0080, $0080,$7E80, $7F80,$7E80 );\r
- TxtSapphire : array[ 0..7 ] of word = (\r
- $0080,$0080, $0080,$1F80, $1F80,$1F80, $1F80,$0080 );\r
- TxtMarble: array[ 0..7 ] of word = (\r
- $0080,$8080, $0080,$FD80, $7F80,$FD80, $7F80,$8080 );\r
-type\r
- T2DPoint = record\r
- X, Y: integer;\r
- end;\r
- TTexture = record\r
- Desc : array[ 0..3 ] of record X, Y: word end;\r
- Width : word;\r
- Data : pointer;\r
- end;\r
- TQuad = record\r
- Vtx : array[ 0..3 ] of word;\r
- Texture: word;\r
- end;\r
- TCube = record\r
- Face : array[ 0..5 ] of TQuad;\r
- Base : integer;\r
- end;\r
-var\r
- Vtx, XVtx: array[ 0..MAXVTX ] of TPoint;\r
- VVtx : array[ 0..MAXVTX ] of T2DPoint;\r
- Cube : array[ 0..MAXCUB ] of TCube;\r
- ZList : array[ 0..MAXCUB ] of integer;\r
- VtxCnt : word;\r
- Txts : array[ 0..MAXTXT ] of TTexture;\r
- Page : word;\r
- Palette : array[ byte ] of record R, G, B: byte; end;\r
- TxtDat1, TxtDat2: pointer;\r
-\r
-(* Add a new entry to the vertex array *)\r
-procedure AddVtx( PX, PY, PZ: longint );\r
-begin\r
- with Vtx[VtxCnt] do begin X:=PX*$10000; Y:=PY*$10000; Z:=PZ*$10000; end;\r
- Inc( VtxCnt );\r
-end;\r
-\r
-procedure MakeCube( var C: TCube; X1,Y1,Z1, X2,Y2,Z2, TX,TY,TZ, Texture: integer );\r
-const\r
- FaceIdx: array[ 0..23 ] of integer = (\r
- 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
-var\r
- I, VC: integer;\r
-begin\r
- VC := VtxCnt;\r
- C.Base := VC;\r
- AddVtx( X1+TX, Y1+TY, Z1+TZ );\r
- AddVtx( X2+TX, Y1+TY, Z1+TZ );\r
- AddVtx( X2+TX, Y2+TY, Z1+TZ );\r
- AddVtx( X1+TX, Y2+TY, Z1+TZ );\r
- AddVtx( X1+TX, Y1+TY, Z2+TZ );\r
- AddVtx( X2+TX, Y1+TY, Z2+TZ );\r
- AddVtx( X2+TX, Y2+TY, Z2+TZ );\r
- AddVtx( X1+TX, Y2+TY, Z2+TZ );\r
- for I:=0 to 23 do C.Face[I shr 2].Vtx[I and 3] := VC+FaceIdx[I];\r
- for I:=0 to 5 do C.Face[I].Texture := Texture;\r
-end;\r
-\r
-procedure MakeTexture( Idx: integer; var VtxData );\r
-var\r
- P: ^word;\r
- I: integer;\r
-begin\r
- P := @VtxData;\r
- with Txts[Idx] do begin\r
- for I:=0 to 3 do begin\r
- Desc[I].X := P^; Inc( P );\r
- Desc[I].Y := P^; Inc( P );\r
- end;\r
- Width := 129;\r
- Data := TxtDat1;\r
- end;\r
-end;\r
-\r
-procedure Init;\r
-var\r
- I: integer;\r
- V: integer;\r
- F: file;\r
- P: array[ 1..768 ] of byte;\r
-begin\r
- (* Initialize objects *)\r
- VtxCnt := 0;\r
- MakeCube( Cube[0], -64,-64,8, 64,64,-8, 0,0,0, 1 ); (* Sundial *)\r
- Cube[0].Face[0].Texture := 0;\r
- V := VtxCnt;\r
- MakeCube( Cube[1], -16,-16,16, 16,16,-16, 0,0,0, 2 ); (* Sapphire *)\r
- tdSetTranslation( Trans );\r
- tdSetRotation( 32, 32, 00 );\r
- tdRotate( Vtx[V], XVtx[V], 8 ); (* Got to rotate this cube *)\r
- for I:=V to V+7 do begin\r
- Vtx[I].X := XVtx[I].X;\r
- Vtx[I].Y := XVtx[I].Y;\r
- Vtx[I].Z := XVtx[I].Z + 100*$10000;\r
- end;\r
- MakeCube( Cube[2], -64,-4,48, 64,4,-48, 0,68,56, 1 ); (* Marble *)\r
- (* Load texture and palette *)\r
- Assign( F, 'DEMO04.DAT' );\r
- Reset( F, 1 );\r
- BlockRead( F, P, SizeOf(P) );\r
- mxSetPalette( @P, 0, 256 );\r
- GetMem( TxtDat1, 63*1024 );\r
- BlockRead( F, TxtDat1^, 129*286 );\r
- Close( F );\r
- TxtDat2 := Ptr( Seg(TxtDat1^), Ofs(TxtDat1^)+129*254 );\r
- (* Init textures *)\r
- MakeTexture( 0, TxtSundial );\r
- MakeTexture( 1, TxtMarble );\r
- MakeTexture( 2, TxtSapphire );\r
- Txts[2].Data := TxtDat2;\r
-end;\r
-\r
-(* Sort procedure, not worth optimizing with only a few objects *)\r
-procedure SortObjects;\r
-var\r
- I, J, K: integer;\r
- ZMax: array[ 0..MAXCUB ] of longint;\r
- ZI: integer;\r
- L: longint;\r
-begin\r
- for I:=0 to MAXCUB do begin\r
- L := XVtx[Cube[I].Base].Z;\r
- for J:=1 to 7 do\r
- if( L > XVtx[Cube[I].Base+J].Z ) then L := XVtx[Cube[I].Base+J].Z;\r
- ZMax[I] := L;\r
- ZList[I] := I;\r
- end;\r
- for I:=0 to MAXCUB-1 do begin\r
- ZI := I;\r
- for J:=I+1 to MAXCUB do\r
- if( ZMax[ZList[J]] > ZMax[ZList[ZI]] ) then ZI := J;\r
- if( ZI <> I ) then begin\r
- K := ZList[I];\r
- ZList[I] := ZList[ZI];\r
- ZList[ZI] := K;\r
- end;\r
- end;\r
-end;\r
-\r
-var\r
- AX, AY, AZ: byte;\r
- I, J, K: word;\r
-begin\r
- mxInit;\r
- mxSetMode( MX_320x240 );\r
- Init;\r
- Page := 240; (* Start with hidden page *)\r
-\r
- (* Init 3D transforms, perspective is intentionally exaggerated *)\r
- AX := 0; AY := 0; AZ := 0;\r
- tdSetTranslation( Trans );\r
- tdSetPerspective( 600*$10000, $10000, $10000 );\r
- (* Main loop, all magic here! *)\r
- while( not KeyPressed ) do begin\r
- tdSetRotation( AX, AY, AZ ); (* Set new angles *)\r
- tdTransform( Vtx, XVtx, VtxCnt ); (* 3D transform points *)\r
- tdTransformToImage( XVtx, VVtx, VtxCnt, 160, 120+Page );\r
- Inc( AX, 1 ); (* Bump angles *)\r
- Inc( AY, 2 );\r
- Inc( AZ, 1 );\r
- mxSetClipRegion( 0, Page, 320, 240 ); (* Set clip to new page *)\r
- mxSetClip( TRUE );\r
- mxFillBox( 0, Page, 320, 240, 0, OP_MOVE ); (* Clear screen *)\r
- (* Draw objects *)\r
- SortObjects;\r
- for I:=0 to MAXCUB do with Cube[ZList[I]] do begin\r
- for J:=0 to 5 do begin\r
- K := Face[J].Texture;\r
- mxTexturePoly( 4, Face[J].Vtx, VVtx, Txts[K].Desc, Txts[K].Data^, Txts[K].Width );\r
- end;\r
- end;\r
- (* Flip page: at 320x240 the Start Address Register Low is always zero *)\r
- case Page of\r
- 0 : begin PortW[$3D4] := $000C; Page := 240; end;\r
- 240: begin PortW[$3D4] := $4B0C; Page := 480; end;\r
- 480: begin PortW[$3D4] := $960C; Page := 0; end;\r
- end;\r
- mxWaitRetrace; (* If the frame rate seems low, try to remove this line *)\r
- end;\r
-\r
- mxSetMode( MX_TEXT );\r
- mxTerm;\r
-end.\r
projects / 16.git / blobdiff