'Blobs on Plasma in translucent mode!!! 'I intentionally used long integers so that this would 'run inside the IDE. 'Relsoft 2003 DECLARE SUB DrawBlob (bx%, by%) DECLARE SUB Blobs (Fps%, Vsynch%, MaxFrame%, Intensity%) DEFINT A-Z TYPE PartType x AS INTEGER y AS INTEGER xv AS INTEGER yv AS INTEGER tx AS INTEGER ty AS INTEGER Angle AS INTEGER newtarget AS INTEGER END TYPE RANDOMIZE TIMER CONST PI = 3.14151693# CONST FALSE = 0, TRUE = NOT FALSE '$DYNAMIC DIM SHARED Vpage1%(0 TO 32001) 'our Buffer '$STATIC DIM SHARED Lsin1%(-1024 TO 1024) 'some sinus precalcs DIM SHARED Lsin2%(-1024 TO 1024) 'to speed things up DIM SHARED Lsin3%(-1024 TO 1024) 'used for Plasma DIM SHARED Lsin!(-10 TO 370) 'ditto but single DIM SHARED Lcos!(-10 TO 370) 'used for Particles DIM SHARED Ly&(0 TO 199) 'y lookuptable DIM SHARED Light%(127, 127) 'the lightmap DIM SHARED Layer1%, Offs1% 'Easy reference of 'our Buffer Vpage1%(0) = 320 * 8 'PUT/GET stuff Vpage1%(1) = 200 Layer1% = VARSEG(Vpage1%(2)) ';*) Offs1% = VARPTR(Vpage1%(2)) FOR i% = 0 TO 199 'Prefcalc Y lookup Ly&(i%) = i% * 320& NEXT i% FOR i% = 0 TO 359 'Cosine/Sine LUT RA! = i% * (3.141593 / 180) Lcos!(i%) = COS(RA!) Lsin!(i%) = SIN(RA!) NEXT i% CLS SCREEN 13 Vsynch% = FALSE 'No WAIT Blobs Fps%, Vsynch%, MaxFrame%, 512 CLS SCREEN 0 WIDTH 80 PRINT "FPS:"; Fps% c$ = INPUT$(1) END SUB Blobs (Fps%, Vsynch%, MaxFrame%, Intensity%) Numblobs = 20 'Number of particles DIM blob(Numblobs) AS PartType FOR i% = 0 TO UBOUND(blob) 'Init blob(i%).x = 160 blob(i%).y = 100 blob(i%).Angle = 0 NEXT i% FOR x% = -64 TO 63 'Calc lightmap FOR y% = -64 TO 63 IF x% = 0 AND y% = 0 THEN c% = 255 ELSE c% = ((8 / SQR((x% * x%) + (y% * y%))) * Intensity%) - (SQR((x% * x%) + (y% * y%)) * 2) END IF IF c% < 0 THEN c% = 0 IF c% > 255 THEN c% = 255 Light%(x% + 64, y% + 64) = c% NEXT y% NEXT x% FOR i% = -1024 TO 1024 Lsin1%(i%) = SIN(i% * PI / (128)) * 16 'Precalc x,y,z Lsin2%(i%) = SIN(i% * PI / (64)) * 32 'and scale factor Lsin3%(i%) = SIN(i% * PI / (32)) * 16 NEXT i% j! = 255 / 360 * 3 'Sinus interpolation of our palette k! = 255 / 360 * 2 l! = 255 / 360 * 5 FOR i% = 0 TO 255 OUT &H3C8, i% m% = INT(a!) n% = INT(b!) o% = INT(c!) r% = 63 * ABS(SIN(m% * PI / 180)) g% = 63 * ABS(SIN(n% * PI / 180)) b% = 63 * ABS(SIN(o% * PI / 180)) a! = a! + j! b! = b! + k! c! = c! + l! OUT &H3C9, r% OUT &H3C9, g% OUT &H3C9, b% NEXT F& = 0 Tim# = TIMER DEF SEG = Layer1% countdir% = -1 switch& = 1 DO F& = (F& + 1) AND &H7FFFFFFF REDIM Vpage1%(0 TO 32001) 'CLS Vpage1%(0) = 320 * 8 Vpage1%(1) = 200 FOR i% = 0 TO UBOUND(blob) GOSUB DoBlobs 'Move Particles NEXT i% FOR i% = 0 TO UBOUND(blob) bx% = blob(i%).x by% = blob(i%).y DrawBlob bx%, by% 'Draw NEXT i% counter% = (counter% + countdir%) IF counter% < -700 THEN countdir% = -countdir% ELSEIF counter% > 400 THEN countdir% = -countdir% END IF offset& = Offs1% FOR ya% = 0 TO 199 ysin% = Lsin1%(ya% - counter%) FOR xa% = 0 TO 319 dc% = PEEK(offset&) IF dc% > 40 AND dc% <= 84 THEN c% = Lsin1%(xa% - counter%) + Lsin1%(ya% - counter%) + ya% c% = Lsin3%(c% + Lsin2%(x% - counter%) - ya% + counter%) + xa% c% = c% + Lsin2%(xa% - ya% + counter%) + Lsin1%(ya% - Lsin2%(xa% - counter% + c%)) c% = c% + Lsin3%(c% + Lsin1%(x% - counter%) - ya% + counter%) + xa% ELSEIF dc% > 84 AND (switch& AND 1) THEN 'alternate it c% = Lsin1%(xa% - counter%) + Lsin1%(ya% - counter%) + ya% c% = Lsin3%(c% + Lsin2%(x% - counter%) - ya% + counter%) + xa% c% = c% + Lsin2%(xa% - ya% + counter%) + Lsin1%(ya% - Lsin2%(xa% - counter% + c%)) c% = c% + Lsin3%(c% + Lsin1%(x% - counter%) - ya% + counter%) + xa% ELSE c% = Lsin3%(xa% - counter%) + ysin% + Lsin2%(ya% + xa%) + Lsin3%(ysin%) c% = Lsin1%(Lsin2%(Lsin3%(c% + ysin% + xa% + counter%))) + Lsin3%(Lsin2%(Lsin1%(c% + ysin% + xa% + counter%))) c% = c% + Lsin1%(Lsin2%(Lsin3%(c% + ysin% + xa% + counter%))) + Lsin3%(Lsin2%(Lsin1%(c% + ysin% + xa% + counter%))) END IF POKE offset&, c% offset& = offset& + 1 switch& = switch& + 1 NEXT xa% switch& = switch& - 1 'move 1 pixel back NEXT ya% IF Vsynch% THEN WAIT &H3DA, 8 PUT (0, 0), Vpage1%(0), PSET 'Blit LOOP UNTIL INKEY$ <> "" Fps% = F& / (TIMER - Tim#) ERASE blob EXIT SUB DoBlobs: IF blob(i%).newtarget THEN blob(i%).tx = INT(RND * 320) blob(i%).ty = INT(RND * 200) blob(i%).newtarget = FALSE END IF 'move the blobs blob(i%).xv = (Lcos!(blob(i%).Angle)) * 3 blob(i%).yv = (Lsin!(blob(i%).Angle)) * 3 blob(i%).x = blob(i%).x + blob(i%).xv blob(i%).y = blob(i%).y + blob(i%).yv 'Check proximity IF ABS(blob(i%).tx - blob(i%).x) AND ABS(blob(i%).ty - blob(i%).y) < 5 THEN blob(i%).newtarget = TRUE END IF 'Modified DOT product. 'Check if Result>0 then Dec else Inc 'the actual angle is not important Dot = ((blob(i%).yv * (blob(i%).tx - blob(i%).x)) - (blob(i%).xv * (blob(i%).ty - blob(i%).y))) IF Dot > 0 THEN blob(i%).Angle = (blob(i%).Angle - 3) IF blob(i%).Angle < 0 THEN blob(i%).Angle = blob(i%).Angle + 360 ELSE blob(i%).Angle = (blob(i%).Angle + 3) MOD 360 END IF RETURN END SUB SUB DrawBlob (bx%, by%) 'Draws a blob using a lightmap 'Bx=Blobx coord x% = bx% - 64 'Restore coord to new coord y% = by% - 64 'correct center offset xsize% = 128 ysize% = 128 newx% = x% 'get coords newy% = y% minx% = 0 'Lightmap offset correctors miny% = 0 'Clip/Crop it IF newy% < 0 THEN CY = -newy% ysize% = ysize% - CY newy% = 0 miny% = CY ELSEIF newy% > 199 THEN EXIT SUB ELSE Ndy = newy% + ysize% IF Ndy > 199 THEN ysize% = ysize% - (Ndy - (200)) END IF END IF IF newx% < 0 THEN CX = -newx% xsize% = xsize% - CX newx% = 0 minx% = CX ELSEIF newx% > 319 THEN EXIT SUB ELSE Ndx = newx% + xsize% IF Ndx > 319 THEN xsize% = xsize% - (Ndx - 320) END IF END IF 'Draw offset& = Offs1% + Ly&(newy%) + newx% 'Start offset FOR y% = 0 TO ysize% - 1 FOR x% = 0 TO xsize% - 1 c% = Light%(x% + minx%, y% + miny%) 'Correct Light offset IF c% THEN oc% = PEEK(offset& + x%) occ% = c% + oc% 'Combine colors IF occ% > 255 THEN occ% = 255 END IF POKE offset& + x%, occ% END IF NEXT x offset& = offset& + 320 NEXT y END SUB