--- /dev/null
+(*\r
+ DEMO03 - Simple star animation, morphs between a cube and a sphere\r
+ (c) 1994 by Alessandro Scotti\r
+*)\r
+uses Crt, Modex, Threed;\r
+\r
+const\r
+ MAXVTX = 1000; (* Number of points *)\r
+ EDGE = 70; (* Length of cube edge *)\r
+ RADIUS = 90; (* Radius of sphere *)\r
+ WAITCOUNT = 192; (* Frames to wait for non-morphing shapes *)\r
+ MS = 32; (* Number of steps for morphing *)\r
+ Trans : TPoint = ( X:0; Y:0; Z:0 );\r
+ InitMorph1: array[ 0..3 ] of integer = ( 0, MS, 0, 0 );\r
+ InitMorph2: array[ 0..3 ] of integer = ( 0, 0, 0, MS );\r
+ InitDelta1: array[ 0..3 ] of integer = ( 0, -1, 0, +1 );\r
+ InitDelta2: array[ 0..3 ] of integer = ( 0, +1, 0, -1 );\r
+type\r
+ T2DPoint = record\r
+ X, Y: integer;\r
+ end;\r
+ T3DPointArray = array[ 0..MAXVTX-1 ] of TPoint;\r
+ P3DPointArray = ^T3DPointArray;\r
+var\r
+ CubeVtx, SphereVtx, Vtx, XVtx: P3DPointArray;\r
+ VVtx : array[ 0..MAXVTX-1 ] of T2DPoint;\r
+ Page : word;\r
+ Status, Count, Delta1, Delta2, Morph1, Morph2: integer;\r
+\r
+procedure Swap( var A, B: longint );\r
+var\r
+ L: longint;\r
+begin\r
+ L := A; A := B; B := L;\r
+end;\r
+\r
+function Toggle( A: longint ): longint;\r
+begin\r
+ Toggle := A;\r
+ if( Random(2) = 0 ) then Toggle := -A;\r
+end;\r
+\r
+procedure Init;\r
+label Retry;\r
+var\r
+ I: integer;\r
+begin\r
+ New( CubeVtx );\r
+ New( SphereVtx );\r
+ New( Vtx );\r
+ New( XVtx );\r
+ (* Build vertexes (yes, I know this piece of code is terrible) *)\r
+ Randomize;\r
+ for I:=0 to MAXVTX-1 do begin\r
+ with CubeVtx^[I] do begin\r
+ (* Build cube *)\r
+ X := (longint(Random(2*EDGE))-EDGE)*$10000;\r
+ Y := (longint(Random(2*EDGE))-EDGE)*$10000;\r
+ Z := Toggle( EDGE*$10000 );\r
+ case Random(3) of\r
+ 0: Swap( X, Z );\r
+ 1: Swap( Y, Z );\r
+ end;\r
+ end;\r
+ with SphereVtx^[I] do begin\r
+ (* Build sphere *)\r
+Retry:\r
+ X := (longint(Random(2*RADIUS))-RADIUS);\r
+ Y := (longint(Random(2*RADIUS))-RADIUS);\r
+ if( X*X+Y*Y > RADIUS*RADIUS ) then goto Retry;\r
+ Z := Toggle( Round( Sqrt( Abs( RADIUS*RADIUS-X*X-Y*Y ) ) ) );\r
+ case Random(3) of\r
+ 0: Swap( X, Z );\r
+ 1: Swap( Y, Z );\r
+ end;\r
+ X := X * $10000; Y := Y * $10000; Z := Z * $10000;\r
+ end;\r
+ end;\r
+ (* Initialize morphing *)\r
+ Move( CubeVtx^, Vtx^, SizeOf(Vtx^) );\r
+ Status := 0;\r
+ Count := WAITCOUNT;\r
+end;\r
+\r
+procedure Morph;\r
+var\r
+ I: integer;\r
+begin\r
+ (* Fully unoptimized, slowest loop I could think of! *)\r
+ for I:=0 to MAXVTX-1 do begin\r
+ Vtx^[I].X := ((CubeVtx^[I].X * Morph1)+(SphereVtx^[I].X * Morph2)) div MS;\r
+ Vtx^[I].Y := ((CubeVtx^[I].Y * Morph1)+(SphereVtx^[I].Y * Morph2)) div MS;\r
+ Vtx^[I].Z := ((CubeVtx^[I].Z * Morph1)+(SphereVtx^[I].Z * Morph2)) div MS;\r
+ end;\r
+end;\r
+\r
+var\r
+ AX, AY, AZ: byte;\r
+ I: word;\r
+ C: char;\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
+ tdSetPerspective( 400*$10000, $10000, $10000 );\r
+ C := #0;\r
+ repeat\r
+ tdSetRotation( AX, AY, AZ ); (* Set new angles *)\r
+ tdTransform( Vtx^, XVtx^, MAXVTX ); (* 3D transform points *)\r
+ tdTransformToImage( XVtx^, VVtx, MAXVTX, 160, 120+Page );\r
+ Inc( AX, 1 ); (* Bump angles *)\r
+ Inc( AY, 1 );\r
+ Inc( AZ, 2 );\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 points *)\r
+ for I:=0 to MAXVTX-1 do\r
+ mxPutPixel( VVtx[I].X, VVtx[I].Y, 128 + XVtx^[I].Z shr 18 );\r
+ mxStartLine( Page ); (* Flip pages *)\r
+ Page := 240-Page;\r
+ (* Morph *)\r
+ if( Odd(Status) ) then begin\r
+ Morph;\r
+ Inc( Morph1, Delta1 );\r
+ Inc( Morph2, Delta2 );\r
+ if( Morph1 < 0 )or( Morph2 < 0 ) then Inc( Status );\r
+ if( Status = 4 ) then Status := 0;\r
+ end\r
+ else begin\r
+ Dec( Count );\r
+ if( Count < 0 ) then begin\r
+ Inc( Status );\r
+ Count := WAITCOUNT;\r
+ Morph1 := InitMorph1[Status];\r
+ Morph2 := InitMorph2[Status];\r
+ Delta1 := InitDelta1[Status];\r
+ Delta2 := InitDelta2[Status];\r
+ end;\r
+ end;\r
+ until( KeyPressed );\r
+\r
+ mxSetMode( MX_TEXT );\r
+ mxTerm;\r
+end.\r