--- /dev/null
+{$E-,N+}\r
+uses Crt, Modex;\r
+\r
+const\r
+ DEFVERT = 12; (* Vertex count *)\r
+ DEFREPL = 3; (* Repetition count *)\r
+ DEFQIXS = 2; (* Qixs *)\r
+ FADESPEED = 48;\r
+type\r
+ TPoint = record\r
+ X, Y : integer;\r
+ end;\r
+ TRGB = record\r
+ R, G, B: byte;\r
+ end;\r
+ TQix = record\r
+ Color: integer;\r
+ Vert : array[ 0..DEFVERT-1, 0..DEFREPL-1 ] of TPoint;\r
+ Delta: array[ 0..DEFVERT-1 ] of TPoint;\r
+ end;\r
+var\r
+ Page : integer;\r
+ MaxX,\r
+ MaxY : word;\r
+ Qix : array[ 0..DEFQIXS-1 ] of TQix;\r
+ Pal : array[ byte ] of TRGB;\r
+\r
+type\r
+ TReal = double;\r
+ TRPoint = record\r
+ X, Y: TReal;\r
+ end;\r
+ TMatrix = array[ 0..3, 0..3 ] of TReal;\r
+var\r
+ M: TMatrix;\r
+ G: array[ 0..DEFVERT-1 ] of TRPoint;\r
+ C: array[ 0..DEFVERT-1 ] of TRPoint;\r
+\r
+procedure BumpPal( Idx, DR, DG, DB, Steps: integer );\r
+var\r
+ I: integer;\r
+begin\r
+ for I:=1 to Steps do begin\r
+ Pal[Idx+1].R := Pal[Idx].R + DR;\r
+ Pal[Idx+1].G := Pal[Idx].G + DG;\r
+ Pal[Idx+1].B := Pal[Idx].B + DB;\r
+ Inc( Idx );\r
+ end;\r
+end;\r
+\r
+procedure InitPalette;\r
+begin\r
+ with Pal[0] do begin R:=0; G:=0; B:=0; end;\r
+ with Pal[1] do begin R:=0; G:=0; B:=62; end;\r
+ BumpPal( 1, 0, 2, -2, 31 );\r
+ BumpPal( 32, 2, -2, 0, 31 );\r
+ BumpPal( 63, -2, 2, 2, 31 );\r
+ BumpPal( 94, 2, 0, -2, 31 );\r
+ BumpPal( 125, -2, -2, 2, 31 );\r
+end;\r
+\r
+procedure Init( var Qix: TQix; Color: integer );\r
+var\r
+ I: integer;\r
+begin\r
+ FillChar( Qix.Vert, SizeOf(Qix.Vert), 0 );\r
+ for I:=0 to DEFVERT-1 do begin\r
+ Qix.Vert[I, DEFREPL-1].X := Random( MaxX );\r
+ Qix.Vert[I, DEFREPL-1].Y := Random( MaxY );\r
+ Qix.Delta[I].X := Random(5)+1;\r
+ Qix.Delta[I].Y := Random(5)+1;\r
+ end;\r
+ Qix.Color := Color;\r
+\r
+ (* Initialize matrix (Catmull-Rom) *)\r
+ M[0,0] := -1/2; M[0,1] := 3/2; M[0,2] := -3/2; M[0,3] := 1/2;\r
+ M[1,0] := 1; M[1,1] := -5/2; M[1,2] := 2; M[1,3] := -1/2;\r
+ M[2,0] := -1/2; M[2,1] := 0; M[2,2] := 1/2; M[2,3] := 0;\r
+ M[3,0] := 0; M[3,1] := 1; M[3,2] := 0; M[3,3] := 0;\r
+end;\r
+\r
+procedure mxBezier( var Qix: TQix; I0, Idx, N: integer );\r
+var\r
+ I, J: integer;\r
+ T, T2, T3: TReal;\r
+ X0, Y0, X, Y: TReal;\r
+ Delta: TReal;\r
+begin\r
+ (* Compute coefficients *)\r
+ for I:=0 to 3 do begin\r
+ C[I].X := 0;\r
+ for J:=0 to 3 do C[I].X := C[I].X + M[I,J]*Qix.Vert[(I0+J) mod DEFVERT,Idx].X;\r
+ C[I].Y := 0;\r
+ for J:=0 to 3 do C[I].Y := C[I].Y + M[I,J]*Qix.Vert[(I0+J) mod DEFVERT,Idx].Y;\r
+ end;\r
+ X0 := C[3].X;\r
+ Y0 := C[3].Y;\r
+ Delta := 1 / N;\r
+ T := 0;\r
+ for I:=1 to N do begin\r
+ T := T + Delta;\r
+ T2 := T*T;\r
+ T3 := T*T2;\r
+ X := C[0].X*T3 + C[1].X*T2 + C[2].X*T + C[3].X;\r
+ Y := C[0].Y*T3 + C[1].Y*T2 + C[2].Y*T + C[3].Y;\r
+ mxLine( Round(X0), Page+Round(Y0), Round(X), Page+Round(Y), Qix.Color, OP_SET );\r
+ X0 := X;\r
+ Y0 := Y;\r
+ end;\r
+end;\r
+\r
+procedure Plot( var Qix: TQix; Idx: integer );\r
+var\r
+ I, J: integer;\r
+begin\r
+ for I:=0 to DEFVERT-1 do begin\r
+ mxBezier( Qix, I, Idx, 12 );\r
+ end;\r
+end;\r
+\r
+procedure Update( var Qix: TQix; Idx: integer );\r
+var\r
+ I: integer;\r
+begin\r
+ for I:=0 to DEFVERT-1 do with Qix do begin\r
+ Inc( Vert[I,Idx].X, Delta[I].X );\r
+ if( Vert[I,Idx].X < 0 ) then begin\r
+ Vert[I,Idx].X := 0;\r
+ Delta[I].X := Random( 5 )+1;\r
+ end;\r
+ if( Vert[I,Idx].X > MaxX ) then begin\r
+ Vert[I,Idx].X := MaxX;\r
+ Delta[I].X := -Random( 5 )-1;\r
+ end;\r
+ Inc( Vert[I,Idx].Y, Delta[I].Y );\r
+ if( Vert[I,Idx].Y < 0 ) then begin\r
+ Vert[I,Idx].Y := 0;\r
+ Delta[I].Y := Random( 5 )+1;\r
+ end;\r
+ if( Vert[I,Idx].Y > MaxY ) then begin\r
+ Vert[I,Idx].Y := MaxY;\r
+ Delta[I].Y := -Random( 5 )-1;\r
+ end;\r
+ end;\r
+end;\r
+\r
+procedure Copy( var Qix: TQix; Dest, Src: integer );\r
+var\r
+ I: integer;\r
+begin\r
+ for I:=0 to DEFVERT-1 do with Qix do begin\r
+ Vert[I,Dest].X := Vert[I,Src].X;\r
+ Vert[I,Dest].Y := Vert[I,Src].Y;\r
+ end;\r
+end;\r
+\r
+procedure AnimateQix;\r
+var\r
+ Q, Idx, I, J, P, Count: integer;\r
+begin\r
+ Count := 0;\r
+ P := DEFREPL-1;\r
+ I := 0;\r
+ J := 1;\r
+ repeat\r
+ mxSetClipRegion( 0, Page, MaxX+1, MaxY+1 );\r
+ mxSetClip( TRUE );\r
+ mxFillBox( 0, Page, MaxX+1, MaxY+1, 0, OP_SET );\r
+ for Q:=0 to DEFQIXS-1 do begin\r
+ Copy( Qix[Q], I, P );\r
+ Update( Qix[Q], I );\r
+ for Idx:=0 to DEFREPL-1 do begin\r
+ Plot( Qix[Q], Idx );\r
+ end;\r
+ end;\r
+ I := (I+1) mod DEFREPL;\r
+ J := (J+1) mod DEFREPL;\r
+ P := (P+1) mod DEFREPL;\r
+ Inc( Count );\r
+ mxStartLine( Page );\r
+ if( Count >= FADESPEED ) then begin\r
+ for Q:=0 to DEFQIXS-1 do begin\r
+ Inc( Qix[Q].Color );\r
+ if( Qix[Q].Color > 156 ) then\r
+ Qix[Q].Color := 1;\r
+ end;\r
+ Count := 0;\r
+ end;\r
+ Page := 240-Page;\r
+ until( KeyPressed );\r
+end;\r
+\r
+var\r
+ I: integer;\r
+begin\r
+ Randomize;\r
+ mxInit;\r
+ mxSetMode( MX_320x240 );\r
+ mxGetScreenSize( MaxX, MaxY );\r
+ for I:=0 to DEFQIXS-1 do\r
+ Init( Qix[I], (I*(155 div DEFQIXS)) mod 155 + 1 );\r
+ InitPalette;\r
+ mxSetPalette( @Pal, 0, 157 );\r
+ Page := 240;\r
+ Dec( MaxX );\r
+ Dec( MaxY );\r
+ AnimateQix;\r
+ mxSetMode( MX_TEXT );\r
+ mxTerm;\r
+end.\r
projects / 16.git / blobdiff