16/xx/modex/QIX2.PAS

   1 {$E-,N+}\r
   2 uses Crt, Modex;\r
   3 \r
   4 const\r
   5   DEFVERT = 12;         (* Vertex count *)\r
   6   DEFREPL = 3;          (* Repetition count *)\r
   7   DEFQIXS = 2;          (* Qixs *)\r
   8   FADESPEED = 48;\r
   9 type\r
  10   TPoint = record\r
  11     X, Y : integer;\r
  12   end;\r
  13   TRGB = record\r
  14     R, G, B: byte;\r
  15   end;\r
  16   TQix = record\r
  17     Color: integer;\r
  18     Vert : array[ 0..DEFVERT-1, 0..DEFREPL-1 ] of TPoint;\r
  19     Delta: array[ 0..DEFVERT-1 ] of TPoint;\r
  20   end;\r
  21 var\r
  22   Page : integer;\r
  23   MaxX,\r
  24   MaxY : word;\r
  25   Qix  : array[ 0..DEFQIXS-1 ] of TQix;\r
  26   Pal  : array[ byte ] of TRGB;\r
  27 \r
  28 type\r
  29   TReal = double;\r
  30   TRPoint = record\r
  31     X, Y: TReal;\r
  32   end;\r
  33   TMatrix = array[ 0..3, 0..3 ] of TReal;\r
  34 var\r
  35   M: TMatrix;\r
  36   G: array[ 0..DEFVERT-1 ] of TRPoint;\r
  37   C: array[ 0..DEFVERT-1 ] of TRPoint;\r
  38 \r
  39 procedure BumpPal( Idx, DR, DG, DB, Steps: integer );\r
  40 var\r
  41   I: integer;\r
  42 begin\r
  43   for I:=1 to Steps do begin\r
  44     Pal[Idx+1].R := Pal[Idx].R + DR;\r
  45     Pal[Idx+1].G := Pal[Idx].G + DG;\r
  46     Pal[Idx+1].B := Pal[Idx].B + DB;\r
  47     Inc( Idx );\r
  48   end;\r
  49 end;\r
  50 \r
  51 procedure InitPalette;\r
  52 begin\r
  53   with Pal[0] do begin R:=0; G:=0; B:=0; end;\r
  54   with Pal[1] do begin R:=0; G:=0; B:=62; end;\r
  55   BumpPal( 1,   0, 2, -2,  31 );\r
  56   BumpPal( 32,  2, -2, 0,  31 );\r
  57   BumpPal( 63,  -2, 2, 2,  31 );\r
  58   BumpPal( 94,  2, 0, -2,  31 );\r
  59   BumpPal( 125, -2, -2, 2, 31 );\r
  60 end;\r
  61 \r
  62 procedure Init( var Qix: TQix; Color: integer );\r
  63 var\r
  64   I: integer;\r
  65 begin\r
  66   FillChar( Qix.Vert, SizeOf(Qix.Vert), 0 );\r
  67   for I:=0 to DEFVERT-1 do begin\r
  68     Qix.Vert[I, DEFREPL-1].X := Random( MaxX );\r
  69     Qix.Vert[I, DEFREPL-1].Y := Random( MaxY );\r
  70     Qix.Delta[I].X := Random(5)+1;\r
  71     Qix.Delta[I].Y := Random(5)+1;\r
  72   end;\r
  73   Qix.Color := Color;\r
  74 \r
  75   (* Initialize matrix (Catmull-Rom) *)\r
  76   M[0,0] := -1/2; M[0,1] := 3/2; M[0,2] := -3/2; M[0,3] := 1/2;\r
  77   M[1,0] := 1; M[1,1] := -5/2; M[1,2] := 2; M[1,3] := -1/2;\r
  78   M[2,0] := -1/2; M[2,1] := 0; M[2,2] := 1/2; M[2,3] := 0;\r
  79   M[3,0] := 0; M[3,1] := 1; M[3,2] := 0; M[3,3] := 0;\r
  80 end;\r
  81 \r
  82 procedure mxBezier( var Qix: TQix; I0, Idx, N: integer );\r
  83 var\r
  84   I, J: integer;\r
  85   T, T2, T3: TReal;\r
  86   X0, Y0, X, Y: TReal;\r
  87   Delta: TReal;\r
  88 begin\r
  89   (* Compute coefficients *)\r
  90   for I:=0 to 3 do begin\r
  91     C[I].X := 0;\r
  92     for J:=0 to 3 do C[I].X := C[I].X + M[I,J]*Qix.Vert[(I0+J) mod DEFVERT,Idx].X;\r
  93     C[I].Y := 0;\r
  94     for J:=0 to 3 do C[I].Y := C[I].Y + M[I,J]*Qix.Vert[(I0+J) mod DEFVERT,Idx].Y;\r
  95   end;\r
  96   X0 := C[3].X;\r
  97   Y0 := C[3].Y;\r
  98   Delta := 1 / N;\r
  99   T := 0;\r
 100   for I:=1 to N do begin\r
 101     T := T + Delta;\r
 102     T2 := T*T;\r
 103     T3 := T*T2;\r
 104     X := C[0].X*T3 + C[1].X*T2 + C[2].X*T + C[3].X;\r
 105     Y := C[0].Y*T3 + C[1].Y*T2 + C[2].Y*T + C[3].Y;\r
 106     mxLine( Round(X0), Page+Round(Y0), Round(X), Page+Round(Y), Qix.Color, OP_SET );\r
 107     X0 := X;\r
 108     Y0 := Y;\r
 109   end;\r
 110 end;\r
 111 \r
 112 procedure Plot( var Qix: TQix; Idx: integer );\r
 113 var\r
 114   I, J: integer;\r
 115 begin\r
 116   for I:=0 to DEFVERT-1 do begin\r
 117     mxBezier( Qix, I, Idx, 12 );\r
 118   end;\r
 119 end;\r
 120 \r
 121 procedure Update( var Qix: TQix; Idx: integer );\r
 122 var\r
 123   I: integer;\r
 124 begin\r
 125   for I:=0 to DEFVERT-1 do with Qix do begin\r
 126     Inc( Vert[I,Idx].X, Delta[I].X );\r
 127     if( Vert[I,Idx].X < 0 ) then begin\r
 128       Vert[I,Idx].X := 0;\r
 129       Delta[I].X := Random( 5 )+1;\r
 130     end;\r
 131     if( Vert[I,Idx].X > MaxX ) then begin\r
 132       Vert[I,Idx].X := MaxX;\r
 133       Delta[I].X := -Random( 5 )-1;\r
 134     end;\r
 135     Inc( Vert[I,Idx].Y, Delta[I].Y );\r
 136     if( Vert[I,Idx].Y < 0 ) then begin\r
 137       Vert[I,Idx].Y := 0;\r
 138       Delta[I].Y := Random( 5 )+1;\r
 139     end;\r
 140     if( Vert[I,Idx].Y > MaxY ) then begin\r
 141       Vert[I,Idx].Y := MaxY;\r
 142       Delta[I].Y := -Random( 5 )-1;\r
 143     end;\r
 144   end;\r
 145 end;\r
 146 \r
 147 procedure Copy( var Qix: TQix; Dest, Src: integer );\r
 148 var\r
 149   I: integer;\r
 150 begin\r
 151   for I:=0 to DEFVERT-1 do with Qix do begin\r
 152     Vert[I,Dest].X := Vert[I,Src].X;\r
 153     Vert[I,Dest].Y := Vert[I,Src].Y;\r
 154   end;\r
 155 end;\r
 156 \r
 157 procedure AnimateQix;\r
 158 var\r
 159   Q, Idx, I, J, P, Count: integer;\r
 160 begin\r
 161   Count := 0;\r
 162   P := DEFREPL-1;\r
 163   I := 0;\r
 164   J := 1;\r
 165   repeat\r
 166     mxSetClipRegion( 0, Page, MaxX+1, MaxY+1 );\r
 167     mxSetClip( TRUE );\r
 168     mxFillBox( 0, Page, MaxX+1, MaxY+1, 0, OP_SET );\r
 169     for Q:=0 to DEFQIXS-1 do begin\r
 170       Copy( Qix[Q], I, P );\r
 171       Update( Qix[Q], I );\r
 172       for Idx:=0 to DEFREPL-1 do begin\r
 173         Plot( Qix[Q], Idx );\r
 174       end;\r
 175     end;\r
 176     I := (I+1) mod DEFREPL;\r
 177     J := (J+1) mod DEFREPL;\r
 178     P := (P+1) mod DEFREPL;\r
 179     Inc( Count );\r
 180     mxStartLine( Page );\r
 181     if( Count >= FADESPEED ) then begin\r
 182       for Q:=0 to DEFQIXS-1 do begin\r
 183         Inc( Qix[Q].Color );\r
 184         if( Qix[Q].Color > 156 ) then\r
 185           Qix[Q].Color := 1;\r
 186       end;\r
 187       Count := 0;\r
 188     end;\r
 189     Page := 240-Page;\r
 190   until( KeyPressed );\r
 191 end;\r
 192 \r
 193 var\r
 194   I: integer;\r
 195 begin\r
 196   Randomize;\r
 197   mxInit;\r
 198   mxSetMode( MX_320x240 );\r
 199   mxGetScreenSize( MaxX, MaxY );\r
 200   for I:=0 to DEFQIXS-1 do\r
 201     Init( Qix[I], (I*(155 div DEFQIXS)) mod 155 + 1 );\r
 202   InitPalette;\r
 203   mxSetPalette( @Pal, 0, 157 );\r
 204   Page := 240;\r
 205   Dec( MaxX );\r
 206   Dec( MaxY );\r
 207   AnimateQix;\r
 208   mxSetMode( MX_TEXT );\r
 209   mxTerm;\r
 210 end.\r