my terain looks blocky
Code: Select all
''bluatigro 7 jul 2017
''rnd terain
#include "color.bas"
const as integer size = 256
dim shared as double hil( size , size )
''hil(0,0)=(rnd-rnd)*size
''hil(0,size)=(rnd-rnd)*size
''hil(size,0)=(rnd-rnd)*size
''hil(size,size)=(rnd-rnd)*size
sub create( x1 as integer , y1 as integer , x2 as integer , y2 as integer , dept as double )
dim as integer x12 , y12
x12 = ( x1 + x2 ) / 2
y12 = ( y1 + y2 ) / 2
if dept < 1 then exit sub
hil(x12,y1)=(hil(x1,y1)+hil(x2,y1))/2+(rnd-rnd)*dept
hil(x12,y2)=(hil(x1,y2)+hil(x2,y2))/2+(rnd-rnd)*dept
hil(x1,y12)=(hil(x1,y1)+hil(x1,y2))/2+(rnd-rnd)*dept
hil(x2,y12)=(hil(x2,y1)+hil(x2,y2))/2+(rnd-rnd)*dept
hil(x12,y12)=(hil(x1,y1)+hil(x1,y2)+hil(x2,y1)+hil(x2,y2))/4+(rnd-rnd)*dept
create x1,y1,x12,y12,dept/2
create x12,y1,x2,y12,dept/2
create x1,y12,x12,y2,dept/2
create x12,y12,x2,y2,dept/2
end sub
create 0,0,size,size,size
screen 20 , 32
dim as integer x,y
for x = 0 to size
for y = 0 to size
if hil(x,y)>-.5 then
pset(x,y),rainbow(hil(x,y))
end if
next y
next x
sleep
Code: Select all
''bluatigro 13 feb 2015
''color.bas
''some colors consts + functions
#ifndef COLOR_H
#define COLOR_H
#include "math.bas"
''primary colors
const as ulong black = &hff000000
const as ulong red = &hffff0000
const as ulong green = &hff00ff00
const as ulong yellow = &hffffff00
const as ulong blue = &hff0000ff
const as ulong magenta = &hffff00ff
const as ulong cyan = &hff00ffff
const as ulong white = &hffffffff
''mix colors
const as ulong orange = &hffff7f00
const as ulong gray = &hff7f7f7f
const as ulong pink = &hffff7f7f
const as ulong purple = &hff7f007f
const as ulong darkRed = &hff7f0000
const as ulong darkYellow = &hff7f7f00
const as ulong darkGreen = &hff007f00
const as ulong darkBlue = &hff00007f
function mix( kla as ulong , f as single , klb as ulong ) as ulong
dim as ulong ra , ga , ba , rb , gb , bb , r , g , b
ra = ( kla shr 16 ) and 255
ga = ( kla shr 8 ) and 255
ba = kla and 255
rb = ( klb shr 16 ) and 255
gb = ( klb shr 8 ) and 255
bb = klb and 255
r = ra + ( rb - ra ) * f
g = ga + ( gb - ga ) * f
b = ba + ( bb - ba ) * f
return rgb( r , g , b )
end function
function rainbow( x as single ) as ulong
dim as ulong r , g , b
r = sin( rad( x ) ) * 127 + 128
g = sin( rad( x - 120 ) ) * 127 + 128
b = sin( rad( x + 120 ) ) * 127 + 128
return rgb( r , g , b )
end function
function rndcolor() as ulong
return rgb( rnd * 255 , rnd * 255 , rnd * 255 )
end function
#endif