+++ /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