07-30-2023, 01:02 PM
I tried a variation on my recent blur on this. Not a laser, but more of a "blaster" bolt thing. I imagine that the addition of Rotozoom and vector tracks would make it possible to orient the shot.
Code: (Select All)
SCREEN _NEWIMAGE(1024, 512, 32)
DIM a%(-8 TO 8)
a%(-8) = 0: a%(-7) = 1: a%(-6) = 2: a%(-5) = 3: a%(-4) = 4: a%(-3) = 5: a%(-2) = 6: a%(-1) = 7
a%(0) = 8
a%(1) = 7: a%(2) = 6: a%(3) = 5: a%(4) = 4: a%(5) = 3: a%(6) = 2: a%(7) = 1: a%(8) = 0
DIM kern%(LBOUND(a%) TO UBOUND(a%), LBOUND(a%) TO UBOUND(a%))
FOR x% = LBOUND(kern%, 1) TO UBOUND(kern%, 1) ' iterate kernel matrix columns
FOR y% = LBOUND(kern%, 2) TO UBOUND(kern%, 2) ' iterate kernel matrix rows
kern%(x%, y%) = a%(x%) * a%(y%) ' seed the gaussian kernel position
NEXT y%, x%
mult! = 255 / kern%(0, 0) ' set a multiplier to prevent alpha bleed through
blasterbolt& = _NEWIMAGE(200, 40, 32)
bloom& = _COPYIMAGE(blasterbolt&)
_DEST blasterbolt&
CLS , &H00000000
c~& = _RGBA32(211, 255, 172, 255)
FOR x% = 20 TO 160
r = x% / 20
FCirc x%, 20, r, c~&
NEXT x%
_DEST bloom&
FOR ox% = 0 TO _WIDTH(blasterbolt&) - 1 '
FOR oy% = 0 TO _HEIGHT(blasterbolt&) - 1 '
_SOURCE blasterbolt& ' source: clear image
c~& = POINT(ox%, oy%) ' get source pixel color at (ox%, oy%)
_DEST bloom& ' destination: blurred receiving image
FOR x% = LBOUND(kern%, 1) TO UBOUND(kern%, 1) ' apply the alpha matrix around original point
FOR y% = LBOUND(kern%, 2) TO UBOUND(kern%, 2)
PSET (ox% + x%, oy% + y%), _RGBA32(_RED32(c~&), _GREEN32(c~&), _BLUE32(c~&), mult! * kern%(x%, y%))
NEXT y%, x%
NEXT oy%, ox%
_DEST 0 '
hbb& = _COPYIMAGE(bloom&, 33)
DO
x% = 0
DO
CLS
_PUTIMAGE (x%, 256), hbb&
x% = x% + 1
_LIMIT 2000
_DISPLAY
LOOP UNTIL x% > 1024
LOOP UNTIL _KEYDOWN(27)
END
SUB FCirc (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG) 'Steve's circle fill
DIM AS LONG R, RError, X, Y
R = ABS(RR) ' radius value along positive x
RError = -R ' opposite side of circle? negative x
X = R ' point along positive x position
Y = 0 ' starting at the equator
IF R = 0 THEN PSET (CX, CY), C: EXIT SUB ' zero radius is point, not circle
LINE (CX - X, CY)-(CX + X, CY), C, BF ' draw equatorial line
WHILE X > Y
RError = RError + Y * 2 + 1
IF RError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw line above equator
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw line below equator
END IF
X = X - 1
RError = RError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF ' draw line north latitudes
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF ' draw line south latitudes
WEND
END SUB 'FCirc
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
sha_na_na_na_na_na_na_na_na_na:
