Sorry your browser is not supported!

`Track editor v1.2
`======================
`P.Parkinson
`======================
`Main Source File

randomize timer()
set display mode 1024,768,32
sync on
sync rate 60
autocam off
color backdrop 0,rgb(128,128,255) 
set text font "Arial"
set text size 16
set text transparent
position camera 0,800,0
point camera 0,0,0

make_track_images()

vec1=make vector3(1)
vec2=make vector3(2)
vec3=make vector3(3)
vec4=make vector3(4)
vec5=make vector3(5)

type pointType
	x as float
	y as float
	z as float
endtype

global maxPoints as integer=100
global numPoints as integer=4
dim points(maxPoints) as pointType
global numSections as integer=20
global maxSections as integer
global joined as integer=0
dim trackData(maxPoints*numSections,5) as float
global roll as integer=0
global roll_multiplyer as float=3.0

global editMode as integer=0
global angle#=0
dim pos(maxPoints*numSections,16)as pointType
`set up start points
for l=1 to numPoints
	points(l).x=l*70-200
	points(l).y=25.0
next l
create_point_objects()
position_point_objects()


`main loop
do
	if joined=0 and editMode=0 then add_point()
	if editMode=0 then move_points(1,numPoints)
	if editMode=1 then adjust_height(1,numPoints)
	maxSections=add_sections()
	set_section_angles_and_positions()
	add_point_numbers()
	`add_section_angles()
	
	check_for_loop_join()
	check_for_change_mode()
	check_for_camera_move()
	if editMode=0
		ink rgb(255,255,255),0
		text 0,0,"Num. Control Points "+str$(numPoints)
		text 0,20,"Num. Sections "+str$(maxSections-999)+" Parts Per Sector(Used For LOD) "+str$(numSections)
		if joined=0 then text 0,40,"Loop Is Open And Points Can Be Added":text 0,60,"Press ' j ' To Close The Loop"
		if joined=1 then text 0,40,"Loop Is Joined And Points Cant Be Added":text 0,60,"Press ' u ' To Open The Loop"
		text 0,80,"You Are In Point Edit Mode,To Switch To Hight Press ' h '"
		text 0,100,"LMB Add Point"
		text 0,120,"RMB Move Point"
		text 0,140,"SPACE To Switch On And Off Test Mode"
		text 0,160,"' s ' To Save Track Data Out As A Text File"
		text 0,180,"' l ' To Use Test Track Data"
	endif
	if editMode=1
		ink rgb(255,255,255),0
		text 0,0,"Num. Control Points "+str$(numPoints)
		text 0,20,"Num. Sections "+str$(maxSections-999)+" Parts Per Sector(Used For LOD) "+str$(numSections)
		if joined=0 then text 0,40,"Loop Is Open And Points Can Be Added":text 0,60,"Press ' j ' To Close The Loop"
		if joined=1 then text 0,40,"Loop Is Joined And Points Cant Be Added":text 0,60,"Press ' u ' To Open The Loop"
		text 0,80,"You Are In Hight Edit Mode,To Switch To Point Press ' p '"
		text 0,100,"LMB Lower Point"
		text 0,120,"RMB Raise Point"
		text 0,140,"L Arrow Spin Left"
		text 0,160,"R Arrow Spin Right"
		text 0,180,"U Arrow Zoom In"
		text 0,200,"D Arrow Zoom Out"
		text 0,220,"SPACE To Switch On And Off Test Mode"
		text 0,240,"' s ' To Save Track Data Out As A Text File"
		text 0,260,"' l ' To Use Test Track Data"
	endif
	if spacekey() then free_flight()
	if inkey$()="s" then save_data()
	if inkey$()="l" then use_test_track_data()
	if inkey$()="+" and numSections<50 then inc numSections
	if inkey$()="-" and numSections>5
		for l=1000 to maxSections
			if object exist(l) then delete object l
		next l
		dec numSections
	endif
	sync
loop

function create_point_objects()
	for l=1 to numPoints
		if object exist(l)=0
			make object sphere l,20
		endif
		color object l,rgb(255,255,0)
		if l=1 then color object l,rgb(255,0,0)
		if l=numPoints then color object l,rgb(0,255,0)
	next l
endfunction

function position_point_objects()
	for l=1 to numPoints
		if object exist(l)
			position object l,points(l).x,points(l).y,points(l).z
		endif
	next l
endfunction

function add_point()
	if mouseclick()=1
		if numPoints<maxPoints
			inc numPoints
			Pick Screen MouseX(),MouseY(),1000
		
			psx = Get Pick Vector X() + Camera Position X()
			psy = 25
			psz = Get Pick Vector Z() + Camera Position Z()
	
			points(numPoints).x=psx
			points(numPoints).y=psy
			points(numPoints).z=psz
			
			create_point_objects()
			position_point_objects()

			while mouseclick()=1
				
			endwhile
		endif
	endif
endfunction

function add_point_numbers()
	ink rgb(0,0,255),0
	for l=1 to  numPoints
		text object screen x(l)-6,object screen y(l)-6,str$(l)
	next l
endfunction

function add_sections()
	obj=1000
	for l=1 to numPoints-3
		`Fill vectors with point coordinates
		set vector3 1,points(l).x,points(l).y,points(l).z
		set vector3 2,points(l+1).x,points(l+1).y,points(l+1).z
		set vector3 3,points(l+2).x,points(l+2).y,points(l+2).z
		set vector3 4,points(l+3).x,points(l+3).y,points(l+3).z
		`Loop through the sections between points
		for y = 1 to numSections
			`Work out point on catmull rom spline (filledVector,pointA,pointB,pointC,pointD,value (0.0 = beginning of curve, 1.0 = end of curve, 0.5 = half way down curve))
			catmullrom vector3 5,1,2,3,4,1.0/numSections*y
			`Draw point
			if object exist(obj)
				position object obj,x vector3(5),y vector3(5),z vector3(5)
			else
				make object box obj,20,1,1:position object obj,x vector3(5),y vector3(5),z vector3(5)
			endif
			inc obj
		next y
	next l
	
	if joined=1
		`Fill vectors with point coordinates
		set vector3 1,points(numPoints-2).x,points(numPoints-2).y,points(numPoints-2).z
		set vector3 2,points(numPoints-1).x,points(numPoints-1).y,points(numPoints-1).z
		set vector3 3,points(numPoints).x,points(numPoints).y,points(numPoints).z
		set vector3 4,points(1).x,points(1).y,points(1).z
		`Loop through the sections between points
		for y = 1 to numSections
			`Work out point on catmull rom spline (filledVector,pointA,pointB,pointC,pointD,value (0.0 = beginning of curve, 1.0 = end of curve, 0.5 = half way down curve))
			catmullrom vector3 5,1,2,3,4,1.0/numSections*y
			`Draw point
			if object exist(obj)
				position object obj,x vector3(5),y vector3(5),z vector3(5)
			else
				make object box obj,20,1,1:position object obj,x vector3(5),y vector3(5),z vector3(5)
			endif
			inc obj
		next y
		
		`Fill vectors with point coordinates
		set vector3 1,points(numPoints-1).x,points(numPoints-1).y,points(numPoints-1).z
		set vector3 2,points(numPoints).x,points(numPoints).y,points(numPoints).z
		set vector3 3,points(1).x,points(1).y,points(1).z
		set vector3 4,points(2).x,points(2).y,points(2).z
		`Loop through the sections between points
		for y = 1 to numSections
			`Work out point on catmull rom spline (filledVector,pointA,pointB,pointC,pointD,value (0.0 = beginning of curve, 1.0 = end of curve, 0.5 = half way down curve))
			catmullrom vector3 5,1,2,3,4,1.0/numSections*y
			`Draw point
			if object exist(obj)
				position object obj,x vector3(5),y vector3(5),z vector3(5)
			else
				make object box obj,20,1,1:position object obj,x vector3(5),y vector3(5),z vector3(5)
			endif
			inc obj
		next y
		
		`Fill vectors with point coordinates
		set vector3 1,points(numPoints).x,points(numPoints).y,points(numPoints).z
		set vector3 2,points(1).x,points(1).y,points(1).z
		set vector3 3,points(2).x,points(2).y,points(2).z
		set vector3 4,points(3).x,points(3).y,points(3).z
		`Loop through the sections between points
		for y = 1 to numSections
			`Work out point on catmull rom spline (filledVector,pointA,pointB,pointC,pointD,value (0.0 = beginning of curve, 1.0 = end of curve, 0.5 = half way down curve))
			catmullrom vector3 5,1,2,3,4,1.0/numSections*y
			`Draw point
			if object exist(obj)
				position object obj,x vector3(5),y vector3(5),z vector3(5)
			else
				make object box obj,20,1,1:position object obj,x vector3(5),y vector3(5),z vector3(5)
			endif
			inc obj
		next y
	endif
	dec obj
	point_sections_to_next_one()
endfunction obj

function move_points(s,e)
	obj=0
	if mouseclick()=2
		obj=pick object (mousex(),mousey(),s,e)
		if obj>0 
			d#=get pick distance()
			Pick Screen MouseX(),MouseY(),d#
			
			psx = Get Pick Vector X() + Camera Position X()
			psz = Get Pick Vector Z() + Camera Position Z()
			
			points(obj).x=psx
			points(obj).z=psz	
			
			position_point_objects()
		endif
	endif
endfunction

function point_sections_to_next_one()
	
	for l=1000 to maxSections
		if object exist(l) and object exist(l+1)
			point object l,object position x(l+1),object position y(l+1),object position z(l+1)
		endif
	next l
	if joined=1
		if object exist(maxSections) and object exist(1000)
			point object maxSections,object position x(1000),object position y(1000),object position z(1000)
		endif
	endif
endfunction

function add_section_angles()
	ink rgb(255,0,0),0
	for l=1000 to maxSections
		if object exist(l)
			text object screen x(l),object screen y(l)+16,str$(int(trackData(l-999,5)))
			text object screen x(l),object screen y(l)+36,str$(int(trackData(l-999,4)))
		endif
	next l
endfunction

function set_section_angles_and_positions()
	for l=1000 to maxSections
		if object exist(l)
			trackData(l-999,1)=object position x(l)
			trackData(l-999,2)=object position y(l)
			trackData(l-999,3)=object position z(l)
			trackData(l-999,4)=object angle y(l)
		endif
	next l
	set_relative_section_angle()
endfunction

function set_relative_section_angle()
	for l=1000 to maxSections
		if object exist(l) and object exist(l+1)
			ang1#=object angle y(l)
			ang2#=object angle y(l+1)
			turn#=ang2#-ang1#
			if turn#>180.0 then turn#=turn#-360.0
			if turn#<-180.0 then turn#=turn#+360.0
			trackData(l-999,5)=turn#
			if roll=1
				if turn#>0.0 then roll object right l,turn#*roll_multiplyer
				if turn#<0.0 then roll object left l,abs(turn#*roll_multiplyer)
			endif
		endif
	next l
	if joined=1
		if object exist(maxSections) and object exist(1000)
			ang1#=object angle y(maxSections)
			ang2#=object angle y(1000)
			turn#=ang2#-ang1#
			if turn#>180.0 then turn#=turn#-360.0
			if turn#<-180.0 then turn#=turn#+360.0
			trackData(maxSections-999,5)=turn#
			if roll=1
				if turn#>0.0 then roll object right maxSections,turn#*roll_multiplyer
				if turn#<0.0 then roll object left maxSections,abs(turn#*roll_multiplyer)
			endif
		endif
	endif
endfunction

function check_for_loop_join()
	if inkey$()="j" and joined=0
		joined=1
	endif
	if inkey$()="u" and joined=1
		for l=1000 to maxSections
			if object exist(l) then delete object l
		next l
		joined=0
	endif
endfunction


function MouseControl(Speed as float)
	xrotate camera camera angle x()+mousemovey()
	yrotate camera camera angle y()+mousemovex()
	if mouseclick()=1 then move camera Speed
	if mouseclick()=2 then move camera (0-Speed)
	r=mousemovex()
	r=mousemovey()
endfunction

function free_flight()
	cls
	text 0,0,"Building Track"
	sync
	if file exist ("track poly data.txt") then delete file "track poly data.txt"
	open to write 1,"track poly data.txt"
	ms#=maxSections-999
	ns#=numSections
	write float 1,ms#
	write float 1,ns#
	
	`wait for spacekey release
	while spacekey()
	endwhile
	
	`delete editable track
	for l=1 to numPoints
`		if object exist(l) then delete object l
	next l
	for l=1000 to maxSections
		if object exist(l) then delete object l
	next l

for x=1 to 6
	`smooth track
	for l=1000 to maxSections-1
		tot#=trackData(l-999,5)
		tot#=tot#+trackData(l+1-999,5)
		trackData(l-999,5)=tot#/2.2
	next l
	if joined=1
		tot#=trackData(maxSections-999,5)
		tot#=tot#+trackData(1000-999,5)
		trackData(maxSections-999,5)=tot#/2.2
	endif
next x

	`create new track objects here
	for l=1000 to maxSections
		make_straight_ahead_object(l)
		position object l,trackData(l-999,1)*5,trackData(l-999,2)*5,trackData(l-999,3)*5
		yrotate object l,trackData(l-999,4)
	next l
	
	`make mesh from object data
	obj=10000
	for l=1000 to maxSections-1
		make_strip(obj,l,l+1)
		texture object obj,1
		inc obj
	next l
	make_strip(obj,maxSections,1000)
	texture object obj,1
	inc obj
	
	
	`delete objects no longer needed
	for l=1000 to maxSections
		if object exist(l) then delete object l
	next l
	
	close file 1
set ambient light 30	
hide light 0
make light 1
set spot light 1,20,90
set light range 1,500
`movement
	l=1000
	do
		text 0,0,"fps"+str$(screen fps())
		position camera trackData(l-999,1)*5,trackData(l-999,2)*5+15,trackData(l-999,3)*5
		point camera trackData(l-998,1)*5,trackData(l-998,2)*5+15,trackData(l-998,3)*5
		position light 1, trackData(l-999,1)*5,trackData(l-999,2)*5+25,trackData(l-999,3)*5
		point light 1, trackData(l-990,1)*5,trackData(l-990,2)*5,trackData(l-990,3)*5
		
		sync
		if spacekey() then exit
		inc l
		if l>maxSections then l=1000
`		mouseControl(5.0)
`		sync
	loop
delete light 1
show light 0
set ambient light 100	
	
	
	`wait for spacekey release
	while spacekey()
	endwhile

	`delete non editable track
	for l=1 to maxSections
		if object exist(l) then delete object l
	next l
	for l=10000 to obj
		if object exist(l) then delete object l
	next l
	
	`create editable track
	create_point_objects()
	position_point_objects()
	maxSections=add_sections()
	
	`reset camera to proper mode
	if editMode=0
		position camera 0,800,0
		point camera 0,0,0
	endif
	if editMode=1
		position camera 0,400,-400
		point camera 0,0,0
	endif
	
endfunction
function check_for_change_mode()
	if inkey$()="h" and editMode=0
		editMode=1
		position camera 0,400,-400
		point camera 0,0,0
	endif
	if inkey$()="p" and editMode=1
		editMode=0
		position camera 0,800,0
		point camera 0,0,0
	endif
endfunction

function check_for_camera_move()
	if editMode=1
		if leftkey()
			 spincameraaround(-5)
		endif
		if rightkey()
			 spincameraaround(5)
		endif
		if upkey() then move camera 1.0
		if downkey() then move camera -1.0
	endif
endfunction

function SpinCameraAround( Speed#)
	angle# = wrapvalue(angle# + Speed#)

   xPos# =cos(angle#) * 400
   yPos# =400
   zPos# =sin(angle#) * 400

   position camera xPos#, yPos#, zPos#
   point camera 0,0,0
endfunction	

function adjust_height(s,e)
	obj=0
	if mouseclick()=1
		obj=pick object (mousex(),mousey(),s,e)
		while mouseclick()=1
			if obj>0
				inc points(obj).y
				position_point_objects()
				maxSections=add_sections()
				sync
			endif
		endwhile
	endif
	if mouseclick()=2
		obj=pick object (mousex(),mousey(),s,e)
		while mouseclick()=2
			if obj>0
				dec points(obj).y
				position_point_objects()
				maxSections=add_sections()
				sync
			endif
		endwhile
	endif
endfunction 

`function make_straight_ahead_object(obj)
`	make object cube obj,1
`	if object exist(50000) then delete object 50000
`	make object cube 50000,1
`	if mesh exist(1) then delete mesh 1
`	make mesh from object 1,50000
`	
`	add limb obj,1,1
`	offset limb obj,1,40,10,0
`	
`	add limb obj,2,1
`	offset limb obj,2,-40,10,0
`	
`	add limb obj,3,1
`	offset limb obj,3,70,30,0
`	
`	add limb obj,4,1
`	offset limb obj,4,-70,30,0
`	
`	add limb obj,5,1
`	offset limb obj,5,90,70,0
`	
`	add limb obj,6,1
`	offset limb obj,6,-90,70,0
`	
`	if object exist(50000) then delete object 50000
`	if mesh exist(1) then delete mesh 1
`	
`endfunction

function make_straight_ahead_object(obj)
	make object cube obj,1
	if object exist(50000) then delete object 50000
	make object cube 50000,1
	if mesh exist(1) then delete mesh 1
	make mesh from object 1,50000
	
	add limb obj,1,1
	offset limb obj,1,30,0,0
	
	add limb obj,2,1
	offset limb obj,2,-30,0,0
	
	add limb obj,3,1
	offset limb obj,3,60,0,0
	
	add limb obj,4,1
	offset limb obj,4,-60,0,0
	
	add limb obj,5,1
	offset limb obj,5,90,0,0
	
	add limb obj,6,1
	offset limb obj,6,-90,0,0
	
	if object exist(50000) then delete object 50000
	if mesh exist(1) then delete mesh 1
	
endfunction

function create_memblockobject(memnum,v)

   make memblock memnum,12+(36*v)
   write memblock dword memnum,0,338
   write memblock dword memnum,4,36
   write memblock dword memnum,8,v

endfunction

function create_vertex(memnum,v,vposx#,vposy#,vposz#,color as dword,u#,v#)

   write memblock float memnum,v*36+12,vposx#
   write memblock float memnum,v*36+16,vposy#
   write memblock float memnum,v*36+20,vposz#
   write memblock dword memnum,v*36+36,color
   write memblock float memnum,v*36+40,u#
   write memblock float memnum,v*36+44,v#

endfunction

function set_normal(memnum,v,normalx#,normaly#,normalz#)

   write memblock float memnum,v*36+24,normalx#
   write memblock float memnum,v*36+28,normaly#
   write memblock float memnum,v*36+32,normalz#

endfunction

function make_strip(obj_num,t1,t2)
	
	`make a memblock big enough to hold the data
	memblock_size=36
	
	if memblock exist(1) then delete memblock 1
	create_memblockobject(1,memblock_size)


	posx1=limb position x(t1,6)
	posy1=limb position y(t1,6)
	posz1=limb position z(t1,6)
	
	posx2=limb position x(t1,4)
	posy2=limb position y(t1,4)
	posz2=limb position z(t1,4)
	
	posx3=limb position x(t1,2)
	posy3=limb position y(t1,2)
	posz3=limb position z(t1,2)
	
	posx4=object position x(t1)
	posy4=object position y(t1)
	posz4=object position z(t1)
	
	posx5=limb position x(t1,1)
	posy5=limb position y(t1,1)
	posz5=limb position z(t1,1)
	
	posx6=limb position x(t1,3)
	posy6=limb position y(t1,3)
	posz6=limb position z(t1,3)
	
	posx7=limb position x(t1,5)
	posy7=limb position y(t1,5)
	posz7=limb position z(t1,5)

	posx8=limb position x(t2,6)
	posy8=limb position y(t2,6)
	posz8=limb position z(t2,6)
	
	posx9=limb position x(t2,4)
	posy9=limb position y(t2,4)
	posz9=limb position z(t2,4)
	
	posx10=limb position x(t2,2)
	posy10=limb position y(t2,2)
	posz10=limb position z(t2,2)
	
	posx11=object position x(t2)
	posy11=object position y(t2)
	posz11=object position z(t2)
	
	posx12=limb position x(t2,1)
	posy12=limb position y(t2,1)
	posz12=limb position z(t2,1)
	
	posx13=limb position x(t2,3)
	posy13=limb position y(t2,3)
	posz13=limb position z(t2,3)
	
	posx14=limb position x(t2,5)
	posy14=limb position y(t2,5)
	posz14=limb position z(t2,5)

	u#=1.0/6.0
	v_num=0
	
	create_vertex(1,v_num,posx8,posy8,posz8,rgb(255,255,255),0,0)
	write float 1,posx8:write float 1,posy8:write float 1,posz8
	inc v_num
	create_vertex(1,v_num,posx2,posy2,posz2,rgb(255,255,255),u#*1,1)
	write float 1,posx2:write float 1,posy2:write float 1,posz2
	inc v_num
	create_vertex(1,v_num,posx1,posy1,posz1,rgb(255,255,255),0,1)
	write float 1,posx1:write float 1,posy1:write float 1,posz1
	inc v_num
		
	create_vertex(1,v_num,posx8,posy8,posz8,rgb(255,255,255),0,0)
	write float 1,posx8:write float 1,posy8:write float 1,posz8
	inc v_num
	create_vertex(1,v_num,posx9,posy9,posz9,rgb(255,255,255),u#*1,0)
	write float 1,posx9:write float 1,posy9:write float 1,posz9
	inc v_num
	create_vertex(1,v_num,posx2,posy2,posz2,rgb(255,255,255),u#*1,1)
	write float 1,posx2:write float 1,posy2:write float 1,posz2
	inc v_num
		
		
	create_vertex(1,v_num,posx9,posy9,posz9,rgb(255,255,255),u#*1,0)
	write float 1,posx9:write float 1,posy9:write float 1,posz9
	inc v_num
	create_vertex(1,v_num,posx3,posy3,posz3,rgb(255,255,255),u#*2,1)
	write float 1,posx3:write float 1,posy3:write float 1,posz3
	inc v_num
	create_vertex(1,v_num,posx2,posy2,posz2,rgb(255,255,255),u#*1,1)
	write float 1,posx2:write float 1,posy2:write float 1,posz2
	inc v_num
		
	create_vertex(1,v_num,posx9,posy9,posz9,rgb(255,255,255),u#*1,0)
	write float 1,posx9:write float 1,posy9:write float 1,posz9
	inc v_num
	create_vertex(1,v_num,posx10,posy10,posz10,rgb(255,255,255),u#*2,0)
	write float 1,posx10:write float 1,posy10:write float 1,posz10
	inc v_num
	create_vertex(1,v_num,posx3,posy3,posz3,rgb(255,255,255),u#*2,1)
	write float 1,posx3:write float 1,posy3:write float 1,posz3
	inc v_num
		
		
	create_vertex(1,v_num,posx10,posy10,posz10,rgb(255,255,255),u#*2,0)
	write float 1,posx10:write float 1,posy10:write float 1,posz10
	inc v_num
	create_vertex(1,v_num,posx4,posy4,posz4,rgb(255,255,255),u#*3,1)
	write float 1,posx4:write float 1,posy4:write float 1,posz4
	inc v_num
	create_vertex(1,v_num,posx3,posy3,posz3,rgb(255,255,255),u#*2,1)
	write float 1,posx3:write float 1,posy3:write float 1,posz3
	inc v_num
		
	create_vertex(1,v_num,posx10,posy10,posz10,rgb(255,255,255),u#*2,0)
	write float 1,posx10:write float 1,posy10:write float 1,posz10
	inc v_num
	create_vertex(1,v_num,posx11,posy11,posz11,rgb(255,255,255),u#*3,0)
	write float 1,posx11:write float 1,posy11:write float 1,posz11
	inc v_num
	create_vertex(1,v_num,posx4,posy4,posz4,rgb(255,255,255),u#*3,1)
	write float 1,posx4:write float 1,posy4:write float 1,posz4
	inc v_num
		
		
	create_vertex(1,v_num,posx11,posy11,posz11,rgb(255,255,255),u#*3,0)
	write float 1,posx11:write float 1,posy11:write float 1,posz11
	inc v_num
	create_vertex(1,v_num,posx5,posy5,posz5,rgb(255,255,255),u#*4,1)
	write float 1,posx5:write float 1,posy5:write float 1,posz5
	inc v_num
	create_vertex(1,v_num,posx4,posy4,posz4,rgb(255,255,255),u#*3,1)
	write float 1,posx4:write float 1,posy4:write float 1,posz4
	inc v_num
		
	create_vertex(1,v_num,posx11,posy11,posz11,rgb(255,255,255),u#*3,0)
	write float 1,posx11:write float 1,posy11:write float 1,posz11
	inc v_num
	create_vertex(1,v_num,posx12,posy12,posz12,rgb(255,255,255),u#*4,0)
	write float 1,posx12:write float 1,posy12:write float 1,posz12
	inc v_num
	create_vertex(1,v_num,posx5,posy5,posz5,rgb(255,255,255),u#*4,1)
	write float 1,posx5:write float 1,posy5:write float 1,posz5
	inc v_num
		
		
	create_vertex(1,v_num,posx12,posy12,posz12,rgb(255,255,255),u#*4,0)
	write float 1,posx12:write float 1,posy12:write float 1,posz12
	inc v_num
	create_vertex(1,v_num,posx6,posy6,posz6,rgb(255,255,255),u#*5,1)
	write float 1,posx6:write float 1,posy6:write float 1,posz6
	inc v_num
	create_vertex(1,v_num,posx5,posy5,posz5,rgb(255,255,255),u#*4,1)
	write float 1,posx5:write float 1,posy5:write float 1,posz5
	inc v_num
		
	create_vertex(1,v_num,posx12,posy12,posz12,rgb(255,255,255),u#*4,0)
	write float 1,posx12:write float 1,posy12:write float 1,posz12
	inc v_num
	create_vertex(1,v_num,posx13,posy13,posz13,rgb(255,255,255),u#*5,0)
	write float 1,posx13:write float 1,posy13:write float 1,posz13
	inc v_num
	create_vertex(1,v_num,posx6,posy6,posz6,rgb(255,255,255),u#*5,1)
	write float 1,posx6:write float 1,posy6:write float 1,posz6
	inc v_num
	
		
	create_vertex(1,v_num,posx13,posy13,posz13,rgb(255,255,255),u#*5,0)
	write float 1,posx13:write float 1,posy13:write float 1,posz13
	inc v_num
	create_vertex(1,v_num,posx7,posy7,posz7,rgb(255,255,255),u#*6,1)
	write float 1,posx7:write float 1,posy7:write float 1,posz7
	inc v_num
	create_vertex(1,v_num,posx6,posy6,posz6,rgb(255,255,255),u#*5,1)
	write float 1,posx6:write float 1,posy6:write float 1,posz6
	inc v_num
		
	create_vertex(1,v_num,posx13,posy13,posz13,rgb(255,255,255),u#*5,0)
	write float 1,posx13:write float 1,posy13:write float 1,posz13
	inc v_num
	create_vertex(1,v_num,posx14,posy14,posz14,rgb(255,255,255),u#*6,0)
	write float 1,posx14:write float 1,posy14:write float 1,posz14
	inc v_num
	create_vertex(1,v_num,posx7,posy7,posz7,rgb(255,255,255),u#*6,1)
	write float 1,posx7:write float 1,posy7:write float 1,posz7
	inc v_num
		
	`write track angle
	write float 1,trackData(t1-999,4)
		
	`write the bend angle
	write float 1,trackData(t1-999,5)
		
	`write track center line
	write float 1,trackData(t1-999,1)*5
	write float 1,trackData(t1-999,2)*5
	write float 1,trackData(t1-999,3)*5
		
	make mesh from memblock 1,1
	make object obj_num,1,0
	set object texture obj_num,2,0
	set object normals obj_num
endfunction

function make_track_images()
	ink rgb(50,50,50),0
	box 0,0,256,256
	for l=1 to 60000
		col=rnd(50)+100
		dot rnd(256),rnd(256),rgb(col,col,col)
	next l
	ink rgb(255,0,0),0
	box 0,0,10,128
	ink rgb(255,255,255),0
	box 0,128,10,256
	ink rgb(255,255,255),0
	box 246,0,256,128
	ink rgb(255,0,0),0
	box 246,128,256,256
	get image 1,0,0,256,256
	
	
	ink rgb(200,200,200),0
	box 0,0,256,256
	ink rgb(190,190,190),0
	box 1,1,255,255
	ink rgb(180,180,180),0
	box 2,2,254,254
	ink rgb(50,50,50),0
	box 3,3,253,253
	for l=1 to 60000
		col=rnd(50)+100
		dot rnd(250)+3,rnd(250)+3,rgb(col,col,col)
	next l
	get image 2,0,0,256,256
endfunction

function save_data()
	cls
	sync
	text 0,0,"Saving Track Data To Text File Ready To Cut And Paste"
	sync
	for l= 1 to 1000000
		
	next l
	if file exist("track data.txt") then delete file "track data.txt"
	open to write 1,"track data.txt"
	write string 1,"data "+str$(numPoints)+"`number of points"
	write string 1,"data "+str$(joined)+"`joined"
	for l=1 to numPoints
		write string 1,"data "+str$(points(l).x)+","+str$(points(l).y)+","+str$(points(l).z)
	next l
	close file 1
endfunction

function use_test_track_data()
	cls
	sync
	text 0,0,"Loading Test Track Data"
	sync
	for l=1 to 1000000
		
	next l
	restore track_data
	read numPoints
	read joined
	for l= 1 to numPoints
		read points(l).x
		read points(l).y
		read points(l).z
	next l
	for l= 1 to maxPoints
		if object exist(l) then delete object l 
	next l
	for l= 1000 to numSections*maxPoints
		if object exist(l) then delete object l 
	next l
	`create editable track
	create_point_objects()
	position_point_objects()
	maxSections=add_sections()
	
	`reset camera to proper mode
	if editMode=0
		position camera 0,800,0
		point camera 0,0,0
	endif
	if editMode=1
		position camera 0,400,-400
		point camera 0,0,0
	endif
endfunction
track_data:

data 35`number of points
data 1`joined
data -130,0,0
data -60,-26,0
data 10,-32,0
data 80,0,0
data 172,4,41
data 164,16,128
data 106,16,165
data 61,0,146
data 29,0,85
data -40,0,59
data -141,0,95
data -138,0,167
data -76,0,224
data 1,0,236
data 102,0,227
data 179,0,201
data 229,27,162
data 265,0,82
data 272,21,-20
data 241,0,-93
data 161,28,-178
data 108,0,-217
data -2,27,-259
data -91,0,-226
data -82,-25,-164
data 38,0,-173
data 69,0,-97
data 32,0,-49
data -68,0,-68
data -151,0,-126
data -206,0,-176
data -288,37,-129
data -322,29,5
data -260,0,75
data -211,0,34

`Track Landscaper v1.3
`======================
`P.Parkinson
`======================
`Main Source File

set display mode 1024,768,32
sync on
sync rate 60
autocam off
color backdrop 0, 0
set text font "Arial"
set text size 12
set text transparent
position camera 200,1600,-1600
point camera 0,0,0
set image colorkey 0,0,0



type pointType
	x as float
	y as float
	z as float
	e as integer
endtype

dim track_data(36) as pointType

global gridSizeX as integer=256
global gridSizeZ as integer =256
global tileSize as integer=25
dim land(gridSizeX,gridSizeZ) as pointType


hmap_fractal()
load_track_data(1)
n=build_land()
save_land()

set ambient light 0

ink rgb(255,255,255),0

do
	`show_hmap()
	text 0,0,"Done"+str$(n)
	mousecontrol(5.0)
	sync
loop


function MouseControl(Speed as float)
	xrotate camera camera angle x()+mousemovey()
	yrotate camera camera angle y()+mousemovex()
	if mouseclick()=1 then move camera Speed
	if mouseclick()=2 then move camera (0-Speed)
	r=mousemovex()
	r=mousemovey()
endfunction

function load_track_data(obj)
	show_hmap()
	sync
	count=0
	open to read 1,"track poly data.txt"
	read float 1,numPolys#
	read float 1,st#
	
	minx#=land(0,0).x
	maxx#=land(gridSizeX,0).x
	minz#=land(0,0).z
	maxz#=land(0,gridSizeZ).z
	
`	memblock_size=36
`	if memblock exist(1) then delete memblock 1
`	create_memblockobject(1,memblock_size)
`	
	for l=1 to int(numPolys#)
		v_num=0
		
		for p=1 to 36
			read float 1,x#:read float 1,y#:read float 1,z#
				
			px#=minx#-x#
			px#=abs(px#)
			px#=px#/tileSize
				
			pz#=minz#-z#
			pz#=abs(pz#)
			pz#=pz#/tileSize
			
			px=int(px#):pz=int(pz#)
			for z=-1 to 1
				for x=-1 to 1
					if px+x>0 and px+x<gridSizeX and pz+z>0 and pz+z<gridSizeZ and land(px+x,pz+z).y>=y#
						`land(px+x,pz+z).x=x#
						land(px+x,pz+z).y=y#-0.5
						`land(px+x,pz+z).z=z#
					endif
				next x
			next z
			
		next p
		

		read float 1,ang#
		read float 1,turn#
		read float 1,x#:read float 1,y#:read float 1,z#	
		
`		radius#=400.0
`		for z= 0 to gridSizeZ
`			for x=0 to gridSizeX
`				if distance3d(x#,y#,z#,land(x,z).x,land(x,z).y,land(x,z).z)<radius# and land(x,z).y>=y#
`					land(x,z).y=y#-1.0
`				endif
`			next x
`		next z
`		
		if count=0
			show_hmap()
			text 0,0,str$(l)+"of"+str$(int(numPolys#))
			sync
		endif
		inc count
		if count>10 then count=0
		
	next l
	close file 1 
	sync
endfunction 

function create_memblockobject(memnum,v)

   make memblock memnum,12+(36*v)
   write memblock dword memnum,0,338
   write memblock dword memnum,4,36
   write memblock dword memnum,8,v

endfunction

function create_vertex(memnum,v,vposx#,vposy#,vposz#,color as dword,u#,v#)

   write memblock float memnum,v*36+12,vposx#
   write memblock float memnum,v*36+16,vposy#
   write memblock float memnum,v*36+20,vposz#
   write memblock dword memnum,v*36+36,color
   write memblock float memnum,v*36+40,u#
   write memblock float memnum,v*36+44,v#

endfunction

function set_normal(memnum,v,normalx#,normaly#,normalz#)

   write memblock float memnum,v*36+24,normalx#
   write memblock float memnum,v*36+28,normaly#
   write memblock float memnum,v*36+32,normalz#

endfunction

function hmap_fractal()
`thanks to who ever did this code,had it so long,and it never fails to work for me
av as float
rn as float
s=gridSizeX  ` units and array size; must be a power of 2
rn=0.2  ` bigger numbers = smoother, smaller = spikier
smt=1  ` how many times to smooth matrix
dim a(s,s,1) as float
` do the diamond square algorithm
` paying special attention to wrapping around
c=s
repeat
   for z=0 to (s-c) step c
      for x=0 to (s-c) step c
         av=(a(x,z)+a(x+c,z)+a(x,z+c)+a(x+c,z+c))/4.0
         av=av+((-50+rnd(100))/rn)
         a(x+(c/2),z+(c/2))=av
      next x
   next z
   w=1
   for z=0 to (s-(c/2)) step (c/2)
      for x=0 to (s-c) step c
         x2=x+(w*(c/2))
         av=a(x2,z+(c/2))+a(x2+(c/2),z)
         if x2=0
            av=av+a(s-(c/2),z)
         else
            av=av+a(x2-(c/2),z)
         endif
         if z=0
            av=av+a(x2,s-(c/2))
         else
            av=av+a(x2,z-(c/2))
         endif
         av=av/4.0
         av=av+((-50+rnd(100))/rn)
         a(x2,z,0)=av
         if x2=0 then a(s,z,0)=av
         if z=0 then a(x2,s,0)=av
      next x
      w=1-w
   next z
   c=c/2
   rn=rn*2.0
until c < 2

` smooth the result
for multiple=1 to smt
   for x=0 to s-1
      x2=x-1 : if x2 < 0 then x2=s-1
      for z=0 to s-1
         z2=z-1 : if z2 < 0 then z2=s-1
         v1#=a(x2,z+1,0)
         v2#=a(x,z+1,0)
         v3#=a(x+1,z+1,0)
         v4#=a(x+1,z,0)
         v5#=a(x+1,z2,0)
         v6#=a(x,z2,0)
         v7#=a(x2,z2,0)
         v8#=a(x2,z,0)
         av#=(v1#+v2#+v3#+v4#+v5#+v6#+v7#+v8#)/8.0
         a(x,z,0)=av#
      next z
   next x
   for f=0 to s
      a(s,f,0)=a(0,f,0)
      a(f,s,0)=a(f,0,0)
   next f
next multiple

`find min/max height
minh#=5000:maxh#=-5000
for z=0 to gridSizeZ
   for x=0 to gridSizeX
      if a(x,z,0)<minh# then minh#=a(x,z,0)
      if a(x,z,0)>maxh# then maxh#=a(x,z,0)
   next x
next z

` update data array and raise it up so the lowest point is>=0
for z=0 to gridSizeZ
   for x=0 to gridSizeX
      av=a(x,z,0)
      if minh#<0 then land(x,z).x = x*tileSize-(gridSizeX*tileSize/2):land(x,z).y = av+abs(minh#):land(x,z).z = z*tileSize-(gridSizeZ*tileSize/2)
      if minh#>=0 then land(x,z).x = x*tileSize-(gridSizeX*tileSize/2):land(x,z).y = av-minh#:land(x,z).z = z*tileSize-(gridSizeZ*tileSize/2)
     next x
next z
endfunction

function show_hmap()
	for z=0 to gridSizeZ
		for x=0 to gridSizeX
			
			col=land(x,z).y/3
			if col<25 then col=25
			if col>255 then col=255
			dot x,z,rgb(col,col,col)
		next x
	next z
	
endfunction


function build_land()
	memblock_size=20*20*6
	if memblock exist(1) then delete memblock 1
	create_memblockobject(1,memblock_size)
	
	obj=1
	
	for lz=0 to 11
		for lx=0 to 11
			v_num=0
			for z=lz*20 to (lz+1)*20-1
				for x=lx*20 to (lx+1)*20-1
					create_vertex(1,v_num,land(x,z).x,land(x,z).y,land(x,z).z,rgb(255,255,255),0,0):inc v_num
					create_vertex(1,v_num,land(x,z+1).x,land(x,z+1).y,land(x,z+1).z,rgb(255,255,255),0,0):inc v_num
					create_vertex(1,v_num,land(x+1,z+1).x,land(x+1,z+1).y,land(x+1,z+1).z,rgb(255,255,255),0,0):inc v_num
					
					create_vertex(1,v_num,land(x,z).x,land(x,z).y,land(x,z).z,rgb(255,255,255),0,0):inc v_num
					create_vertex(1,v_num,land(x+1,z+1).x,land(x+1,z+1).y,land(x+1,z+1).z,rgb(255,255,255),0,0):inc v_num
					create_vertex(1,v_num,land(x+1,z).x,land(x+1,z).y,land(x+1,z).z,rgb(255,255,255),0,0):inc v_num
				next x
			next z
			make mesh from memblock 1,1
			make object obj,1,0
			set object texture obj,2,0
			set object normals obj
			`set object smoothing obj,95
			set object wireframe obj,1
			inc obj
		next lx
	next lz
	
	
	
endfunction obj

function save_land()
	if file exist("land data.txt")
		delete file "land data.txt"
	endif
	
	open to write 1,"land data.txt"
	for z=0 to gridSizeZ
		for x=0 to gridSizeX
			write float 1,land(x,z).x
			write float 1,land(x,z).y
			write float 1,land(x,z).z
		next x
	next z
endfunction



function Distance3D( x1# as float, y1# as float, z1# as float, x2# as float, y2# as float, z2# as float )
    distance# = Abs(Sqrt((x1# - x2#) ^ 2 + (y1# - y2#) ^ 2 + (z1# - z2#) ^ 2))
endfunction distance#

`Track Loader v1.2
`======================
`P.Parkinson
`======================
`Main Source File

set display mode 1024,768,32
sync on
sync rate 60
autocam off
color backdrop rgb(150,150,255)
set text font "Arial"
set text size 12
set text transparent
set image colorkey 0,0,0
make_texture()

type pointType
	x as float
	y as float
	z as float
	t as float
	a as float
endtype
dim track_data(36) as pointType
dim track_pos(5000) as pointType
dim pos(5000,16)as pointType
global gridSizeX as integer=256
global gridSizeZ as integer =256
global tileSize as integer=25
dim land(gridSizeX,gridSizeZ) as pointType


num_track_sections=load_track_data(1)
num_land_sections=load_land_data(num_track_sections+1)

set ambient light 0

ink rgb(255,255,255),0
l=1
do
	position camera track_pos(l).x,track_pos(l).y+25,track_pos(l).z
	if l<num_track_sections
		point camera track_pos(l+1).x,track_pos(l+1).y+25,track_pos(l+1).z
	else
		point camera track_pos(1).x,track_pos(l).y+25,track_pos(1).z
	endif
	inc l
	if l>num_track_sections then l=1
	wait 50
	text 0,20,str$(screen fps())
	text 0,40,str$(num_obj)
`	mousecontrol(5.0)
	sync
loop


function MouseControl(Speed as float)
	xrotate camera camera angle x()+mousemovey()
	yrotate camera camera angle y()+mousemovex()
	if mouseclick()=1 then move camera Speed
	if mouseclick()=2 then move camera (0-Speed)
	r=mousemovex()
	r=mousemovey()
endfunction

function load_track_data(obj)
	text 0,0,"loading track"
	sync
	sync
	u#=1.0/6.0
	open to read 1,"track poly data.txt"
	read float 1,numPolys#
	read float 1,st#
	
	memblock_size=36
	if memblock exist(1) then delete memblock 1
	create_memblockobject(1,memblock_size)
	
	for l=1 to int(numPolys#)
		v_num=0
		for p=1 to 36
			read float 1,x#:read float 1,y#:read float 1,z#
			track_data(p).x=x#:track_data(p).y=y#:track_data(p).z=z#
		next p
		read float 1,ang#
		read float 1,turn#
		read float 1,x#:read float 1,y#:read float 1,z#
		track_pos(l).x=x#
		track_pos(l).y=y#
		track_pos(l).z=z#
		track_pos(l).a=ang#
		track_pos(l).t=turn#
		
		for p=0 to 5	

			create_vertex(1,v_num,track_data(1+p*6).x,track_data(1+p*6).y,track_data(1+p*6).z,rgb(255,255,255),p*u#,0):inc v_num
			create_vertex(1,v_num,track_data(2+p*6).x,track_data(2+p*6).y,track_data(2+p*6).z,rgb(255,255,255),(p+1)*u#,1):inc v_num
			create_vertex(1,v_num,track_data(3+p*6).x,track_data(3+p*6).y,track_data(3+p*6).z,rgb(255,255,255),p*u#,1):inc v_num
			
			create_vertex(1,v_num,track_data(4+p*6).x,track_data(4+p*6).y,track_data(4+p*6).z,rgb(255,255,255),p*u#,0):inc v_num
			create_vertex(1,v_num,track_data(5+p*6).x,track_data(5+p*6).y,track_data(5+p*6).z,rgb(255,255,255),(p+1)*u#,0):inc v_num
			create_vertex(1,v_num,track_data(6+p*6).x,track_data(6+p*6).y,track_data(6+p*6).z,rgb(255,255,255),(p+1)*u#,1):inc v_num
			
		next p

		make mesh from memblock 1,1
		make object obj,1,0
		set object texture obj,2,0
		set object normals obj
		`set object smoothing obj,95
		`set object wireframe obj,1
		`set object transparency obj,1
		if l<5 
			texture object obj,3
		else
			texture object obj,1
		endif
		
		inc obj
	next l
	
	dec obj
	close file 1 

	sync
endfunction obj

function create_memblockobject(memnum,v)

   make memblock memnum,12+(36*v)
   write memblock dword memnum,0,338
   write memblock dword memnum,4,36
   write memblock dword memnum,8,v

endfunction

function create_vertex(memnum,v,vposx#,vposy#,vposz#,color as dword,u#,v#)

   write memblock float memnum,v*36+12,vposx#
   write memblock float memnum,v*36+16,vposy#
   write memblock float memnum,v*36+20,vposz#
   write memblock dword memnum,v*36+36,color
   write memblock float memnum,v*36+40,u#
   write memblock float memnum,v*36+44,v#

endfunction

function set_normal(memnum,v,normalx#,normaly#,normalz#)

   write memblock float memnum,v*36+24,normalx#
   write memblock float memnum,v*36+28,normaly#
   write memblock float memnum,v*36+32,normalz#

endfunction

function make_texture()
	ink rgb(50,50,50),0
	box 0,0,256,256
	for l=1 to 60000
		col=rnd(50)+100
		dot rnd(256),rnd(256),rgb(col,col,col)
	next l
	ink rgb(255,0,0),0
	box 20,0,30,128
	ink rgb(255,255,255),0
	box 20,128,30,256
	ink rgb(255,255,255),0
	box 226,0,236,128
	ink rgb(255,0,0),0
	box 226,128,236,256
	get image 1,0,0,256,256
	save image "test.bmp",1
	
	ink rgb(150,150,0),0
	box 0,0,256,256
	for l=1 to 60000
		col=rnd(100)+100
		dot rnd(256),rnd(256),rgb(col,col,0)
	next l
	get image 2,0,0,256,256
	
	ink rgb(50,50,50),0
	box 0,0,256,256
	for l=1 to 60000
		col=rnd(50)+100
		dot rnd(256),rnd(256),rgb(col,col,col)
	next l
	for x=0 to 256 step 50
		ink rgb(255,255,255),0
		box x,0,x+25,128
		box x+25,128,x+50,256
	next x
	get image 3,0,0,256,256
	cls
endfunction

function load_land_data(obj)
	u#=1.0/gridSizeX
	v#=1.0/gridSizeZ
	open to read 1,"land data.txt"
	for z=0 to gridSizeZ
		for x=0 to gridSizeX
			read float 1,land(x,z).x
			read float 1,land(x,z).y
			read float 1,land(x,z).z
			
		next x
	next z
	memblock_size=20*20*6
	if memblock exist(1) then delete memblock 1
	create_memblockobject(1,memblock_size)
	
	for lz=0 to 11
		for lx=0 to 11
			v_num=0
			for z=lz*20 to (lz+1)*20-1
				for x=lx*20 to (lx+1)*20-1
					create_vertex(1,v_num,land(x,z).x,land(x,z).y,land(x,z).z,rgb(255,255,255),0,0):inc v_num
					create_vertex(1,v_num,land(x,z+1).x,land(x,z+1).y,land(x,z+1).z,rgb(255,255,255),0,1):inc v_num
					create_vertex(1,v_num,land(x+1,z+1).x,land(x+1,z+1).y,land(x+1,z+1).z,rgb(255,255,255),1,1):inc v_num
					
					create_vertex(1,v_num,land(x,z).x,land(x,z).y,land(x,z).z,rgb(255,255,255),0,0):inc v_num
					create_vertex(1,v_num,land(x+1,z+1).x,land(x+1,z+1).y,land(x+1,z+1).z,rgb(255,255,255),1,1):inc v_num
					create_vertex(1,v_num,land(x+1,z).x,land(x+1,z).y,land(x+1,z).z,rgb(255,255,255),1,0):inc v_num
					
					
				next x
			next z
			make mesh from memblock 1,1
			make object obj,1,0
			set object texture obj,2,0
			set object normals obj
			`set object smoothing obj,95
			`set object wireframe obj,1
			texture object obj,2
			inc obj
		next lx
	next lz
	
	

	dec obj
endfunction obj

`Ianm´s Matrix1 & Sparky´s Collision DLL´s test
`======================
`P Parkinson
`======================
`Main Source File

sync on
sync rate 60
autocam off
color backdrop 0, 0
set text font "Arial"
set text size 12
set text transparent
hide mouse 
set ambient light 0

set point light 0,0,500,0
set light range 0,5000

position camera 50,50,-100
point camera 0,0,0

`column and row size
global sz as integer=64

`actual object size to be created centred at 0,0,0 when created
global obj_sz as float=255.0

`array to hold the hight data
dim map_data(sz,sz) as float

`ianm matrix1 command
make object plain 1,obj_sz,obj_sz,sz,sz,338
`set object wireframe 1,1

`make initial map
hmap_fractal()

lock vertexdata for limb 1,0
poly=0
for z=0 to sz
	for x=0 to sz
		set_vertex_hight(poly,map_data(x,z))
		inc poly
	next x
next z
unlock vertexdata
set object normals 1

`add the landcsape to the collision data
SC_setupComplexObject 1,0,2

`make object to use for raycasting
make object cube 10000,1
hide object 10000

`make object to use for marker
make object cube 10001,1
color object 10001,rgb(255,0,0)

do
	
	`make a new map
	`allways remove the old collision data then re add it once any updates are made
	if spacekey()
		SC_removeObject 1
		lock vertexdata for limb 1,0
		poly=0
		hmap_fractal()
		for z=0 to 64
			for x=0 to 64
				set_vertex_hight(poly,map_data(x,z))
				inc poly
			next x
		next z
		unlock vertexdata
		set object normals 1
		SC_setupComplexObject 1,0,2
	endif
	
	`check for raycast to landscape and place marker
	raycast_landscape()
	
	if inkey$()="l" then lower_land()
	if inkey$()="r" then raise_land()
	if inkey$()="t" then create_texture()
	
	mousecontrol(1.0)
	text 0,0,"Press Space To Re-build The Landscape"
	text 0,15,"Screen FPS "+str$(screen fps())
	text 0,30,"Mouse To Look Around - LMB/RMB To Zoom In/Out"
	text 0,45,"´l´ To Lower Land ´r´ To Raise Land"
	text 0,60,"´t´ To Texture Map"
	sync
	
loop


function MouseControl(Speed as float)
	
	xrotate camera camera angle x()+mousemovey()
	yrotate camera camera angle y()+mousemovex()
	if mouseclick()=1 then move camera Speed
	if mouseclick()=2 then move camera (0-Speed)
	
	r=mousemovex()
	r=mousemovey()
	
endfunction

function set_vertex_hight(p,h#)
	
	set vertexdata position p,get vertexdata position x(p),h#/10.0,get vertexdata position z(p)
	if h#>=30 then set vertexdata diffuse p,rgb(h#,255,h#)
	if h#<30 then set vertexdata diffuse p,rgb(255-h#,255-h#,0)
endfunction

function hmap_fractal()
`thanks to who ever did this code,had it so long,and it never fails to work for me
	av as float
	rn as float
	s=sz  ` units and array size; must be a power of 2
	rn=0.07  ` bigger numbers = smoother, smaller = spikier
	smt=1  ` how many times to smooth matrix
	dim a(s,s,1) as float
	` do the diamond square algorithm
	` paying special attention to wrapping around
	c=s
	repeat
	   for z=0 to (s-c) step c
	      for x=0 to (s-c) step c
	         av=(a(x,z)+a(x+c,z)+a(x,z+c)+a(x+c,z+c))/4.0
	         av=av+((-50+rnd(100))/rn)
	         a(x+(c/2),z+(c/2))=av
	      next x
	   next z
	   w=1
	   for z=0 to (s-(c/2)) step (c/2)
	      for x=0 to (s-c) step c
	         x2=x+(w*(c/2))
	         av=a(x2,z+(c/2))+a(x2+(c/2),z)
	         if x2=0
	            av=av+a(s-(c/2),z)
	         else
	            av=av+a(x2-(c/2),z)
	         endif
	         if z=0
	            av=av+a(x2,s-(c/2))
	         else
	            av=av+a(x2,z-(c/2))
	         endif
	         av=av/4.0
	         av=av+((-50+rnd(100))/rn)
	         a(x2,z,0)=av
	         if x2=0 then a(s,z,0)=av
	         if z=0 then a(x2,s,0)=av
	      next x
	      w=1-w
	   next z
	   c=c/2
	   rn=rn*2.0
	until c < 2
	
	` smooth the result
	for multiple=1 to smt
	   for x=0 to s-1
	      x2=x-1 : if x2 < 0 then x2=s-1
	      for z=0 to s-1
	         z2=z-1 : if z2 < 0 then z2=s-1
	         v1#=a(x2,z+1,0)
	         v2#=a(x,z+1,0)
	         v3#=a(x+1,z+1,0)
	         v4#=a(x+1,z,0)
	         v5#=a(x+1,z2,0)
	         v6#=a(x,z2,0)
	         v7#=a(x2,z2,0)
	         v8#=a(x2,z,0)
	         av#=(v1#+v2#+v3#+v4#+v5#+v6#+v7#+v8#)/8.0
	         a(x,z,0)=av#
	      next z
	   next x
	   for f=0 to s
	      a(s,f,0)=a(0,f,0)
	      a(f,s,0)=a(f,0,0)
	   next f
	next multiple
	
	`find min/max height
	minh#=5000:maxh#=-5000
	for z=0 to sz
	   for x=0 to sz
	      if a(x,z,0)<minh# then minh#=a(x,z,0)
	      if a(x,z,0)>maxh# then maxh#=a(x,z,0)
	   next x
	next z
	
	` raise it up so the lowest point is>=0
	for z=0 to sz
	   for x=0 to sz
	      av=a(x,z,0)
	      if minh#<0 then map_data(x,z)=av+abs(minh#)
	      if minh#>=0 then map_data(x,z)=av-minh#
	     next x
	next z
	
	`find new maxh
	maxh#=-5000
	for z=0 to sz
	   for x=0 to sz
	      if map_data(x,z)>maxh# then maxh#=map_data(x,z)
	   next x
	next z
	
	`set at 0 to 255
	if maxh#>255
		d#=maxh#/255.0
		for z=0 to sz
		   for x=0 to sz
		      map_data(x,z)=map_data(x,z,)/d#
		   next x
		next z
	endif

endfunction

function needed_for_sparkys()
	
	if memblock exist(1)
		
	endif
	
endfunction

function raycast_landscape()
	
	position object 10000,camera position x(),camera position y(),camera position z()
	set object to camera orientation 10000
	move object 10000,10000
	hit=SC_rayCast(0,camera position x(),camera position y(),camera position z(),object position x(10000),object position y(10000),object position z(10000),0)
	if hit>0
		cx# = sc_getstaticcollisionx() : nx# = sc_getcollisionnormalx()
     	cy# = sc_getstaticcollisiony() : ny# = sc_getcollisionnormaly()
      cz# = sc_getstaticcollisionz() : nz# = sc_getcollisionnormalz()
		position object 10001,cx#,cy#,cz#
      point object 10001,cx#+(nx#*1000),cy#+(ny#*1000),cz#+(nz#*1000)
	endif
	
endfunction

function lower_land()
	
	texture object 1,0
	x#=object position x(10001)
	y#=object position y(10001)
	z#=object position z(10001)
	
	st#=obj_sz/sz
	x#=x#+(obj_sz/2.0)+obj_sz/sz/2.0
	z#=obj_sz-z#
	z#=z#-(obj_sz/2.0)+obj_sz/sz/2.0
	
	vx=x#/st#
	vz=z#/st#
	text 0,30,"vx "+str$(vx)+" vz "+str$(vz)
	
	`radius around center of explosion
	restore crater:
	for z=-3 to 3
		for x=-3 to 3
			read hd
			if vx+x>=0 and vx+x<=sz and vz+z>=0 and vz+z<=sz
				map_data(vx+x,vz+z)=map_data(vx+x,vz+z)-hd
				if map_data(vx+x,vz+z)<0 then map_data(vx+x,vz+z)=0
			endif
		next x
	next z
	
	SC_removeObject 1
	lock vertexdata for limb 1,0
	poly=0
	for z=0 to 64
		for x=0 to 64
			if get vertexdata position x(poly)<>map_data(x,z)
				set_vertex_hight(poly,map_data(x,z))
			endif
			inc poly
		next x
	next z
	unlock vertexdata
	set object normals 1
	SC_setupComplexObject 1,0,2
	
endfunction

function raise_land()
	
	texture object 1,0
	x#=object position x(10001)
	y#=object position y(10001)
	z#=object position z(10001)
	
	st#=obj_sz/sz
	x#=x#+(obj_sz/2.0)+obj_sz/sz/2.0
	z#=obj_sz-z#
	z#=z#-(obj_sz/2.0)+obj_sz/sz/2.0
	
	vx=x#/st#
	vz=z#/st#
	
	`radius around center of explosion
	restore crater:
	for z=-3 to 3
		for x=-3 to 3
			read hd
			if vx+x>=0 and vx+x<=sz and vz+z>=0 and vz+z<=sz
				map_data(vx+x,vz+z)=map_data(vx+x,vz+z)+hd
				if map_data(vx+x,vz+z)>255 then map_data(vx+x,vz+z)=255
			endif
		next x
	next z
	
	SC_removeObject 1
	lock vertexdata for limb 1,0
	poly=0
	for z=0 to 64
		for x=0 to 64
			if get vertexdata position x(poly)<>map_data(x,z)
				set_vertex_hight(poly,map_data(x,z))
			endif
			inc poly
		next x
	next z
	unlock vertexdata
	set object normals 1
	SC_setupComplexObject 1,0,2
	
endfunction

crater:
data 0,1,2,4,2,1,0
data 1,2,4,8,4,2,1
data 2,4,8,10,8,4,2
data 4,8,10,15,10,8,4
data 2,4,8,10,8,4,2
data 1,2,4,8,4,2,1
data 0,1,2,4,2,1,0

function create_texture()
	
	`make tiles
	`sand grass rock
	make_sprite(235,180,50,1000):sprite 1,-128,-128,1000
	make_sprite(205,128,50,1001):sprite 2,-128,-128,1001
	make_sprite(128,sz,50,1002):sprite 3,-128,-128,1002
	make_sprite(0,200,0,1003):sprite 4,-128,-128,1003
	make_sprite(0,128,0,1004):sprite 5,-128,-128,1004
	make_sprite(0,sz,0,1005):sprite 6,-128,-128,1005
	make_sprite(30,30,30,1006):sprite 7,-128,-128,1006
	make_sprite(70,70,70,1007):sprite 8,-128,-128,1007
	make_sprite(120,120,120,1008):sprite 9,-128,-128,1008
	make_sprite(170,170,170,1009):sprite 10,-128,-128,1009
	make_sprite(220,220,220,1010):sprite 11,-128,-128,1010
	
	create bitmap 1,sz*10,sz*10
	offset=rnd(5)
	set current bitmap 1
	for t=1 to 1
		for z=0 to sz
			for x=0 to sz
				if map_data(x,z)>0+offset and map_data(x,z)<20+offset
					rotate sprite 1,rnd(90)
					paste sprite 1,x*10,z*10
				endif
				if map_data(x,z)>20+offset and map_data(x,z)<40+offset
					rotate sprite 2,rnd(90)
					paste sprite 2,x*10,z*10
				endif
				if map_data(x,z)>40+offset and map_data(x,z)<60+offset
					rotate sprite 3,rnd(90)
					paste sprite 3,x*10,z*10
				endif
				if map_data(x,z)>60+offset and map_data(x,z)<100+offset
					rotate sprite 4,rnd(90)
					paste sprite 4,x*10,z*10
				endif
				if map_data(x,z)>100+offset and map_data(x,z)<130+offset
					rotate sprite 5,rnd(90)
					paste sprite 5,x*10,z*10
				endif
				if map_data(x,z)>130+offset and map_data(x,z)<160+offset
					rotate sprite 6,rnd(90)
					paste sprite 6,x*10,z*10
				endif
				if map_data(x,z)>160+offset and map_data(x,z)<190+offset
					rotate sprite 7,rnd(90)
					paste sprite 7,x*10,z*10
				endif
				if map_data(x,z)>190+offset and map_data(x,z)<210+offset
					rotate sprite 8,rnd(90)
					paste sprite 8,x*10,z*10
				endif
				if map_data(x,z)>210+offset and map_data(x,z)<230+offset
					rotate sprite 9,rnd(90)
					paste sprite 9,x*10,z*10
				endif
				if map_data(x,z)>230+offset and map_data(x,z)<300+offset
					rotate sprite 10,rnd(90)
					paste sprite 10,x*10,z*10
				endif
			next x
		next z
	next t
	
	if image exist(1) then delete image 1
	get image 1,0,0,sz*10,sz*10	
	set current bitmap 0
	texture object 1,1
	
endfunction

function make_sprite(r#,g#,b#,image_num)
		
	if bitmap exist(1) then delete bitmap 1
	set bitmap format 21
	create bitmap 1,128,128
	set current bitmap 1
	set image colorkey 0,0,0
	for l=1 to 1000
		x=rnd(128)
		z=rnd(128)
		dot x,z,rgb(r#,g#,b#)
	next l
	for l=1 to 1000
		x=rnd(128)
		z=rnd(128)
		col#=rnd(30)
		r2#=r#+col#
		if r2#>255 then r2#=255
		if r2#<0 then r2#=0
		g2#=g#+col#
		if g2#>255 then g2#=255
		if g2#<0 then g2#=0
		b2#=b#+col#
		if b2#>255 then b2#=255
		if b2#<0 then b2#=0
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	for l=1 to 100
		x=rnd(128)
		z=rnd(128)
		col#=rnd(50)+50
		r2#=col#
		g2#=col#
		b2#=col#
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	get image image_num,0,0,128,128
	set current bitmap 0
	
endfunction

Function DrawRoadSegment(iRoadObject)
   Dim segx(2000,3) as float
   Dim segy(2000,3) as float
   Dim segz(2000,3) as float

   local x as float
   local y as float
   local z as float
   local t as integer
   local n as integer
   local idir as float
   local bloackno as integer

   x=3600
   y=11.75
   z=-2000
   idir = 300

    for n=0 to 990
		segx(n,0) = x + sin(idir + 270) * 8
		segz(n,0) = z + cos(idir + 270) * 8
		y=Get Terrain Ground Height(ObjTerrain01,segx(n,0),segz(n,0))+.6
		if y<8 then y=8
		segy(n,0) = y 
		segx(n,1) = x
		segz(n,1) = z
		y=Get Terrain Ground Height(ObjTerrain01,segx(n,1),segz(n,1))+.67
		if y<8 then y=8
		segy(n,1) = y
		segx(n,2) = x + sin(idir + 90) * 8
		segz(n,2) = z + cos(idir + 90) * 8
		y=Get Terrain Ground Height(ObjTerrain01,segx(n,2),segz(n,2))+.6
		if y<8 then y=8
		segy(n,2) = y
		x = x + sin(idir) * 16
		z = z + cos(idir) * 16
		if n>111 and n<129 then idir=idir+2
		if n>171 and n<189 then idir=idir-2
		if n>311 and n<329 then idir=idir+1
		if n>371 and n<389 then idir=idir-1
		if n>610 and n<650 then idir=idir-2
		if n>800 and n<840 then idir=idir+2
	next n

   blockno=1
   if memblock exist(blockno) then delete memblock blockno
   make memblock blockno,1048576
   write memblock dword blockno,0,338
   write memblock dword blockno,4,36
   write memblock dword blockno,8,65536
   
   t=0
   for n=0 to 989
   		addvertex(1,t,segx(n,0),segy(n,0),segz(n,0),rgb(255,255,255),0,n)
   		t = t + 1
   		addvertex(1,t,segx(n+1,0),segy(n+1,0),segz(n+1,0),rgb(255,255,255),0,n+1)
   		t = t + 1
   		addvertex(1,t,segx(n,1),segy(n,1),segz(n,1),rgb(255,255,255),.5,n)
   		t = t + 1

   		addvertex(1,t,segx(n,1),segy(n,1),segz(n,1),rgb(255,255,255),.5,n)
   		t = t + 1
   		addvertex(1,t,segx(n+1,0),segy(n+1,0),segz(n+1,0),rgb(255,255,255),0,n+1)
   		t = t + 1
   		addvertex(1,t,segx(n+1,1),segy(n+1,1),segz(n+1,1),rgb(255,255,255),.5,n+1)
   		t = t + 1

   		addvertex(1,t,segx(n,1),segy(n,1),segz(n,1),rgb(255,255,255),.5,n)
   		t = t + 1
   		addvertex(1,t,segx(n+1,1),segy(n+1,1),segz(n+1,1),rgb(255,255,255),.5,n+1)
   		t = t + 1
   		addvertex(1,t,segx(n,2),segy(n,2),segz(n,2),rgb(255,255,255),1,n)
   		t = t + 1

   		addvertex(1,t,segx(n,2),segy(n,2),segz(n,2),rgb(255,255,255),1,n)
   		t = t + 1
   		addvertex(1,t,segx(n+1,1),segy(n+1,1),segz(n+1,1),rgb(255,255,255),.5,n+1)
   		t = t + 1
   		addvertex(1,t,segx(n+1,2),segy(n+1,2),segz(n+1,2),rgb(255,255,255),1,n+1)
   		t = t + 1

   next n
   write memblock dword blockno, 8, t 
   
   	make mesh from memblock 1,1
	make object iRoadObject,1,ImgRoad01
	set object texture iRoadObject, ImgRoad01,0
	set object normals iRoadObject   
endfunction


function addvertex(blockno,v,vposx#,vposy#,vposz#,color as dword,u#,v#)
   write memblock float blockno,v*36+12,vposx#
   write memblock float blockno,v*36+16,vposy#
   write memblock float blockno,v*36+20,vposz#
   write memblock dword blockno,v*36+36,color
   write memblock float blockno,v*36+40,u#
   write memblock float blockno,v*36+44,v#
endfunction

function setnormal(blockno,v,normalx#,normaly#,normalz#)
   write memblock float blockno,v*36+24,normalx#
   write memblock float blockno,v*36+28,normaly#
   write memblock float blockno,v*36+32,normalz#
endfunction

`%ProjectTitle%
`======================
`P Parkinson
`======================
`Main Source File

sync on
sync rate 60
autocam off
color backdrop 0, rgb(200,200,255)
set text font "Arial"
set text size 12
set text transparent

position camera 100,200,0
point camera 0,0,0
position light 0,0,1000,0
set light range 0,10000

`column and row size
global sz as integer=512

`array to hold the hight data
dim map_data(sz,sz) as float
text 0,0,"Please Wait Building Terrain Textures And Heightmaps"
sync
sync
`make initial map
hmap_fractal()

`make the hightmap image
make_hightmap_image(1)

`make texture image
make_texture_image(2)

`make detail texture
make_detail_texture(3)

make object terrain 1
set terrain split 1,8
set terrain scale 1,5.0,0.7,5.0
set terrain heightmap 1,"hm.bmp"
set terrain texture 1,2,3
set terrain tiling 1,16
set terrain light 1,0.0,1.0,0.0,1.1,1.1,1.1,1.0
build terrain 1

do
	mousecontrol(1.0)
	update terrain
	sync
loop


function MouseControl(Speed as float)
	xrotate camera camera angle x()+mousemovey()
	yrotate camera camera angle y()+mousemovex()
	if mouseclick()=1 then move camera Speed
	if mouseclick()=2 then move camera (0-Speed)
	r=mousemovex()
	r=mousemovey()
endfunction

function hmap_fractal()
`thanks to who ever did this code,had it so long,and it never fails to work for me
	av as float
	rn as float
	s=sz  ` units and array size; must be a power of 2
	rn=0.07  ` bigger numbers = smoother, smaller = spikier
	smt=1  ` how many times to smooth matrix
	dim a(s,s,1) as float
	` do the diamond square algorithm
	` paying special attention to wrapping around
	c=s
	repeat
	   for z=0 to (s-c) step c
	      for x=0 to (s-c) step c
	         av=(a(x,z)+a(x+c,z)+a(x,z+c)+a(x+c,z+c))/4.0
	         av=av+((-50+rnd(100))/rn)
	         a(x+(c/2),z+(c/2))=av
	      next x
	   next z
	   w=1
	   for z=0 to (s-(c/2)) step (c/2)
	      for x=0 to (s-c) step c
	         x2=x+(w*(c/2))
	         av=a(x2,z+(c/2))+a(x2+(c/2),z)
	         if x2=0
	            av=av+a(s-(c/2),z)
	         else
	            av=av+a(x2-(c/2),z)
	         endif
	         if z=0
	            av=av+a(x2,s-(c/2))
	         else
	            av=av+a(x2,z-(c/2))
	         endif
	         av=av/4.0
	         av=av+((-50+rnd(100))/rn)
	         a(x2,z,0)=av
	         if x2=0 then a(s,z,0)=av
	         if z=0 then a(x2,s,0)=av
	      next x
	      w=1-w
	   next z
	   c=c/2
	   rn=rn*2.0
	until c < 2
	
	` smooth the result
	for multiple=1 to smt
	   for x=0 to s-1
	      x2=x-1 : if x2 < 0 then x2=s-1
	      for z=0 to s-1
	         z2=z-1 : if z2 < 0 then z2=s-1
	         v1#=a(x2,z+1,0)
	         v2#=a(x,z+1,0)
	         v3#=a(x+1,z+1,0)
	         v4#=a(x+1,z,0)
	         v5#=a(x+1,z2,0)
	         v6#=a(x,z2,0)
	         v7#=a(x2,z2,0)
	         v8#=a(x2,z,0)
	         av#=(v1#+v2#+v3#+v4#+v5#+v6#+v7#+v8#)/8.0
	         a(x,z,0)=av#
	      next z
	   next x
	   for f=0 to s
	      a(s,f,0)=a(0,f,0)
	      a(f,s,0)=a(f,0,0)
	   next f
	next multiple
	
	`find min/max height
	minh#=5000:maxh#=-5000
	for z=0 to sz
	   for x=0 to sz
	      if a(x,z,0)<minh# then minh#=a(x,z,0)
	      if a(x,z,0)>maxh# then maxh#=a(x,z,0)
	   next x
	next z
	
	` raise it up so the lowest point is>=0
	for z=0 to sz
	   for x=0 to sz
	      av=a(x,z,0)
	      if minh#<0 then map_data(x,z)=av+abs(minh#)
	      if minh#>=0 then map_data(x,z)=av-minh#
	     next x
	next z
	
	`find new maxh
	maxh#=-5000
	for z=0 to sz
	   for x=0 to sz
	      if map_data(x,z)>maxh# then maxh#=map_data(x,z)
	   next x
	next z
	
	`set at 0 to 255
	if maxh#>255
		d#=maxh#/255.0
		for z=0 to sz
		   for x=0 to sz
		      map_data(x,z)=map_data(x,z,)/d#
		   next x
		next z
	endif

endfunction

function make_hightmap_image(img_num)
	for z=0 to sz
		for x=0 to sz
			dot x,z,rgb(map_data(x,z),map_data(x,z),map_data(x,z))
		next x
	next z
	get image img_num,0,0,sz,sz
	if file exist("hm.bmp") then delete file "hm.bmp" 
	save image "hm.bmp",img_num
endfunction

function make_texture_image(img_num)
	`make tiles
	`sand grass rock
	make_sprite(235,180,50,1000):sprite 1,-128,-128,1000
	make_sprite(205,128,50,1001):sprite 2,-128,-128,1001
	make_sprite(128,sz,50,1002):sprite 3,-128,-128,1002
	make_sprite(0,200,0,1003):sprite 4,-128,-128,1003
	make_sprite(0,128,0,1004):sprite 5,-128,-128,1004
	make_sprite(0,sz,0,1005):sprite 6,-128,-128,1005
	make_sprite(30,30,30,1006):sprite 7,-128,-128,1006
	make_sprite(70,70,70,1007):sprite 8,-128,-128,1007
	make_sprite(120,120,120,1008):sprite 9,-128,-128,1008
	make_sprite(170,170,170,1009):sprite 10,-128,-128,1009
	make_road_sprite(220,220,220,1010):sprite 11,-128,-128,1010
	
	create bitmap 1,sz*4,sz*4
	offset=rnd(5)
	set current bitmap 1
	for t=1 to 1
		for z=0 to sz
			for x=0 to sz
				if map_data(x,z)>0+offset and map_data(x,z)<20+offset
					rotate sprite 1,rnd(90)
					paste sprite 1,x*4,z*4
				endif
				if map_data(x,z)>20+offset and map_data(x,z)<40+offset
					rotate sprite 2,rnd(90)
					paste sprite 2,x*4,z*4
				endif
				if map_data(x,z)>40+offset and map_data(x,z)<60+offset
					rotate sprite 3,rnd(90)
					paste sprite 3,x*4,z*4
				endif
				if map_data(x,z)>60+offset and map_data(x,z)<100+offset
					rotate sprite 4,rnd(90)
					paste sprite 4,x*4,z*4
				endif
				if map_data(x,z)>100+offset and map_data(x,z)<130+offset
					rotate sprite 5,rnd(90)
					paste sprite 5,x*4,z*4
				endif
				if map_data(x,z)>130+offset and map_data(x,z)<160+offset
					rotate sprite 6,rnd(90)
					paste sprite 6,x*4,z*4
				endif
				if map_data(x,z)>160+offset and map_data(x,z)<190+offset
					rotate sprite 7,rnd(90)
					paste sprite 7,x*4,z*4
				endif
				if map_data(x,z)>190+offset and map_data(x,z)<210+offset
					rotate sprite 8,rnd(90)
					paste sprite 8,x*4,z*4
				endif
				if map_data(x,z)>210+offset and map_data(x,z)<230+offset
					rotate sprite 9,rnd(90)
					paste sprite 9,x*4,z*4
				endif
				if map_data(x,z)>230+offset and map_data(x,z)<300+offset
					rotate sprite 10,rnd(90)
					paste sprite 10,x*4,z*4
				endif
			next x
		next z
	next t
	for z=0 to sz*4 step 400
		for x=0 to sz*4 
			rotate sprite 11,rnd(90)
			paste sprite 11,x,z
		next x
	next z
	for x=0 to sz*4 step 400
		for z=0 to sz*4 
			rotate sprite 11,rnd(90)
			paste sprite 11,x,z
		next z
	next x
	get image img_num,0,0,sz*4,sz*4	
	set current bitmap 0
	if file exist("tex.bmp") then delete file "tex.bmp" 
	save image "tex.bmp",img_num
endfunction

function make_sprite(r#,g#,b#,image_num)
		
	if bitmap exist(1) then delete bitmap 1
	set bitmap format 21
	create bitmap 1,128,128
	set current bitmap 1
	set image colorkey 0,0,0
	for l=1 to 1000
		x=rnd(128)
		z=rnd(128)
		dot x,z,rgb(r#,g#,b#)
	next l
	for l=1 to 1000
		x=rnd(128)
		z=rnd(128)
		col#=rnd(30)
		r2#=r#+col#
		if r2#>255 then r2#=255
		if r2#<0 then r2#=0
		g2#=g#+col#
		if g2#>255 then g2#=255
		if g2#<0 then g2#=0
		b2#=b#+col#
		if b2#>255 then b2#=255
		if b2#<0 then b2#=0
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	for l=1 to 100
		x=rnd(128)
		z=rnd(128)
		col#=rnd(50)+50
		r2#=col#
		g2#=col#
		b2#=col#
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	get image image_num,0,0,128,128
	set current bitmap 0
	
endfunction

function make_road_sprite(r#,g#,b#,image_num)
		
	if bitmap exist(1) then delete bitmap 1
	set bitmap format 21
	create bitmap 1,32,32
	set current bitmap 1
	set image colorkey 0,0,0
	for l=1 to 1000
		x=rnd(32)
		z=rnd(32)
		dot x,z,rgb(r#,g#,b#)
	next l
	for l=1 to 1000
		x=rnd(32)
		z=rnd(32)
		col#=rnd(30)
		r2#=r#+col#
		if r2#>255 then r2#=255
		if r2#<0 then r2#=0
		g2#=g#+col#
		if g2#>255 then g2#=255
		if g2#<0 then g2#=0
		b2#=b#+col#
		if b2#>255 then b2#=255
		if b2#<0 then b2#=0
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	for l=1 to 100
		x=rnd(32)
		z=rnd(32)
		col#=rnd(50)+50
		r2#=col#
		g2#=col#
		b2#=col#
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	get image image_num,0,0,32,32
	set current bitmap 0
	
endfunction

function make_detail_texture(img_num)
	for y=0 to 256
		for x=0 to 256
			col=rnd(50)+50
			``if rnd(100)<50
				dot x,y,rgb(col,col,col)
			``endif
		next x
	next y
	get image img_num,0,0,256,256
	if file exist("det.bmp") then delete file "det.bmp" 
	save image "det.bmp",img_num
endfunction

`%ProjectTitle%
`======================
`P Parkinson
`======================
`Main Source File
set display mode 1024,768,32
sync on
sync rate 60
autocam off
color backdrop 0, rgb(200,200,255)
set text font "Arial"
set text size 12
set text transparent

position camera 100,200,0
point camera 0,0,0
position light 0,0,1000,0
set light range 0,10000

`column and row size
global sz as integer=512

`array to hold the hight data
dim map_data(sz,sz) as float
text 0,0,"Please Wait Building Terrain Textures And Heightmaps"
sync
sync
`make initial map
hmap_fractal()

`make the hightmap image
make_hightmap_image(1)

`make texture image
make_texture_image(2)

`make detail texture
make_detail_texture(3)

make object terrain 1
set terrain split 1,8
set terrain scale 1,5.0,0.7,5.0
set terrain heightmap 1,"hm.bmp"
set terrain texture 1,2,3
set terrain tiling 1,16
set terrain light 1,0.0,1.0,0.0,1.1,1.1,1.1,1.0
build terrain 1

do
	mousecontrol(1.0)
	update terrain
	sync
loop


function MouseControl(Speed as float)
	xrotate camera camera angle x()+mousemovey()
	yrotate camera camera angle y()+mousemovex()
	if mouseclick()=1 then move camera Speed
	if mouseclick()=2 then move camera (0-Speed)
	r=mousemovex()
	r=mousemovey()
endfunction

function hmap_fractal()
`thanks to who ever did this code,had it so long,and it never fails to work for me
	av as float
	rn as float
	s=sz  ` units and array size; must be a power of 2
	rn=0.07  ` bigger numbers = smoother, smaller = spikier
	smt=1  ` how many times to smooth matrix
	dim a(s,s,1) as float
	` do the diamond square algorithm
	` paying special attention to wrapping around
	c=s
	repeat
	   for z=0 to (s-c) step c
	      for x=0 to (s-c) step c
	         av=(a(x,z)+a(x+c,z)+a(x,z+c)+a(x+c,z+c))/4.0
	         av=av+((-50+rnd(100))/rn)
	         a(x+(c/2),z+(c/2))=av
	      next x
	   next z
	   w=1
	   for z=0 to (s-(c/2)) step (c/2)
	      for x=0 to (s-c) step c
	         x2=x+(w*(c/2))
	         av=a(x2,z+(c/2))+a(x2+(c/2),z)
	         if x2=0
	            av=av+a(s-(c/2),z)
	         else
	            av=av+a(x2-(c/2),z)
	         endif
	         if z=0
	            av=av+a(x2,s-(c/2))
	         else
	            av=av+a(x2,z-(c/2))
	         endif
	         av=av/4.0
	         av=av+((-50+rnd(100))/rn)
	         a(x2,z,0)=av
	         if x2=0 then a(s,z,0)=av
	         if z=0 then a(x2,s,0)=av
	      next x
	      w=1-w
	   next z
	   c=c/2
	   rn=rn*2.0
	until c < 2
	
	` smooth the result
	for multiple=1 to smt
	   for x=0 to s-1
	      x2=x-1 : if x2 < 0 then x2=s-1
	      for z=0 to s-1
	         z2=z-1 : if z2 < 0 then z2=s-1
	         v1#=a(x2,z+1,0)
	         v2#=a(x,z+1,0)
	         v3#=a(x+1,z+1,0)
	         v4#=a(x+1,z,0)
	         v5#=a(x+1,z2,0)
	         v6#=a(x,z2,0)
	         v7#=a(x2,z2,0)
	         v8#=a(x2,z,0)
	         av#=(v1#+v2#+v3#+v4#+v5#+v6#+v7#+v8#)/8.0
	         a(x,z,0)=av#
	      next z
	   next x
	   for f=0 to s
	      a(s,f,0)=a(0,f,0)
	      a(f,s,0)=a(f,0,0)
	   next f
	next multiple
	
	`find min/max height
	minh#=5000:maxh#=-5000
	for z=0 to sz
	   for x=0 to sz
	      if a(x,z,0)<minh# then minh#=a(x,z,0)
	      if a(x,z,0)>maxh# then maxh#=a(x,z,0)
	   next x
	next z
	
	` raise it up so the lowest point is>=0
	for z=0 to sz
	   for x=0 to sz
	      av=a(x,z,0)
	      if minh#<0 then map_data(x,z)=av+abs(minh#)
	      if minh#>=0 then map_data(x,z)=av-minh#
	     next x
	next z
	
	`find new maxh
	maxh#=-5000
	for z=0 to sz
	   for x=0 to sz
	      if map_data(x,z)>maxh# then maxh#=map_data(x,z)
	   next x
	next z
	
	`set at 0 to 255
	if maxh#>255
		d#=maxh#/255.0
		for z=0 to sz
		   for x=0 to sz
		      map_data(x,z)=map_data(x,z,)/d#
		   next x
		next z
	endif

endfunction

function make_hightmap_image(img_num)
	for z=0 to sz
		for x=0 to sz
			dot x,z,rgb(map_data(x,z),map_data(x,z),map_data(x,z))
		next x
	next z
	get image img_num,0,0,sz,sz
	if file exist("hm.bmp") then delete file "hm.bmp" 
	save image "hm.bmp",img_num
endfunction

function make_texture_image(img_num)
	`make tiles
	`sand grass rock
	make_sprite(235,180,50,1000):sprite 1,-128,-128,1000
	make_sprite(205,128,50,1001):sprite 2,-128,-128,1001
	make_sprite(128,sz,50,1002):sprite 3,-128,-128,1002
	make_sprite(0,200,0,1003):sprite 4,-128,-128,1003
	make_sprite(0,128,0,1004):sprite 5,-128,-128,1004
	make_sprite(0,sz,0,1005):sprite 6,-128,-128,1005
	make_sprite(30,30,30,1006):sprite 7,-128,-128,1006
	make_sprite(70,70,70,1007):sprite 8,-128,-128,1007
	make_sprite(120,120,120,1008):sprite 9,-128,-128,1008
	make_sprite(170,170,170,1009):sprite 10,-128,-128,1009
	make_road_sprite(220,220,220,1010):sprite 11,-128,-128,1010
	
	create bitmap 1,sz*4,sz*4
	offset=rnd(5)
	set current bitmap 1
	for t=1 to 1
		for z=0 to sz
			for x=0 to sz
				if map_data(x,z)>0+offset and map_data(x,z)<20+offset
					rotate sprite 1,rnd(90)
					paste sprite 1,x*4,z*4
				endif
				if map_data(x,z)>20+offset and map_data(x,z)<40+offset
					rotate sprite 2,rnd(90)
					paste sprite 2,x*4,z*4
				endif
				if map_data(x,z)>40+offset and map_data(x,z)<60+offset
					rotate sprite 3,rnd(90)
					paste sprite 3,x*4,z*4
				endif
				if map_data(x,z)>60+offset and map_data(x,z)<100+offset
					rotate sprite 4,rnd(90)
					paste sprite 4,x*4,z*4
				endif
				if map_data(x,z)>100+offset and map_data(x,z)<130+offset
					rotate sprite 5,rnd(90)
					paste sprite 5,x*4,z*4
				endif
				if map_data(x,z)>130+offset and map_data(x,z)<160+offset
					rotate sprite 6,rnd(90)
					paste sprite 6,x*4,z*4
				endif
				if map_data(x,z)>160+offset and map_data(x,z)<190+offset
					rotate sprite 7,rnd(90)
					paste sprite 7,x*4,z*4
				endif
				if map_data(x,z)>190+offset and map_data(x,z)<210+offset
					rotate sprite 8,rnd(90)
					paste sprite 8,x*4,z*4
				endif
				if map_data(x,z)>210+offset and map_data(x,z)<230+offset
					rotate sprite 9,rnd(90)
					paste sprite 9,x*4,z*4
				endif
				if map_data(x,z)>230+offset and map_data(x,z)<300+offset
					rotate sprite 10,rnd(90)
					paste sprite 10,x*4,z*4
				endif
			next x
		next z
	next t
	for z=0 to sz*4 step 400
		for x=0 to sz*4 
			rotate sprite 11,rnd(90)
			paste sprite 11,x,z
		next x
	next z
	for x=0 to sz*4 step 400
		for z=0 to sz*4 
			rotate sprite 11,rnd(90)
			paste sprite 11,x,z
		next z
	next x
	get image img_num,0,0,sz*4,sz*4	
	set current bitmap 0
	if file exist("tex.bmp") then delete file "tex.bmp" 
	save image "tex.bmp",img_num
endfunction

function make_sprite(r#,g#,b#,image_num)
		
	if bitmap exist(1) then delete bitmap 1
	set bitmap format 21
	create bitmap 1,128,128
	set current bitmap 1
	set image colorkey 0,0,0
	for l=1 to 1000
		x=rnd(128)
		z=rnd(128)
		dot x,z,rgb(r#,g#,b#)
	next l
	for l=1 to 1000
		x=rnd(128)
		z=rnd(128)
		col#=rnd(30)
		r2#=r#+col#
		if r2#>255 then r2#=255
		if r2#<0 then r2#=0
		g2#=g#+col#
		if g2#>255 then g2#=255
		if g2#<0 then g2#=0
		b2#=b#+col#
		if b2#>255 then b2#=255
		if b2#<0 then b2#=0
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	for l=1 to 100
		x=rnd(128)
		z=rnd(128)
		col#=rnd(50)+50
		r2#=col#
		g2#=col#
		b2#=col#
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	get image image_num,0,0,128,128
	set current bitmap 0
	
endfunction

function make_road_sprite(r#,g#,b#,image_num)
		
	if bitmap exist(1) then delete bitmap 1
	set bitmap format 21
	create bitmap 1,32,32
	set current bitmap 1
	set image colorkey 0,0,0
	for l=1 to 1000
		x=rnd(32)
		z=rnd(32)
		dot x,z,rgb(r#,g#,b#)
	next l
	for l=1 to 1000
		x=rnd(32)
		z=rnd(32)
		col#=rnd(30)
		r2#=r#+col#
		if r2#>255 then r2#=255
		if r2#<0 then r2#=0
		g2#=g#+col#
		if g2#>255 then g2#=255
		if g2#<0 then g2#=0
		b2#=b#+col#
		if b2#>255 then b2#=255
		if b2#<0 then b2#=0
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	for l=1 to 100
		x=rnd(32)
		z=rnd(32)
		col#=rnd(50)+50
		r2#=col#
		g2#=col#
		b2#=col#
		dot x,z,rgb(r2#,g2#,b2#)
	next l
	get image image_num,0,0,32,32
	set current bitmap 0
	
endfunction

function make_detail_texture(img_num)
	for y=0 to 256
		for x=0 to 256
			col=rnd(50)+50
			``if rnd(100)<50
				dot x,y,rgb(col,col,col)
			``endif
		next x
	next y
	get image img_num,0,0,256,256
	if file exist("det.bmp") then delete file "det.bmp" 
	save image "det.bmp",img_num
endfunction