+++ /dev/null
-(*\r
- DEMO05 - A Gouraud-shaded rotating torus\r
- (c) 1994 Alessandro Scotti\r
-*)\r
-uses Crt, Modex, Threed;\r
-\r
-(* Define ALTPAL for alternate palette *)\r
-{$define ALTPAL}\r
-\r
-const\r
- MAXVTX1 = 15; RADIUS1 = 70; (* MAXVTX1+1 must be multiple of 4 *)\r
- MAXVTX2 = 15; RADIUS2 = 30;\r
- MAXVTX = (MAXVTX1+1)*(MAXVTX2+1)-1;\r
- MAXFACE = MAXVTX;\r
- Trans : TPoint = ( X:0; Y:0; Z:0 ); (* Object translation *)\r
- Light : TPoint = ( X:0; Y:0; Z:-63*$10000 ); (* Light direction *)\r
-type\r
- TQuad = record\r
- QVtx : array[ 0..3 ] of integer;\r
- end;\r
-var\r
- Vtx, XVtx : array[ 0..MAXVTX ] of TPoint; (* Points *)\r
- VVtx : array[ 0..MAXVTX ] of record X, Y: integer end;\r
- Face : array[ 0..MAXFACE ] of TQuad; (* Polys *)\r
- Culled : array[ 0..MAXFACE ] of integer;\r
- GNrm,XGNrm: array[ 0..MAXVTX ] of TVector; (* Gouraud normals *)\r
- VtxLight : array[ 0..MAXVTX ] of integer; (* Points brightness *)\r
- Page : word;\r
-\r
-function GetVtx( I1, I2: integer ): integer;\r
-begin\r
- GetVtx := (I1 mod (MAXVTX1+1))*(MAXVTX2+1) + I2 mod (MAXVTX2+1);\r
-end;\r
-\r
-procedure Init;\r
-var\r
- R, N, X, Y, Z: real;\r
- I, J, K, V: integer;\r
-begin\r
- (* Build vertexes *)\r
- for I:=0 to MAXVTX1 do begin\r
- K := (I + (MAXVTX1+1) shr 2) mod (MAXVTX1+1);\r
- R := RADIUS1 + RADIUS2*Cos( 2*K*Pi / (MAXVTX1+1) );\r
- for J:=0 to MAXVTX2 do begin\r
- V := I*(MAXVTX2+1)+J; (* Index of current vertex *)\r
- (* Compute coordinates of current vertex *)\r
- X := R*Cos(2*J*Pi / (MAXVTX2+1)); (* Get coordinates *)\r
- Y := R*Sin(2*J*Pi / (MAXVTX2+1));\r
- Z := RADIUS2*Sin(2*K*Pi / (MAXVTX1+1));\r
- Vtx[V].X := Round( X )*$10000; (* Save coordinates *)\r
- Vtx[V].Y := Round( Y )*$10000;\r
- Vtx[V].Z := Round( Z )*$10000;\r
- (* Compute direction of Gouraud normal thru current vertex *)\r
- X := X - RADIUS1*Cos(2*J*Pi / (MAXVTX2+1));\r
- Y := Y - RADIUS1*Sin(2*J*Pi / (MAXVTX2+1));\r
- N := Sqrt( X*X + Y*Y + Z*Z ); (* Get vector length *)\r
- GNrm[V].X := Trunc( X*$10000/N ); (* Save normal vector *)\r
- GNrm[V].Y := Trunc( Y*$10000/N );\r
- GNrm[V].Z := Trunc( Z*$10000/N );\r
- end;\r
- end;\r
- (* Generate faces so that depth-sorting is not needed: there are still *)\r
- (* some *very* little errors, but this is the best I could devise *)\r
- J := 0;\r
- K := 0;\r
- for I:=0 to MAXFACE do with Face[I] do begin\r
- QVtx[0] := GetVtx( J, K );\r
- QVtx[1] := GetVtx( J, K+1 );\r
- QVtx[2] := GetVtx( J+1, K+1 );\r
- QVtx[3] := GetVtx( J+1, K );\r
- Inc( K );\r
- if( K > MAXVTX2 ) then begin\r
- K := 0;\r
- Inc( J );\r
- end;\r
- end;\r
-{$ifndef ALTPAL}\r
- for I:=0 to 63 do mxSetColor( I+64, 0, 0, I ); (* Blue palette *)\r
-{$else}\r
- for I:=0 to 31 do mxSetColor(I+64, 0, I shl 1, 0); (* Green neon palette *)\r
- for I:=32 to 63 do mxSetColor ( I+64, (I-32) shl 1, 63, (I-32) shl 1 );\r
-{$endif}\r
-end;\r
-\r
-var\r
- AX, AY, AZ: byte;\r
- I: word;\r
-begin\r
- mxInit;\r
- mxSetMode( MX_320x240 );\r
- Init;\r
- Page := 240; (* Start with hidden page *)\r
-\r
- AX := 0;\r
- AY := 0;\r
- AZ := 0;\r
- (* Init 3D transforms, perspective is intentionally exaggerated *)\r
- tdSetTranslation( Trans );\r
- tdSetLight( Light );\r
- tdSetPerspective( 400*$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, MAXVTX+1 ); (* 3D transform points *)\r
- tdTransformToImage( XVtx, VVtx, MAXVTX+1, 160, 120+Page );\r
- tdRotate( GNrm, XGNrm, MAXVTX+1 ); (* Rotate Gouraud normals *)\r
- tdTransformLight( XGNrm, VtxLight, MAXVTX+1 );\r
- (* Backplane culling is not really needed here! *)\r
- FillChar( Culled, SizeOf(Culled), 0 );\r
- tdBackPlaneCull( Face, XVtx, Culled, MAXFACE+1, SizeOf(TQuad) );\r
- Inc( AX, 1 ); (* Bump angles *)\r
- Inc( AY, 2 );\r
- Inc( AZ, 3 );\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 polygons *)\r
- for I:=0 to MAXFACE do with Face[I] do\r
- if( Culled[I] >= 0 ) then mxGouraudPoly( 4, QVtx, VVtx, VtxLight, 64 );\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; (* Uncomment this instruction if screen flickers *)\r
- end;\r
-\r
- mxSetMode( MX_TEXT );\r
- mxTerm;\r
-end.\r
projects / 16.git / blobdiff