16/x_/modex/DEMO03.PAS

   1 (*\r
   2     DEMO03 - Simple star animation, morphs between a cube and a sphere\r
   3     (c) 1994 by Alessandro Scotti\r
   4 *)\r
   5 uses Crt, Modex, Threed;\r
   6 \r
   7 const\r
   8   MAXVTX = 1000;        (* Number of points *)\r
   9   EDGE = 70;            (* Length of cube edge *)\r
  10   RADIUS = 90;          (* Radius of sphere *)\r
  11   WAITCOUNT = 192;      (* Frames to wait for non-morphing shapes *)\r
  12   MS = 32;              (* Number of steps for morphing *)\r
  13   Trans : TPoint = ( X:0; Y:0; Z:0 );\r
  14   InitMorph1: array[ 0..3 ] of integer = ( 0, MS, 0, 0 );\r
  15   InitMorph2: array[ 0..3 ] of integer = ( 0, 0, 0, MS );\r
  16   InitDelta1: array[ 0..3 ] of integer = ( 0, -1, 0, +1 );\r
  17   InitDelta2: array[ 0..3 ] of integer = ( 0, +1, 0, -1 );\r
  18 type\r
  19   T2DPoint = record\r
  20     X, Y: integer;\r
  21   end;\r
  22   T3DPointArray = array[ 0..MAXVTX-1 ] of TPoint;\r
  23   P3DPointArray = ^T3DPointArray;\r
  24 var\r
  25   CubeVtx, SphereVtx, Vtx, XVtx: P3DPointArray;\r
  26   VVtx  : array[ 0..MAXVTX-1 ] of T2DPoint;\r
  27   Page  : word;\r
  28   Status, Count, Delta1, Delta2, Morph1, Morph2: integer;\r
  29 \r
  30 procedure Swap( var A, B: longint );\r
  31 var\r
  32   L: longint;\r
  33 begin\r
  34   L := A; A := B; B := L;\r
  35 end;\r
  36 \r
  37 function Toggle( A: longint ): longint;\r
  38 begin\r
  39   Toggle := A;\r
  40   if( Random(2) = 0 ) then Toggle := -A;\r
  41 end;\r
  42 \r
  43 procedure Init;\r
  44 label Retry;\r
  45 var\r
  46   I: integer;\r
  47 begin\r
  48   New( CubeVtx );\r
  49   New( SphereVtx );\r
  50   New( Vtx );\r
  51   New( XVtx );\r
  52   (* Build vertexes (yes, I know this piece of code is terrible) *)\r
  53   Randomize;\r
  54   for I:=0 to MAXVTX-1 do begin\r
  55     with CubeVtx^[I] do begin\r
  56       (* Build cube *)\r
  57       X := (longint(Random(2*EDGE))-EDGE)*$10000;\r
  58       Y := (longint(Random(2*EDGE))-EDGE)*$10000;\r
  59       Z := Toggle( EDGE*$10000 );\r
  60       case Random(3) of\r
  61         0: Swap( X, Z );\r
  62         1: Swap( Y, Z );\r
  63       end;\r
  64     end;\r
  65     with SphereVtx^[I] do begin\r
  66       (* Build sphere *)\r
  67 Retry:\r
  68       X := (longint(Random(2*RADIUS))-RADIUS);\r
  69       Y := (longint(Random(2*RADIUS))-RADIUS);\r
  70       if( X*X+Y*Y > RADIUS*RADIUS ) then goto Retry;\r
  71       Z := Toggle( Round( Sqrt( Abs( RADIUS*RADIUS-X*X-Y*Y ) ) ) );\r
  72       case Random(3) of\r
  73         0: Swap( X, Z );\r
  74         1: Swap( Y, Z );\r
  75       end;\r
  76       X := X * $10000; Y := Y * $10000; Z := Z * $10000;\r
  77     end;\r
  78   end;\r
  79   (* Initialize morphing *)\r
  80   Move( CubeVtx^, Vtx^, SizeOf(Vtx^) );\r
  81   Status := 0;\r
  82   Count := WAITCOUNT;\r
  83 end;\r
  84 \r
  85 procedure Morph;\r
  86 var\r
  87   I: integer;\r
  88 begin\r
  89   (* Fully unoptimized, slowest loop I could think of! *)\r
  90   for I:=0 to MAXVTX-1 do begin\r
  91     Vtx^[I].X := ((CubeVtx^[I].X * Morph1)+(SphereVtx^[I].X * Morph2)) div MS;\r
  92     Vtx^[I].Y := ((CubeVtx^[I].Y * Morph1)+(SphereVtx^[I].Y * Morph2)) div MS;\r
  93     Vtx^[I].Z := ((CubeVtx^[I].Z * Morph1)+(SphereVtx^[I].Z * Morph2)) div MS;\r
  94   end;\r
  95 end;\r
  96 \r
  97 var\r
  98   AX, AY, AZ: byte;\r
  99   I: word;\r
 100   C: char;\r
 101 begin\r
 102   mxInit;\r
 103   mxSetMode( MX_320x240 );\r
 104   Init;\r
 105   Page := 240;          (* Start with hidden page *)\r
 106 \r
 107   AX := 0;\r
 108   AY := 0;\r
 109   AZ := 0;\r
 110   (* Init 3D transforms, perspective is intentionally exaggerated *)\r
 111   tdSetTranslation( Trans );\r
 112   tdSetPerspective( 400*$10000, $10000, $10000 );\r
 113   C := #0;\r
 114   repeat\r
 115     tdSetRotation( AX, AY, AZ );                (* Set new angles *)\r
 116     tdTransform( Vtx^, XVtx^, MAXVTX );         (* 3D transform points *)\r
 117     tdTransformToImage( XVtx^, VVtx, MAXVTX, 160, 120+Page );\r
 118     Inc( AX, 1 );                               (* Bump angles *)\r
 119     Inc( AY, 1 );\r
 120     Inc( AZ, 2 );\r
 121     mxSetClipRegion( 0, Page, 320, 240 );       (* Set clip to new page *)\r
 122     mxSetClip( TRUE );\r
 123     mxFillBox( 0, Page, 320, 240, 0, OP_MOVE ); (* Clear screen *)\r
 124     (* Draw points *)\r
 125     for I:=0 to MAXVTX-1 do\r
 126       mxPutPixel( VVtx[I].X, VVtx[I].Y, 128 + XVtx^[I].Z shr 18 );\r
 127     mxStartLine( Page );                        (* Flip pages *)\r
 128     Page := 240-Page;\r
 129     (* Morph *)\r
 130     if( Odd(Status) ) then begin\r
 131       Morph;\r
 132       Inc( Morph1, Delta1 );\r
 133       Inc( Morph2, Delta2 );\r
 134       if( Morph1 < 0 )or( Morph2 < 0 ) then Inc( Status );\r
 135       if( Status = 4 ) then Status := 0;\r
 136     end\r
 137     else begin\r
 138       Dec( Count );\r
 139       if( Count < 0 ) then begin\r
 140         Inc( Status );\r
 141         Count :=  WAITCOUNT;\r
 142         Morph1 := InitMorph1[Status];\r
 143         Morph2 := InitMorph2[Status];\r
 144         Delta1 := InitDelta1[Status];\r
 145         Delta2 := InitDelta2[Status];\r
 146       end;\r
 147     end;\r
 148   until( KeyPressed );\r
 149 \r
 150   mxSetMode( MX_TEXT );\r
 151   mxTerm;\r
 152 end.\r