]> 4ch.mooo.com Git - 16.git/blob - 16/xw__/modex/DEMO05.PAS
16_ca needs huge amounts of work and I should remember what needs to be done soon...
[16.git] / 16 / xw__ / modex / DEMO05.PAS
1 (*\r
2    DEMO05 - A Gouraud-shaded rotating torus\r
3    (c) 1994 Alessandro Scotti\r
4 *)\r
5 uses Crt, Modex, Threed;\r
6 \r
7 (* Define ALTPAL for alternate palette *)\r
8 {$define ALTPAL}\r
9 \r
10 const\r
11   MAXVTX1 = 15; RADIUS1 = 70;   (* MAXVTX1+1 must be multiple of 4 *)\r
12   MAXVTX2 = 15; RADIUS2 = 30;\r
13   MAXVTX  = (MAXVTX1+1)*(MAXVTX2+1)-1;\r
14   MAXFACE = MAXVTX;\r
15   Trans : TPoint = ( X:0; Y:0; Z:0 );           (* Object translation *)\r
16   Light : TPoint = ( X:0; Y:0; Z:-63*$10000 );  (* Light direction *)\r
17 type\r
18   TQuad   = record\r
19     QVtx  : array[ 0..3 ] of integer;\r
20   end;\r
21 var\r
22   Vtx, XVtx : array[ 0..MAXVTX ] of TPoint;     (* Points *)\r
23   VVtx      : array[ 0..MAXVTX ] of record X, Y: integer end;\r
24   Face      : array[ 0..MAXFACE ] of TQuad;     (* Polys *)\r
25   Culled    : array[ 0..MAXFACE ] of integer;\r
26   GNrm,XGNrm: array[ 0..MAXVTX ] of TVector;    (* Gouraud normals *)\r
27   VtxLight  : array[ 0..MAXVTX ] of integer;    (* Points brightness *)\r
28   Page      : word;\r
29 \r
30 function GetVtx( I1, I2: integer ): integer;\r
31 begin\r
32   GetVtx := (I1 mod (MAXVTX1+1))*(MAXVTX2+1) + I2 mod (MAXVTX2+1);\r
33 end;\r
34 \r
35 procedure Init;\r
36 var\r
37   R, N, X, Y, Z: real;\r
38   I, J, K, V: integer;\r
39 begin\r
40   (* Build vertexes *)\r
41   for I:=0 to MAXVTX1 do begin\r
42     K := (I + (MAXVTX1+1) shr 2) mod (MAXVTX1+1);\r
43     R := RADIUS1 + RADIUS2*Cos( 2*K*Pi / (MAXVTX1+1) );\r
44     for J:=0 to MAXVTX2 do begin\r
45       V := I*(MAXVTX2+1)+J;                     (* Index of current vertex *)\r
46       (* Compute coordinates of current vertex *)\r
47       X := R*Cos(2*J*Pi / (MAXVTX2+1));         (* Get coordinates *)\r
48       Y := R*Sin(2*J*Pi / (MAXVTX2+1));\r
49       Z := RADIUS2*Sin(2*K*Pi / (MAXVTX1+1));\r
50       Vtx[V].X := Round( X )*$10000;            (* Save coordinates *)\r
51       Vtx[V].Y := Round( Y )*$10000;\r
52       Vtx[V].Z := Round( Z )*$10000;\r
53       (* Compute direction of Gouraud normal thru current vertex *)\r
54       X := X - RADIUS1*Cos(2*J*Pi / (MAXVTX2+1));\r
55       Y := Y - RADIUS1*Sin(2*J*Pi / (MAXVTX2+1));\r
56       N := Sqrt( X*X + Y*Y + Z*Z );             (* Get vector length *)\r
57       GNrm[V].X := Trunc( X*$10000/N );         (* Save normal vector *)\r
58       GNrm[V].Y := Trunc( Y*$10000/N );\r
59       GNrm[V].Z := Trunc( Z*$10000/N );\r
60     end;\r
61   end;\r
62   (* Generate faces so that depth-sorting is not needed: there are still *)\r
63   (* some *very* little errors, but this is the best I could devise *)\r
64   J := 0;\r
65   K := 0;\r
66   for I:=0 to MAXFACE do with Face[I] do begin\r
67     QVtx[0] := GetVtx( J, K );\r
68     QVtx[1] := GetVtx( J, K+1 );\r
69     QVtx[2] := GetVtx( J+1, K+1 );\r
70     QVtx[3] := GetVtx( J+1, K );\r
71     Inc( K );\r
72     if( K > MAXVTX2 ) then begin\r
73       K := 0;\r
74       Inc( J );\r
75     end;\r
76   end;\r
77 {$ifndef ALTPAL}\r
78   for I:=0 to 63 do mxSetColor( I+64, 0, 0, I );     (* Blue palette *)\r
79 {$else}\r
80   for I:=0 to 31 do mxSetColor(I+64, 0, I shl 1, 0); (* Green neon palette *)\r
81   for I:=32 to 63 do mxSetColor ( I+64, (I-32) shl 1, 63, (I-32) shl 1 );\r
82 {$endif}\r
83 end;\r
84 \r
85 var\r
86   AX, AY, AZ: byte;\r
87   I: word;\r
88 begin\r
89   mxInit;\r
90   mxSetMode( MX_320x240 );\r
91   Init;\r
92   Page := 240;          (* Start with hidden page *)\r
93 \r
94   AX := 0;\r
95   AY := 0;\r
96   AZ := 0;\r
97   (* Init 3D transforms, perspective is intentionally exaggerated *)\r
98   tdSetTranslation( Trans );\r
99   tdSetLight( Light );\r
100   tdSetPerspective( 400*$10000, $10000, $10000 );\r
101   (* Main loop, all magic here! *)\r
102   while( not KeyPressed ) do begin\r
103     tdSetRotation( AX, AY, AZ );                (* Set new angles *)\r
104     tdTransform( Vtx, XVtx, MAXVTX+1 );         (* 3D transform points *)\r
105     tdTransformToImage( XVtx, VVtx, MAXVTX+1, 160, 120+Page );\r
106     tdRotate( GNrm, XGNrm, MAXVTX+1 );          (* Rotate Gouraud normals *)\r
107     tdTransformLight( XGNrm, VtxLight, MAXVTX+1 );\r
108     (* Backplane culling is not really needed here! *)\r
109     FillChar( Culled, SizeOf(Culled), 0 );\r
110     tdBackPlaneCull( Face, XVtx, Culled, MAXFACE+1, SizeOf(TQuad) );\r
111     Inc( AX, 1 );                               (* Bump angles *)\r
112     Inc( AY, 2 );\r
113     Inc( AZ, 3 );\r
114     mxSetClipRegion( 0, Page, 320, 240 );       (* Set clip to new page *)\r
115     mxSetClip( TRUE );\r
116     mxFillBox( 0, Page, 320, 240, 0, OP_MOVE ); (* Clear screen *)\r
117     (* Draw polygons *)\r
118     for I:=0 to MAXFACE do with Face[I] do\r
119       if( Culled[I] >= 0 ) then mxGouraudPoly( 4, QVtx, VVtx, VtxLight, 64 );\r
120     (* Flip page: at 320x240 the Start Address Register Low is always zero *)\r
121     case Page of\r
122       0  : begin PortW[$3D4] := $000C; Page := 240; end;\r
123       240: begin PortW[$3D4] := $4B0C; Page := 480; end;\r
124       480: begin PortW[$3D4] := $960C; Page := 0; end;\r
125     end;\r
126     mxWaitRetrace; (* Uncomment this instruction if screen flickers *)\r
127   end;\r
128 \r
129   mxSetMode( MX_TEXT );\r
130   mxTerm;\r
131 end.\r