平野作りました！

海抜が一定値以内の部分を平らにして、平野作ってみました(≧∇≦)b
海もマシちょっと増やしました(●´ω｀●)

プログラムはこちら：

'
' ”勾配＊フェード関数”の基本パターンの重ね合わせによるパーリンノイズ by みなつ
'
' 平野付き 海マシ バージョン
'
'
option strict
acls
'var SW=640,SH=360
var SW=1280,SH=720
var CX=SW/2,CY=SH/2
xscreen SW,SH

var camz=50

var grid=128
dim g[grid*4+1,grid*4+1]
var gridCenter=grid*2
basePerlin

var vramW=256,vramH=256
dim vram[vramW,vramH]

var tall=64,plain=0.1,t,th=0.2,tmag=(1-plain)/(1-plain-th)*1.0
var os=1


width 16
color #lime

while 1
 cls:gcls
 var h
 for h=0 to 300
  gline SW-10,SH-h,SW-1,SH-h,byg2rgb(h,1)
 next

 fill vram,0
 locate 0,(SH div 16)-1
 var o
 for o=os to os+5
  var oct=pow(2,o),amp=pow(2,o-os)
  ?format$("Octave=%d Amp=1/%d",o+1,amp)
  make 1/oct,1/amp
  viewVram
 next
 wait 60*5
wend
'drawAll
end

def drawAll
 var x,y
 for y=0 to vramH-1
  for x=0 to vramW-1
   var c=(1+vram[x,y])*128
   gpset x,y,rgb(c,c,c)
  next
 next
end

def make scl,amp
 var ix,iy,stp=grid*scl
 for iy=-stp to vramH-1+stp step stp
  for ix=-stp to vramW-1+stp step stp
   rotDraw ix,iy,scl,rad(rnd(360)),amp
  next
 next
end

def rotDraw x,y,scl,th,amp
 var u,v,size=grid*scl
 for v=max(-size,y-(VramH-1)) to min(size,y)
  for u=max(-size,-x) to min(size,vramW-1-x)
   var px=gridCenter+(u*cos(th)-v*sin(th))/scl
   var py=gridCenter+(u*sin(th)+v*cos(th))/scl
   if px<0 || py<0 || px>grid*4 || py>grid*4 then continue
   var gx=x+u
   var gy=y-v
   inc vram[gx,gy],g[px,py]*amp
   var c=(1+vram[gx,gy])*128
   gpset gx,gy,rgb(c,c,c)
  next
 next
end

def basePerlin
 'var maxc=0

 var x,y
 var gradU=1,gradV=0
 for y=-grid to grid
  var v=y/grid
  var fv=1-fad(abs(v))
  for x=-grid to grid
   var u=x/grid
   var fu=1-fad(abs(u))

   var c=(u*gradU+v*gradV)*fu*fv
   g[gridCenter+x,gridCenter+y]=c
   'c=(u*gradU+v*gradV)
   'c=fu*fv
   'maxc=max(maxc,c)
   '?c
   'c=(1+c/0.27)*128
   'c=(1+c)*128
   'var col=rgb(c,c,c)
   'gpset CX+x,CY-y,col
  next
 next
 '?"max=";maxc
end

def fad(t)
 return t*t*t*(t*(t*6-15)+10)
end

def viewVram
 dim cam[3],camTo[3]
 set camTo,0,0,0 'カメラの注視点

 var th=rad(-90+20)
 var r=max(vramW,vramH)*0.9
 set cam,r*cos(th),r*0.9,r*sin(th) 'カメラの位置
 drawVram cam,camTo
end

def drawVram cam,camTo
 dim gx1[0],gy1[0]
 dim gx2[0],gy2[0]
 dim gx3[0],gy3[0]
 dim gx4[0],gy4[0]
 dim col[0]
 dim mz[0]

 dim ck[3]:sub ck,camTo,cam:norm ck
 dim ci[3]:roty ci,ck,pi()/2:ci[1]=0:norm ci
 dim cj[3]:cross cj,ck,ci:norm cj

 var i,j,stp=2
 for j=-vramH/2 to (vramH-1)/2-stp step stp
  var y=vramH/2+j
  for i=-vramW/2 to (vramW-1)/2-stp step stp
   var x=vramW/2+i

   var p[3],cp[3],gx,gy,gz,scl,m=0,mag=SW

   t=vram[x+0,y+0]
   if t>plain then t=plain+max(0,t-plain-th)*tmag

   var h=100+(t-plain)*600
   'h=(h div 30)*30
   push col,byg2rgb(h,1-0.2+vram[x+0,y+0])

   set p,i+0,t*tall,-j+0
   sub cp,p,cam
   gz=iprod(cp,ck)
   scl=mag/(camz+gz)
   gx=cx+iprod(cp,ci)*scl
   gy=cy-iprod(cp,cj)*scl
   push gx1,gx:push gy1,gy
   inc m,gz

   t=vram[x+stp,y+0]
   if t>plain then t=plain+max(0,t-plain-th)*tmag
   set p,i+stp,t*tall,-j+0
   sub cp,p,cam
   gz=iprod(cp,ck)
   scl=mag/(camz+gz)
   gx=cx+iprod(cp,ci)*scl
   gy=cy-iprod(cp,cj)*scl
   push gx2,gx:push gy2,gy
   inc m,gz

   t=vram[x+stp,y+stp]
   if t>plain then t=plain+max(0,t-plain-th)*tmag
   set p,i+stp,t*tall,-j-stp
   sub cp,p,cam
   gz=iprod(cp,ck)
   scl=mag/(camz+gz)
   gx=cx+iprod(cp,ci)*scl
   gy=cy-iprod(cp,cj)*scl
   push gx3,gx:push gy3,gy
   inc m,gz

   t=vram[x+0,y+stp]
   if t>plain then t=plain+max(0,t-plain-th)*tmag
   set p,i+0,t*tall,-j-stp
   sub cp,p,cam
   gz=iprod(cp,ck)
   scl=mag/(camz+gz)
   gx=cx+iprod(cp,ci)*scl
   gy=cy-iprod(cp,cj)*scl
   push gx4,gx:push gy4,gy
   inc m,gz

   push mz,m
  next
 next

 dim idx[len(mz)+1]
 for i=0 to len(mz)-1:idx[i]=i:next
 rsort mz,idx

 var ox=70,oy=-50 '表示オフセット
 var l=len(mz)
 for j=0 to l-1
  i=idx[j]
  var c=col[i]
  var ggx1=gx1[i]+ox
  var ggx2=gx2[i]+ox
  var ggx3=gx3[i]+ox
  var ggx4=gx4[i]+ox
  var ggy1=gy1[i]+oy
  var ggy2=gy2[i]+oy
  var ggy3=gy3[i]+oy
  var ggy4=gy4[i]+oy
  gtri ggx1,ggy1,ggx2,ggy2,ggx3,ggy3,0
  gtri ggx3,ggy3,ggx4,ggy4,ggx1,ggy1,0
  gline ggx1,ggy1,ggx2,ggy2,c
  gline ggx2,ggy2,ggx3,ggy3,c
  gline ggx3,ggy3,ggx4,ggy4,c
  gline ggx4,ggy4,ggx1,ggy1,c
 next
end

def byg2rgb(h,v)
 'h=0〜200
 var hh=h*510/200
 var r=hh-255
 var g=hh
 var b=255-hh
 return rgb(r*v,g*v,b*v)
end


'三次元ベクトル計算ルーチン(左手係)
DEF V3$(A)
 RETURN FORMAT$("(%6.2F,%6.2F,%6.2F)",A[0],A[1],A[2])
END

DEF PRNT A
 ?V3$(A)
END

DEF SET C,X,Y,Z
 C[0]=X
 C[1]=Y
 C[2]=Z
END

DEF ADD C,A,B
 C[0]=A[0]+B[0]
 C[1]=A[1]+B[1]
 C[2]=A[2]+B[2]
END

DEF SUB C,A,B
 C[0]=A[0]-B[0]
 C[1]=A[1]-B[1]
 C[2]=A[2]-B[2]
END

DEF MUL C,A,B
 C[0]=A[0]*B
 C[1]=A[1]*B
 C[2]=A[2]*B
END

DEF DIVD C,A,B
 C[0]=A[0]/B
 C[1]=A[1]/B
 C[2]=A[2]/B
END

DEF DIST(A)
 RETURN SQR(A[0]*A[0]+A[1]*A[1]+A[2]*A[2])
END

DEF IPROD(A,B)
 RETURN A[0]*B[0]+A[1]*B[1]+A[2]*B[2]
END

DEF CROSS C,A,B
 C[0]=A[1]*B[2]-B[1]*A[2]
 C[1]=A[2]*B[0]-B[2]*A[0]
 C[2]=A[0]*B[1]-B[0]*A[1]
END

DEF NORM A
 VAR D=SQR(A[0]*A[0]+A[1]*A[1]+A[2]*A[2])
 A[0]=A[0]/D
 A[1]=A[1]/D
 A[2]=A[2]/D
END

DEF ROTX C,A,TH
 VAR SN=SIN(TH),CS=COS(TH)
 VAR X=A[0],Y=A[1],Z=A[2]
 C[0]=X
 C[1]=Y*CS-Z*SN
 C[2]=Y*SN+Z*CS
END

DEF ROTY C,A,TH
 VAR SN=SIN(TH),CS=COS(TH)
 VAR X=A[0],Y=A[1],Z=A[2]
 C[0]=Z*SN+X*CS
 C[1]=Y
 C[2]=Z*CS-X*SN
END

DEF ROTZ C,A,TH
 VAR SN=SIN(TH),CS=COS(TH)
 VAR X=A[0],Y=A[1],Z=A[2]
 C[0]=X*CS-Y*SN
 C[1]=X*SN+Y*CS
 C[2]=Z
END

DEF ROTN C,A,N,TH
 VAR SN=SIN(TH),CS=COS(TH)
 VAR CS1=1-CS
 VAR A1=A[0],A2=A[1],A3=A[2]
 VAR N1=N[0],N2=N[1],N3=N[2]
 VAR N12CS1=N1*N2*CS1
 VAR N23CS1=N2*N3*CS1
 VAR N31CS1=N3*N1*CS1
 VAR N1SN=N1*SN
 VAR N2SN=N2*SN
 VAR N3SN=N3*SN
 C[0]=A1*(CS+N1*N1*CS1) + A2*(N12CS1-N3SN)  + A3*(N31CS1+N2SN)
 C[1]=A1*(N12CS1+N3SN)  + A2*(CS+N2*N2*CS1) + A3*(N23CS1-N1SN)
 C[2]=A1*(N31CS1-N2SN)  + A2*(N23CS1+N1SN)  + A3*(CS+N3*N3*CS1)
END