パーリンノイズの勾配＊フェード関数の図

パーリンノイズって、こんな感じで勾配＊フェード関数の値を1セットだけ計算しておいて、あとはグリッド毎にランダムな方向回転しながら重ねあわせればいいのかなー？＠＠；

と思って、ちょっと1セットだけ可視化してみました。

上記の図のPiSTARTER用の表示プログラム：

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[0,0]
g=basePerlin(grid)

while 1
 view
wend
end

def view
 dim cam[3],camTo[3]
 set camTo,0,0,0
 var vp=1
 var d=0

 for d=45 to 45+360 step 1
  var th=rad(d)
  var r=200+sin(th*3)*50
  r=200
  set cam,r*cos(th),5+(1+sin(th*3))*50,r*sin(th)
  gpage vp,!vp
  gcls
  draw g,grid,cam,camTo

  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 p[3],cp[3],gx,gy,gz,scl,m=0,mag=SW
  var gx1,gy1,gx2,gy2
  set p,-grid*0.6,0,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
  gx1=gx:gy1=gy
 
  set p,grid*0.6,0,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
  gx2=gx:gy2=gy
  gline gx1,gy1,gx2,gy2

  set p,0,0,-grid*0.6
  sub cp,p,cam
  gz=iprod(cp,ck)
  scl=mag/(camz+gz)
  gx=cx+iprod(cp,ci)*scl
  gy=cy-iprod(cp,cj)*scl
  gx1=gx:gy1=gy
 
  set p,0,0,grid*0.6
  sub cp,p,cam
  gz=iprod(cp,ck)
  scl=mag/(camz+gz)
  gx=cx+iprod(cp,ci)*scl
  gy=cy-iprod(cp,cj)*scl
  gx2=gx:gy2=gy
  gline gx1,gy1,gx2,gy2

  vp=!vp
 next
end

def draw g,grid,cam,camTo
 dim gx1[0],gy1[0]
 dim gx2[0],gy2[0]
 dim gx3[0],gy3[0]
 dim gx4[0],gy4[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=4
 for j=-grid/2 to grid/2-stp step stp
  var y=grid/2+j
  for i=-grid/2 to grid/2-stp step stp
   var x=grid/2+i

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

   set p,i+0,g[x+0,y+0],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

   set p,i+stp,g[x+stp,y+0],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

   set p,i+stp,g[x+stp,y+stp],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

   set p,i+0,g[x+0,y+stp],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 l=len(mz)
 for j=0 to l-1
  i=idx[j]
  gtri gx1[i],gy1[i],gx2[i],gy2[i],gx3[i],gy3[i],0
  gtri gx3[i],gy3[i],gx4[i],gy4[i],gx1[i],gy1[i],0
  gline gx1[i],gy1[i],gx2[i],gy2[i],#lime
  gline gx2[i],gy2[i],gx3[i],gy3[i],#lime
  gline gx3[i],gy3[i],gx4[i],gy4[i],#lime
  gline gx4[i],gy4[i],gx1[i],gy1[i],#lime
 next
end


def basePerlin(grid)
 dim p[grid+1,grid+1]
 var gs=grid/2

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

   var c=(u*gradU+v*gradV)*fu*fv*gs
   '?c
   'var col=rgb(c,c,c)
   'gpset CX+x,CY-y,col
   'gpset CX+x+v*64,CY-y/2-c*2
   p[grid/2+x,grid/2+y]=c
  next
 next
 return p
end

def fad(t)
 return t*t*t*(t*(t*6-15)+10)
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