OK i got it up to about 80fps. Basically, instead of looping over the whole area, it just loops over a smaller square for each light. To reset the whole memblock each time i'm copying from another memblock, which seems to be quick.
I also changed looping over y within x to x within y, so the positions inside the memblock consecutively read/written are closer, but this didn't really have much of an effect.
There are some other methods that could be tried but nothing simple.
Sorry for messy code. I left in some commented bits because they might be of interest. Hold space to use original code and see the speed difference.
sync on
sync rate 0
sync
cls rgb(255,255,255)
#constant _width = 320
#constant _height = 240
#constant _width2 = 319
#constant _height2 = 239
#constant _XF = 2.0 `screen width()/_width
#constant _YF = 2.0
#constant LightSources = 3
dim Light(3) as LSType
type LSType
x as integer
y as integer
intensity as float
endtype
Light(2).x = 400
Light(2).y = 350
Light(3).x = 105
Light(3).y = 165
global MemSize as integer : MemSize = 12 + 4*_width*_height
make memblock 1, MemSize
write memblock dword 1, 0, _width
write memblock dword 1, 4, _height
write memblock dword 1, 8, 32
`make a blank memblock so can reset info in 1st one
make memblock 2, MemSize
copy memblock 1,2,0,0,MemSize
for pos=15 to MemSize step 4
write memblock byte 2, pos, 255
next pos
SetupLightMask()
make image from memblock 1,1
sprite 1,0,0,1
size sprite 1, 640,480
hide sprite 1
CreateBackground(2)
ink 0xFFFFFFFF,0
position mouse 360, 210
do
paste image 2, 0,0
Light(1).x = mousex()
Light(1).y = mousey()
if spacekey() `hold space to see old version running!
UpdateLightMaskOld()
else
UpdateLightMaskB()
endif
paste sprite 1, 0,0
text 0,0, "FPS: " + str$(screen fps())
sync
loop
function CreateBackground(img)
cls
rem Boxes
for i = 1 to 30
ink 0xFF000000 + rnd(0xFFFFFF), 0
x = rnd(640) : y = rnd(480)
box x, y, x + rnd(640-x), y + rnd(480-y)
next i
rem Lines
for i = 1 to 30
ink 0xFF000000 + rnd(0xFFFFFF), 0
line rnd(640), rnd(480), rnd(640), rnd(480)
next i
rem Text
for i = 1 to 30
ink 0xFF000000 + rnd(0xFFFFFF), 0
text rnd(640), rnd(480), "Mr Tank is Skill"
next i
rem Get image
get image img,0,0,640,480,1
endfunction
function SetupLightMask()
for x = 1 to _width
for y = 1 to _height
pos = 12 + 4*(x-1 + (y-1)*_height)
write memblock dword 1, pos, 0
next y
next x
make image from memblock 1,1
endfunction
function UpdateLightMask()
pos_step=4*_width
for x = 0 to _width2
v1 = 15 + 4*x
xp = x*_XF
xd1 = Light(1).x - xp
dis1a = xd1*xd1
xd2 = Light(2).x - xp
dis2a = xd2*xd2
xd3 = Light(3).x - xp
dis3a = xd3*xd3
pos=v1
for y = 0 to _height2
`pos = v1 + 4*y*_width
yp = y*_YF
yd1 = Light(1).y - yp
dis1 = dis1a + yd1*yd1
yd2 = Light(2).y - yp
dis2 = dis2a + yd2*yd2
yd3 = Light(3).y - yp
dis3 = dis3a + yd3*yd3
`L1 = 255 - dis1/100 : if L1 < 0 then L1 = 0
`L2 = 255 - dis2/100 : if L2 < 0 then L2 = 0
`L3 = 255 - dis3/100 : if L3 < 0 then L3 = 0
remstart
if dis1>25500:L1=0:else:L1 = 255 - dis1/100:endif
if dis2>25500:L2=0:else:L2 = 255 - dis2/100:endif
if dis3>25500:L3=0:else:L3 = 255 - dis3/100:endif
L = L1 + ((255-L1)*L2)/255
L = L + ((255-L)*L3)/255
`if L > 255 then alpha = 0 else alpha = 255-L
`alpha=255-(L&&255)
alpha=(L~~255)&&255
remend
if dis1>25500:D1=255:else:D1=dis1/100:endif
if dis2>25500:D2=255:else:D2=dis2/100:endif
if dis3>25500:D3=255:else:D3=dis3/100:endif
`D=(D1*D2*D3)/(256*256)
D=(D1*D2*D3)>>16
alpha=D&&255
write memblock byte 1, pos, alpha
inc pos,pos_step
next y
next x
make image from memblock 1,1
endfunction
function UpdateLightMaskB()
REMSTART
pstep=4*_width
for x=0 to _width2
pos=15 + 4*x
for y=0 to _height2
`pos = v1 + 4*y*_width
write memblock byte 1, pos, 255 `lmask(x,y)
inc pos,pstep
next y
next x
REMEND
REMSTART
z=get memblock size(1)
for pos=15 to z step 4
write memblock byte 1, pos, 255
next pos
REMEND
copy memblock 2,1,0,0,MemSize
`^^ perhaps easier to just use copy memblock??
for li=1 to 3
startx=(Light(li).x)/_XF-80 `<< size of circles is in 160 side square..
endx=(Light(li).x)/_XF+80
starty=(Light(li).y)/_YF-80
endy=(Light(li).y)/_YF+80
if startx<0 then startx=0
if endx>_width2 then endx=_width2
if starty<0 then starty=0
if endy>_height2 then endy=_height2
for y=starty to endy
yp = y*_YF
yd1 = Light(li).y - yp
dis1 = yd1*yd1
pos=15 +4*y*_width
inc pos,4*startx
for x=startx to endx
xp = x*_XF
xd1 = Light(li).x - xp
dis1a = dis1+ xd1*xd1
if dis1a<25500
D1=dis1a/100
write memblock byte 1, pos, (memblock byte(1, pos)*D1)>>8
else
`D1=255
endif
inc pos,4
next y
next x
next lightnum
make image from memblock 1,1
endfunction
function UpdateLightMaskOld()
for x = 0 to _width2
v1 = 15 + 4*x
xp = x*_XF
xd1 = Light(1).x - xp
dis1a = xd1*xd1
xd2 = Light(2).x - xp
dis2a = xd2*xd2
xd3 = Light(3).x - xp
dis3a = xd3*xd3
for y = 0 to _height2
pos = v1 + 4*y*_width
yp = y*_YF
yd1 = Light(1).y - yp
dis1 = dis1a + yd1*yd1
yd2 = Light(2).y - yp
dis2 = dis2a + yd2*yd2
yd3 = Light(3).y - yp
dis3 = dis3a + yd3*yd3
L1 = 255 - dis1/100 : if L1 < 0 then L1 = 0
L2 = 255 - dis2/100 : if L2 < 0 then L2 = 0
L3 = 255 - dis3/100 : if L3 < 0 then L3 = 0
L = L1 + ((255-L1)*L2)/255
L = L + ((255-L)*L3)/255
if L > 255 then alpha = 0 else alpha = 255-L
write memblock byte 1, pos, alpha
next y
next x
make image from memblock 1,1
endfunction
