3D Land (Sample Programs)

by Andrew360 @, Saturday, June 08, 2013, 15:46 (1449 days ago)

The forums haven't been active for a while, so I decided to post something that I made a while ago. If you find any bugs it would be appreciated if you posted them.

units=100
seed=10
#Seed>0

units=units+4
graphvisible 0
graphsize units*5,units*5
global world
fastgraphics
color black
rect 0,0,units*5,units*5
color clear
rect 5,5,units*5-10,units*5-10
color black
opsnum=16
xs={0,1,1,1,0,-1,-1,-1,5,-5,5,-5,0,0,5,-5}
ys={1,1,0,-1,-1,-1,0,1,-5,5,5,-5,5,-5,0,0}
for iteration=1 to 3
xpos=units*2.5
ypos=xpos
do
dim ops(opsnum)
stuck=true
for i=0 to opsnum-1
ops[i]=0
if pixel(xpos+xs[i],ypos+ys[i])=clear then ops[i]=1 : stuck=false
next i
if not stuck then
do
seed=(seed*7)%257
choice=seed%16
until ops[choice]=1
xpos=xpos+xs[choice]
ypos=ypos+ys[choice]
endif
plot xpos,ypos
until stuck
next iteration
dim world(units,units)
for x=0 to units*5-1
for y=0 to units*5-1
if pixel(x,y)=clear then world[int(x/5),int(y/5)]=world[int(x/5),int(y/5)]+1
next y
next x
for x=0 to units-1
for y=0 to units-1
color rgb(world[x,y]*10,world[x,y]*10,world[x,y]*10)
rect x*5,y*5,5,5
next y
next x
dim world(units,units)
for x=0 to units-1
for y=0 to units-1
world[x,y]=(pixel(x*5,y*5)%256+pixel(x*5+5,y*5)%256+ pixel(x*5,y*5+5)%256+pixel(x*5-5,y*5)%256+pixel(x*5,y*5-5)%256)/50
if x=0 or x=units-1 or y=0 or y=units-1 then world[x,y]=0
next y
next x
units=units-4
graphsize 650,400
outputvisible 0
graphvisible 1

ypos=units/2
xpos=ypos
frame=0
oneday=500

do
if frame=oneday then frame=0
frame=frame+1
color black
rect 0,0,700,400
b=((sin((frame*pi*2/oneday))+2)/3)
wl=119+sin((frame*pi*2/oneday)-(pi*1.5))*3
dim xps(25,25)
dim yps(25,25)
dim hps(25,25)
dim wps(25,25)
For y1 = 0 to 24
For x1 = 0 to 24
xps[x1,y1]=12*(24-x1)+12*y1+35
y=-6*(24-x1)+6*y1+100
h=world[x1+xpos-12,y1+ypos-12]*5
hps[x1,y1]=h
if h>wl then
y=y+wl
wps[x1,y1]=1
else
y=y+h
wps[x1,y1]=0
endif
yps[x1,y1]=y
next x1
next y1
For y1 = 0 to 23
For x1 = 0 to 23
color rgb(hps[x1,y1]/3*b,hps[x1,y1]*b,hps[x1,y1]/3*b)
if wps[x1,y1] then color rgb(0,0,255*b)
poly {xps[x1,y1],yps[x1,y1],xps[x1+1,y1],yps[x1+1,y1],xps[x1+1,y1+1], yps[x1+1,y1+1],xps[x1,y1+1],yps[x1,y1+1]}
next x1
next y1
color white
circle 50,50,50
color black
circle 50,50,47
color yellow
circle 50,10,7
color grey
circle 50,90,7
color black
circle 53,90,5
color white
circle 50,50,4
line 0,50,100,50
line 50,50,50-cos(frame*pi*2/oneday)*48,50-sin(frame*pi*2/oneday)*48
if 1 then
scale=units/100

res=4 #1=best,10=worst

for x=0 to 99 step res
for y=0 to 99 step res
h=world[x*scale,y*scale]*5
color rgb(h/3,h,h/3)
if h>wl then color blue
rect y,300+x,res,res
next y
next x
color red
plot ypos/scale,300+xpos/scale
endif
refresh
a=key
if a=16777235 then xpos=xpos-1#:ypos=ypos-1
if a=16777237 then xpos=xpos+1#:ypos=ypos+1
if a=16777236 then ypos=ypos+1#:xpos=xpos-1
if a=16777234 then ypos=ypos-1#:xpos=xpos+1
if ypos<14 then ypos=14
if xpos<14 then xpos=14
if ypos>units-12 then ypos=units-12
if xpos>units-12 then xpos=units-12
until 0

RSS Feed of thread
powered by my little forum