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