;*)
Can't help it Jocke... :*(
Code:
DECLARE SUB LensPlasmaRT (x%, y%, Radius%, Counter%, countdir%, Trans%)
'256*126 = 32256
'((256*126)+4)\2 =16130
'256*8 =2048
DEFINT A-Z
'$DYNAMIC
RANDOMIZE TIMER
CONST PI = 3.14151693#
CONST FALSE = 0, TRUE = NOT FALSE
DIM SHARED Vpage1%(0 TO 16130)
DIM SHARED Vpage2%(0 TO 16130)
'$STATIC
DIM SHARED div4%(0 TO 256 * 5) 'smooth
DIM SHARED div8%(0 TO 256 * 5)
DIM SHARED div16%(0 TO 256 * 5)
DIM SHARED Lpx%(0 TO 255) 'smooth
DIM SHARED div5%(0 TO 256 * 5) 'fire
DIM SHARED Scanline%(0 TO 255)
DIM SHARED Lsin1%(-1024 TO 1024)
DIM SHARED Lsin2%(-1024 TO 1024)
DIM SHARED Lsin3%(-1024 TO 1024)
DIM SHARED Lsin!(-10 TO 370)
DIM SHARED Lcos!(-10 TO 370)
DIM SHARED Ly%(0 TO 125)
DIM SHARED Sqrt%(0 TO 64 * 64)
DIM SHARED Layer1%, offs1%
DIM SHARED Layer2%, offs2%
DIM SHARED Textseg%, Textoff%
Vpage1%(0) = 2048
Vpage1%(1) = 126
Vpage2%(0) = 2048
Vpage2%(1) = 126
Textseg% = VARSEG(Texture%(2))
Textoff% = VARPTR(Texture%(2))
Layer1% = VARSEG(Vpage1%(2))
offs1% = VARPTR(Vpage1%(2))
Layer2% = VARSEG(Vpage2%(2))
offs2% = VARPTR(Vpage2%(2))
FOR i% = 0 TO 125
Ly%(i%) = i% * 256
NEXT i%
FOR i% = 0 TO 359
RA! = i% * (3.141593 / 180)
Lcos!(i%) = COS(RA!)
Lsin!(i%) = SIN(RA!)
NEXT i%
FOR i% = 0 TO 64 * 64
Sqrt%(i%) = SQR(i%)
NEXT i%
FOR i% = -1024 TO 1024
Lsin1%(i%) = SIN(i% * PI / (128)) * 256
Lsin2%(i%) = SIN(i% * PI / (64)) * 128
Lsin3%(i%) = SIN(i% * PI / (32)) * 64
NEXT i%
CLS
SCREEN 13
j! = 255 / 360 * 3
k! = 255 / 360 * 4
l! = 255 / 360 * 4
FOR i% = 0 TO 255
OUT &H3C8, i%
m% = INT(a!)
n% = INT(b!)
o% = INT(c!)
r% = 63 * ABS(SIN(m% * PI / 180))
IF r% > 63 THEN r% = 63
g% = 63 * ABS(SIN(n% * PI / 180))
IF i < 128 THEN g% = 0
b% = 32 * ABS(SIN(o% * PI / 180))
a! = a! + j!
b! = b! + k!
c! = c! + l!
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
NEXT
CLS
SCREEN 13
cd% = 1
Lensrad% = 20
raddir% = 1
countdir% = 1
DEF SEG = Layer1%
T# = TIMER
DO
F& = (F& + 1) AND &H7FFFFFFF
Counter% = (Counter% + countdir%)
IF Counter% < -700 THEN
countdir% = -countdir%
ELSEIF Counter% > 900 THEN
countdir% = -countdir%
END IF
offset% = offs1%
FOR ya% = 0 TO 125
ysin% = Lsin1%(ya% - Counter%)
FOR xa% = 0 TO 255
c% = Lsin3%(xa% - Counter%) + ysin% + Lsin2%(ya% + xa%)
POKE offset%, c%
offset% = offset% + 1
NEXT xa%
NEXT ya%
T! = (F&) * 3.141593 / 180
Lensx% = INT(COS(T! * 6) + SIN(T!) * 130)
Lensy% = INT(SIN(T! + 2) * SIN(T! * 2) * 50)
Lensx% = Lensx% + 94
Lensy% = Lensy% + 8
Lensrad% = Lensrad% + raddir%
IF Lensrad% < 20 THEN
raddir% = -raddir%
ELSEIF Lensrad% > 63 THEN
raddir% = -raddir%
END IF
LensPlasmaRT Lensx%, Lensy%, Lensrad%, c%, cd%, FALSE
LensPlasmaRT 256 - Lensx% - (Lensrad% * 2), 126 - Lensy% - (Lensrad% * 2), 20 + 63 - Lensrad%, c%, cd%, FALSE
PUT (28, 30), Vpage1%(0), PSET
LOOP UNTIL INKEY$ <> ""
Fps% = F& / (TIMER - T#)
CLS
SCREEN 0
WIDTH 80
PRINT "FPS:"; Fps%
PRINT "Fire by Relsoft"
c$ = INPUT$(1)
END
END
SUB Grad (col1, r1, g1, b1, col2, r2, g2, b2)
cols = col2 - col1 + 1
rstep! = (r2 - r1) / cols
gstep! = (g2 - g1) / cols
bstep! = (b2 - b1) / cols
r! = r1
g! = g1
b! = b1
FOR col = col1 TO col2
r! = r! + rstep!
g! = g! + gstep!
b! = b! + bstep!
red% = INT(r!)
Green% = INT(g!)
Blue% = INT(b!)
OUT &H3C8, col
OUT &H3C9, red%
OUT &H3C9, Green%
OUT &H3C9, Blue%
NEXT col
END SUB
SUB LensPlasmaRT (x%, y%, Radius%, Counter%, countdir%, Trans%) STATIC
'RealTime Lens with Plasma
SphereHeight% = 15
Cleaner% = SphereHeight% * 10
RadiusSquared% = Radius% * Radius%
Xsize% = Radius% * 2
ysize% = Xsize%
newx% = x% 'get coords
newy% = y%
minx% = 0
miny% = 0
'Clip/Crop it
IF newy% < 0 THEN
CY = -newy%
ysize% = ysize% - CY
newy% = 0
miny% = CY
ELSEIF newy% > 125 THEN
EXIT SUB
ELSE
Ndy = newy% + ysize%
IF Ndy > 125 THEN
ysize% = ysize% - (Ndy - (126))
END IF
END IF
IF newx% < 0 THEN
CX = -newx%
Xsize% = Xsize% - CX
newx% = 0
minx% = CX
ELSEIF newx% > 255 THEN
EXIT SUB
ELSE
Ndx = newx% + Xsize%
IF Ndx > 255 THEN
Xsize% = Xsize% - (Ndx - 256)
END IF
END IF
Counter% = (Counter% + countdir%)
IF Counter% < -700 THEN
countdir% = -countdir%
ELSEIF Counter% > 900 THEN
countdir% = -countdir%
END IF
rot% = 64 * (((Counter% AND 1) = 1) OR 1)
IF NOT Trans% THEN
FOR yt% = 0 TO ysize% - 1
FOR xt% = 0 TO Xsize% - 1
x1% = (xt% - Radius%) + minx%
y1% = (yt% - Radius%) + miny%
HypotSquared% = (x1% * x1%) + (y1% * y1%)
IF HypotSquared% < (RadiusSquared% - Cleaner%) THEN 'clean some nasty model errors
H% = Sqrt%(RadiusSquared% - HypotSquared%)
Sx% = (SphereHeight% - H%)
Sy% = (SphereHeight% - H%)
Sx% = Sx% * (x1% / H%) 'Here is the actual height calcs
Sy% = Sy% * (y1% / H%) 'XY/H is for normalization
py% = (Sy% + yt% + newy%)
px% = (Sx% + xt% + newx%)
c% = Lsin3%(px% - Counter%) + Lsin1%(py% - Counter%) + Lsin2%(py% + px)
POKE offs1% + Ly%(newy% + yt%) + newx% + xt%, c%
END IF
NEXT xt%
NEXT yt%
ELSE
xsizeCleaner% = (Xsize% AND 1)
FOR yt% = 0 TO ysize% - 1
FOR xt% = 0 TO Xsize% - xsizeCleaner%
x1% = (xt% - Radius%) + minx%
y1% = (yt% - Radius%) + miny%
rot% = -rot%
HypotSquared% = (x1% * x1%) + (y1% * y1%)
IF HypotSquared% < (RadiusSquared% - Cleaner%) THEN 'clean some nasty model errors
H% = Sqrt%(RadiusSquared% - HypotSquared%)
Sx% = (SphereHeight% - H%)
Sy% = (SphereHeight% - H%)
Sx% = Sx% * (x1% / H%) 'Here is the actual height calcs
Sy% = Sy% * (y1% / H%) 'XY/H is for normalization
py% = (Sy% + yt% + newy%)
px% = (Sx% + xt% + newx%)
c% = Lsin3%(px% + rot%) + Lsin1%(px% + rot% + Counter%) + Lsin2%(py% + rot%)
POKE offs1% + Ly%(newy% + yt%) + newx% + xt%, c%
END IF
NEXT xt%
NEXT yt%
END IF
END SUB
![[Image: jocke.gif]](http://jocke.phatcode.net/jocke.gif)
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)