RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: ZXDunny on October 03, 2017, 04:53:57 PM
-
So I had a surprise day off work today, so decided to spend it productively - and went back to my landscape program. This time I modified the generator to wrap around, and then went for an XMountains style scroller. Currently it generates a landscape (that's the pause at the start) and then uses SpecBAS's interrupt driven routines to scroll the screen while it generates the next one. It uses two hidden windows as buffers for the generated scenes. You may occasionally notice a slight seam between scenes - that's unavoidable due to the post-processing being random after the heightmap generator.
The status blobs at the top left indicate the progress of generation:
Blue - idle
Red - heightmap generation
Magenta - Smoothing
Green - tree line generation
Cyan - Slope correction
Yellow - Final smooth and render.
Smoothing is the part that takes the most time.
https://www.youtube.com/watch?v=TGMn_MoMvZI
(https://s26.postimg.org/u50600mex/Image13.png)
It's quite a lot larger than my usual sort of thing, but I don't get much time to code these days:
10 REM Landscape, diamond-square algorithm
sz=size, ft=feature size,
w=water line, gl=grass line, sl=snowline, slev=smoothing level
tl=treeline, tlh=treeline height, th=max tree height
20 sz=256,ft=4,w=0,gl=.25,sl=.45,tl=.2,th=.125,tlh=.25,slev=8:
DIM m(sz*2,sz) BASE 0:
dim t(sz*2,sz) base 0:
z=sz-1,zs=sz*2-1,fs=sz/ft,wl=w,flg=0
30 DEF FN p(x,y)=m(x & zs,y & z)
40 DEF FN sq(x,y,s,f)=(FN p(x-s,y-s)+FN p(x+s,y-s)+FN p(x-s,y+s)+FN p(x+s,y+s))/4+f
50 DEF FN di(x,y,s,f)=(FN p(x-s,y)+FN p(x+s,y)+FN p(x,y+s)+FN p(x,y-s))/4+f
60 DEF FN r=RND-.5
70 DEF FN l(a)=(EXP a-1)/1.71828182845
80 def fn s(i,j)=(fn p(i-1,j)+fn p(i,j-1)+fn p(i+1,j)+fn p(i,j+1)+
fn p(i-1,j-1)+fn p(i+1,j-1)+fn p(i-1,j+1)+fn p(i+1,j+1))/8
90 go to 320
100 st=1: go sub 410:
o=sz*flg,p=sz:
for x=o+fs to sz*2 step fs;y=0 to sz step fs:
m(x & zs,y & z)=rnd:
Next y;x
110 sc=2,ss=fs:
do while ss>1:
hs=ss/2:
for y=hs to sz+hs step ss;x=hs TO sz+hs+p STEP ss:
if m(x & zs,y & z)=0 THEN
m(x & zs,y & z)=FN sq(x,y,hs,fn r*sc):
END IF:
NEXT x;y:
FOR y=0 TO sz step ss;x=0 to sz+p step ss:
if m((x+hs) & zs,y & z)=0 THEN
m((x+hs) & zs,y & z)=FN di(x+hs,y,hs,fn r*sc):
END IF:
IF m(x & zs,(y+hs) & z)=0 THEN
m(x & zs,(y+hs) & z)=FN di(x,y+hs,hs,fn r*sc):
END IF:
next x;y:
ss,sc/=2:
loop:
mat t()=m():
120 st=2: go sub 410:
maxl=0,sc=200:
for x=0 to zs;y=0 to z:
maxl=max(maxl,m(x,y)):
next y;x:
for i=1 to slev;x=0 to zs;y=0 to z:
if ((m(x,y)<maxl*tl) and m(x,y)>wl) or y=0 then
m(x,y)=fn s(x,y)
130 next y;x;i:
140 st=3: go sub 410:
tth=th*maxl:
for x=0 to zs;y=1 to z:
if m(x,y)>=maxl*tl and m(x,y)<maxl*(tl+tlh) then
m(x,y)+=(rnd*tth)-(tth/2)
150 next y;x:
160 st=4: go sub 410:
r=maxl,maxl=0:
for x=0 to zs;y=0 to z:
m(x,y)=max(wl,sc*fn l(fn l(m(x,y)/r)))-wl,
maxl=max(maxl,m(x,y)):
next y;x:
wl=0
170 st=5: go sub 410:
for x=0 to zs;y=0 to z:
m(x,y)=fn s(x,y):
next y;x
180 st=6: go sub 410:
cls 255:
yp=scrh/3:
xm=scrw/z,ym=(scrh-yp)/(sz*0.5)
190 waterline=maxl*wl,
snowline=maxl*sl,
grassline=maxl*gl,
muddle=32
200 FOR y=0 TO z-1;x=sz TO zs-1:
lv=(m(x,y)+m(x+1,y)+m(x,y+1)+m(x+1,y+1))/4,
a=x,b=y,
rx1=(x-sz)*xm,
ry1=ym*y+yp-m(a,b):
go sub 280
210 shade1=shade:
a=x+1,
rx2=rx1+xm,
ry2=ym*y+yp-m(a,b):
GO sub 280:
220 shade2=shade,
a=x,b=y+1,
ry3=ym*b+yp-m(a,b):
GO sub 280
230 shade3=shade,
a=x+1,
ry4=ym*b+yp-m(a,b):
go sub 280
240 shade4=shade,
a=x+.5,b=y+.5:
rx=xm*(a-sz),
ry=(ym*b+yp)-lv:
250 POLYGON INK shade1;rx,ry TO rx1,ry1 TO rx2,ry2 FILL:
POLYGON INK shade2;rx,ry TO rx2,ry2 TO rx2,ry4 FILL:
POLYGON INK shade3;rx,ry TO rx1,ry1 TO rx1,ry3 FILL:
POLYGON INK shade4;rx,ry TO rx1,ry3 TO rx2,ry4 FILL:
260 NEXT x;y:
270 st=7: go sub 410:
return
280 c=x+1-(b-y),
d=y+(a-x),
xc=x+.5,
yc=y+.5,
xrun1=xc-a,
xrun2=xc-c,
yrun1=yc-b,
yrun2=yc-d,
rise1=lv-m(a,b),
rise2=lv-m(c,d),
yrise=ABS(rise1*xrun2-rise2*xrun1),
yrun=ABS(yrun1*xrun2-xrun1*yrun2):
IF yrun=yrise THEN yrun,yrise=0
290 xrise=ABS(rise1*yrun2-rise2*yrun1),
xrun=ABS(xrun1*yrun2-yrun1*xrun2):
IF xrun=xrise THEN xrun,xrise=0
300 xrise,yrise/=2,
shade=62*(1-ABS(xrise/(xrun+xrise)))*(1-ABS(yrise/(yrun+yrise)))+1:
r=(rnd*muddle)-(muddle/2),
shade=IIF(lv>snowline+(r/2),min(shade+128+rnd*7,191),iif(int
lv<=waterline,min(shade+192+(rnd*30)-15,254),iif(lv<grassline+r,min(shade+64+rnd*15,127),min(shade+rnd*15,63))))
310 return
320 rem Set up buffers
330 go sub 380:
paper 255:cls 0:
print scale 4,4;at 6,7;paper 0;ink 63;"PLEASE WAIT":
window new status,2,2,60,8 transparent 255:
window status:cls 255: palette default:
st=7: go sub 410:
dim buf(2):
for f=1 to 2:
window new buf(f),0,0,scrw,scrh:
window hide buf(f):
window buf(f):
go sub 380:
next f:
buffer=0:
go sub 400:
xr=scrw
340 rem Start scrolling and copying
350 on every 2
window scroll 0,-1,0:
window copy buf(buffer+1),xr,0,1,scrh to 0,scrw-1,0:
xr+=1
360 if xr=scrw then
xr=0:
go sub 390
370 wait screen: go to 360
380 for a=0 to 63:
palette a,(a/83)*255,(a/136)*255,(a/220)*255:
palette a+64,0,(a/155)*255,0:
palette a+128,(a/63)*255,(a/63)*255,(a/63)*255:
palette a+192,0,0,(.25+(a/190))*255:
next a:
palette 255,0,64,128:
return
390 buffer=1-buffer
400 window buf((1-buffer)+1):
flg=1,wl=w:
mat m()=zer:
for x1=sz to (sz*2)-1;y1=0 to z:
m(x1-sz,y1)=t(x1,y1):
next y1;x1:
for y1=0 to z:
m(sz,y1)=t(zs,y1):
next y1:
go sub 100:
return
410 wn=cwin:
window status:
if st<7 then
text move (st-1)*9,0;ink st+1;#243
else
for f=0 to 5:
text move f*9,0;ink 1;#243:
next f:
end if:
window wn:
return
-
So Cool! :)
I remember you had a thread going at BP.org ? and I tried to translate to SmallBASIC and failed.
I have recently viewed Anne M Burns fractal (or is it recursive) art. I love this kind of stuff!
-
I thought the water could use some love. So I implemented a function using sines stacked on top of eachother to generate ripples, and took advantage of the buffer array t() to get the depth of water fragments - the intention being that waves would be larger the deeper the water.
Here's my first attempt:
(https://s1.postimg.org/85bxy2n8gf/Image2.png)
But I think it needs refinement. Maybe some surf on the crests? I dunno.
-
If you take requests, how about some waterfalls?
BTW, I hope you get a few more days off from work. ;)
-
Waterfalls would be hard. First you need to identify likely places that a spring would occur, and then "walk" down the mountain - look at the fragments in each of the 8 positions around you and choose the one with the steepest slope to proceed to. Continue until you reach bottom - a fragment that has no downward slopes around it. As you go, erode the landscape to the left and right of your position slightly, as well as the fragment you're standing on.
Then do it again. And again. And again until you have your spring, with a river that opens out to the sea or forms a lake. You can get even more technical when you hit that bottom fragment and use a flood fill algorithm to flood a few fragments around you, and any that are flooded and have downward slopes are marked as potential springs which you apply the above algorithm to.
When it's all done, you colour the fragments based on the steepness of their slope.
That gets you waterfalls, rivers and lakes.
And it's also phenomenally complex :)
-
Fantastic, Dunny!