Well folks, after two years I found the solution to this, but unfortunately it is written in Dark Basic Pro. It is a custom Perlin3D noise function which produces a smooth and spherecompatible texture. I tried to translate this to BB but wasn't successfully. Is anybody able to locate the error or rewrite my attempt that we get the same results in BB?
Dark Basic Pro output:
My BB attempt output:
The Dark Basic Code
Rem ***** Main Source File *****
set window on
set window layout 0,0,0
set display mode 512,256,32
hide mouse
sync off
sync rate 0
rem create arrays for perlin generator
dim s#(15,2)
dim r#(63,63,63)
rem prepare the perlin
prepare_perlin(1,0.5)
rem multisampling controller
multi = 1
milti = multi - 1
malt# = multi ^ 2
malt# = 1 / malt#
xsize = 512
ysize = 256
rem get the base sizes
xsize# = xsize * multi
ysize# = ysize * multi
rem get the scalers
xscaler# = 360
yscaler# = 180
xscaler# = xscaler# / xsize#
yscaler# = yscaler# / ysize#
width# = 2
rem piece details
pxs = 511
pys = 255
xof = 0
yof = 0
rem loop the y position
for posx = 0 to pxs step 1
rem prepare screen for drawing
lock pixels
rem loop the x
for posy = 0 to pys step 1
rem reset colours
g = 0
b = 0
rem get the scaled sizes
xp = (posx + xof) * multi
yp = (posy + yof) * multi
rem do the multisampling
for posa = 0 to milti
rem get the baring around the sphere
ba# = xp + posa
ba# = (ba# + 0.5) * xscaler#
xp# = cos(ba#)
zp# = sin(ba#)
for s = 0 to milti
rem get the pitch around the sphere
pa# = yp + poss
pa# = ((pa# + 0.5) * yscaler#)
po# = sin(pa#) * width#
rem get the positions in the space
x# = (xp# * po#) + 5
y# = (cos(pa#) * width#) + 5
z# = (zp# * po#) + 5
rem get the perlin result for that part
h = int(perl(x#,y#,z#,8) * 255)
rem cap the value
if h => 255 then h = 255
if h <= 0 then h = 0
rem add appropriate colour
if h => 136
g=g+h
else
b=b+h
endif
rem failsafe quit
if spacekey() then end
next poss
next posa
rem scale down the colours
g = g * malt#
b = b * malt#
rem get the colour
ink rgb(0,g,b),0
rem put a dot there
dot posx,posy
next posy
unlock pixels
sync
next posx
do
if spacekey() then end
loop
rem end
rem perlin function
function perl(x#,y#,z#,octaves)
rem make sure the pass value is zerod
h# = 0
rem shift octaves down to input works from 1 but system works from 0
octaves=octaves-1
rem make sue octaves are an ecceptable value
if octaves <= 0 then octaves = 0
if octaves => 15 then octaves = 15
rem loop the octaves
for oct = 0 to octaves
rem grab the frequency and amplitude for this
fre# = s#(oct,0)
amp# = s#(oct,1)
rem convert the co-ordinates into steps
x = int(x# * fre#)
y = int(y# * fre#)
z = int(z# * fre#)
rem get the inbetween co-ords
xb# = sine((x# * fre#) - flo(x))
yb# = sine((y# * fre#) - flo(y))
zb# = sine((z# * fre#) - flo(z))
xa# = 1 - xb#
ya# = 1 - yb#
za# = 1 - zb#
rem get the values for the 8 corners
v000# = vil(x,y,z) * xa# * ya# * za#
v100# = vil(x+1,y,z) * xb# * ya# * za#
v010# = vil(x,y+1,z) * xa# * yb# * za#
v001# = vil(x,y,z+1) * xa# * ya# * zb#
v101# = vil(x+1,y,z+1) * xb# * ya# * zb#
v110# = vil(x+1,y+1,z) * xb# * yb# * za#
v011# = vil(x,y+1,z+1) * xa# * yb# * zb#
v111# = vil(x+1,y+1,z+1) * xb# * yb# * zb#
rem add it on
h#=h#+(v000# + v100# + v010# + v001# + v101# + v110# + v011# + v111#) * amp#
next oct
rem scale it down
h# = h# * s#(octaves,2)
endfunction h#
rem function to get the random value of a co-ordinate
function vil(x,y,z)
rem control edges
if x < 0 then x = x - (int((x / 64) - 1) * 64) else x = x - (int(x/64) * 64)
if y < 0 then y = y - (int((y / 64) - 1) * 64) else y = y - (int(y/64) * 64)
if z < 0 then z = z - (int((z / 64) - 1) * 64) else z = z - (int(z/64) * 64)
rem get the number
v# = r#(x,y,z)
endfunction v#
rem return an integer as a floating point
function flo(a)
b# = a
endfunction b#
rem function to turn a straight 0 - 1 into a sine curved 0 - 1
function sine(v#)
rem perform the change
v# = (1 - cos(v# * 180)) * 0.5
endfunction v#
rem function to prepare data for perlin noise
function prepare_perlin(seed,persistance#)
rem set the seed value
randomize seed
rem create seed data
for x = 0 to 63
for y = 0 to 63
for z = 0 to 63
z# = rnd(10000)
r#(x,y,z) = (z# * 0.0001)
next z
next y
next z
rem prepare octave data
for z = 0 to 15
rem work out the frequence of the octave
s#(z,0) = 2 ^ z
rem get the amplitude
s#(z,1) = persistance# ^ z
rem work out the maximum amplitude of
s#(z,2) = 0
for x = 0 to z
s#(z,2)=s#(z,2)+s#(x,1)
next x
s#(z,2) = 1 / s#(z,2)
next z
endfunction
My BB attempt Code
Graphics 512,256,32,2
; create arrays For perlin generator
Dim s#(15,2)
Dim r#(63,63,63)
; prepare the perlin
prepare_perlin(1,0.5)
; multisampling controller
multi = 1
milti = multi - 1
malt# = multi ^ 2
malt# = 1.0 / malt#
xsize# = 512
ysize# = 256
; get the base sizes
xsize# = xsize * multi
ysize# = ysize * multi
; get the scalers
xscaler# = 360
yscaler# = 180
xscaler# = xscaler# / xsize#
yscaler# = yscaler# / ysize#
width# = 2
; piece details
pxs = 511
pys = 255
xof = 0
yof = 0
LockBuffer GraphicsBuffer()
; loop the y position
For posx = 0 to pxs Step 1
; loop the x
For posy = 0 to pys Step 1
; reset colours
g = 0
b = 0
; get the scaled sizes
xp# = (posx + xof) * multi
yp# = (posy + yof) * multi
; do the multisampling
For posa = 0 to milti
; get the baring around the sphere
ba# = xp + posa
ba# = (ba# + 0.5) * xscaler#
xp# = Cos(ba#)
zp# = Sin(ba#)
For poss = 0 To milti
; get the pitch around the sphere
pa# = yp + poss
pa# = ((pa# + 0.5) * yscaler#)
po# = Sin(pa#) * width#
; get the positions in the space
x# = (xp# * po#) + 5
y# = (Cos(pa#) * width#) + 5
z# = (zp# * po#) + 5
; get the perlin result For that part
h = Int(perl(x#,y#,z#,8) * 255)
;Print h : WaitKey : End
; cap the value
If h => 255 Then h = 255
If h <= 0 Then h = 0
; add appropriate colour
If h => 136
g=g+h
Else
b=b+h
EndIf
; failsafe quit
If KeyHit(1) Then End
Next
Next
; scale down the colours
g = g * malt#
b = b * malt#
; get the colour
rgb=0*$10000+g*$100+b
WritePixelFast posx,posy,rgb
; put a dot there
;Plot posx,posy
Next
Next
UnlockBuffer GraphicsBuffer()
SaveBuffer(GraphicsBuffer(),"bbperlin.bmp")
While Not KeyHit(1)
Flip
Wend
End
; perlin Function
Function perl#(x#,y#,z#,octaves)
; make sure the pass value is zerod
h# = 0
; shift octaves down to Input works from 1 but system works from 0
octaves=octaves-1
; make sue octaves are an ecceptable value
If octaves <= 0 Then octaves = 0
If octaves => 15 Then octaves = 15
; loop the octaves
For oct = 0 to octaves
; grab the frequency And amplitude For this
fre# = s#(oct,0)
amp# = s#(oct,1)
; convert the co-ordinates into steps
x = Int(x# * fre#)
y = Int(y# * fre#)
z = Int(z# * fre#)
; get the inbetween co-ords
xb# = sine((x# * fre#) - Floor(x))
yb# = sine((y# * fre#) - Floor(y))
zb# = sine((z# * fre#) - Floor(z))
xa# = 1.0 - xb#
ya# = 1.0 - yb#
za# = 1.0 - zb#
; get the values For the 8 corners
v000# = vil(x,y,z) * xa# * ya# * za#
v100# = vil(x+1,y,z) * xb# * ya# * za#
v010# = vil(x,y+1,z) * xa# * yb# * za#
v001# = vil(x,y,z+1) * xa# * ya# * zb#
v101# = vil(x+1,y,z+1) * xb# * ya# * zb#
v110# = vil(x+1,y+1,z) * xb# * yb# * za#
v011# = vil(x,y+1,z+1) * xa# * yb# * zb#
v111# = vil(x+1,y+1,z+1) * xb# * yb# * zb#
; add it on
h#=h#+(v000# + v100# + v010# + v001# + v101# + v110# + v011# + v111#) * amp#
Next
; scale it down
h# = h# * s#(octaves,2)
Return h#
End Function
; Function to get the random value of a co-ordinate
Function vil#(x,y,z)
; control edges
If x < 0 Then x = x - (Int((x / 64) - 1) * 64) Else x = x - (Int(x/64) * 64)
If y < 0 Then y = y - (Int((y / 64) - 1) * 64) Else y = y - (Int(y/64) * 64)
If z < 0 Then z = z - (Int((z / 64) - 1) * 64) Else z = z - (Int(z/64) * 64)
; get the number
v# = r#(x,y,z)
Return v#
End Function
; Return an integer as a floating point
Function flo#(a)
b# = a
Return b#
End Function
; Function to turn a straight 0 - 1 into a sine curved 0 - 1
Function sine#(v#)
; perform the change
v# = (1 - Cos(v# * 180)) * 0.5
Return v#
End Function
; Function to prepare Data For perlin noise
Function prepare_perlin(seed,persistance#)
; set the seed value
SeedRnd seed
; create seed Data
For posx = 0 To 63
For posy = 0 To 63
For posz = 0 To 63
z# = Rnd(0,10000)
r#(posx,posy,posz) = (z# * 0.0001)
Next
Next
Next
; prepare octave Data
For posz = 0 To 15
; work out the frequence of the octave
s#(posz,0) = 2 ^ posz
; get the amplitude
s#(posz,1) = persistance# ^ posz
; work out the maximum amplitude of
s#(posz,2) = 0
For posx = 0 To posz
s#(posz,2)=s#(posz,2)+s#(posx,1)
Next
s#(posz,2) = 1.0 / s#(posz,2)
Next
End Function
