Sorry your browser is not supported!

gosub setup
gosub images
gosub fog
gosub matrix
gosub lights
gosub sun
gosub camera
gosub sky
Peak(1)

ink rgb(255,255,255),0

`LOOP
REPEAT
   text 0,0,"Press RETURN to generate a random mountain."
   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f

   if ReturnKey()=1 then repeat:until Returnkey()=0 : Peak(1)
   sync
UNTIL Mouseclick()=1

end

`--------------------
` Functions
`--------------------
FUNCTION Peak(m)
   For z = 0 to 20
      For x = 0 to 20
         diff#=ABS(10-x)+ABS(10-z)
         h#=(100-(diff#*6))-rnd(diff#^1.5)
         if h#<0 then h#=0

         set matrix height m,x,z,h#
         if x=0 or z=0 or x=20 or z=20 then set matrix height m,x,z,0
      Next x
   Next z

   Normalise(m)
   Update Matrix m
ENDFUNCTION
`----
`By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
Function Normalise(MatNum)
  For z=1 to 20
    For x=1 to 20
      h8#=get matrix height(MatNum,x,z-1)*5
      h4#=get matrix height(MatNum,x-1,z)*5
      h#=get matrix height(MatNum,x,z)*5
      h2#=get matrix height(MatNum,x,z)*5
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
EndFunction

`--------------------
` Gosubs
`--------------------
Setup:
   set display mode 1024,768,32
   randomize timer()
   hide mouse
   sync on
   sync rate 30
   autocam off
Return
`----
Matrix:
   make matrix 1,100,100,20,20
   set matrix wireframe off 1
   prepare matrix texture 1,1,20,20
   for z = 0 to 19
      for x = 0 to 19
         set matrix tile 1,x,z,x+(z*20)
      next x
   next z
Return
`----
Lights:
   color ambient light 0
   set ambient light 20
   make light 1
   set directional light 0,0,0,1
   set directional light 1,1,-.5,1
   color backdrop rgb(0,100,255)
Return
`----
Sun:
   for s = 10 to 25
      make object sphere 10+s,s^2
      scale object 10+s,104,70,99
      color object 10+s,rgb(255,180,50)
      ghost object on 10+s
      position object 10+s,-210,50,200
   next s
`----
Camera:
   position camera 200,70,-200
   point camera -20,60,50
   set camera fov 0.8
Return
`----
Images:
   `mountain image
   ink RGB(200,200,180),rgb(40,40,45)
   cls
   for n = 1 to 200
      x=rnd(256):y=rnd(256)
      line x,y,x+rnd(64),y+rnd(64)
   next n
   get image 1,0,0,256,256

   `clouds image
   cls rgb(255,255,255)
   for n = 1 to 1000
      x=rnd(255)
      ink rgb(x,x,x),0
      dot rnd(63),rnd(63)
   next n
   get image 3,0,0,64,64
Return
`----
Sky:
   color backdrop rgb(200,255,255)
Return
`----
Fog:
   for f = 1 to 6
      make object plain 10+f,1000,1000
      texture object 10+f,3
      xrotate object 10+f,90
      fix object pivot 10+f
      yrotate object 10+f,45
      if f>1 then ghost object on 10+f
      position object 10+f,50,10+(5*f),50
   next f
Return

`======================
`SNOW: A WEATHER EFFECT
`BY ALEX JONES (INH)
`======================

sync on
sync rate 30
autocam off
gosub images
gosub createobjects

`=========
`MAIN LOOP
`=========
x#=0
ink rgb(0,0,0),0
do
	for t=1 to 700
		if rnd(3)=0 then sy#=0
		if rnd(3)=1 then sy#=0.2
		if rnd(3)=2 then sy#=0.4
		if rnd(3)=3 then sy#=0.6
		yrotate object t,wrapvalue(object angle y(t)+rnd(2))
		zrotate object t,wrapvalue(object angle z(t)+10+rnd(10))
 
		move object t,sy#
		if object position y(t)<-5+mhh# then position object t,-19+x#,30+rnd(50),30+rnd(10) : inc sfn,1 : inc x#,0.2 : inc mmh#,0.0007
		position object (t),object position x(t),object position y(t)-0.2,object position z(t)
	next t
	if sfn=>700 then x#=0 : sfn=0
	position matrix 1,-200,-5+mmh#,-10
	if matrix position y(1)>0.4 then gosub lowermatrix



remstart

rem Use MOUSEMOVE to alter camera angles
cx#=wrapvalue(cx#+mousemovey())
cy#=wrapvalue(cy#+mousemovex())
cz#=wrapvalue(cz#+mousemovez())
rotate camera cx#,cy#,cz#

rem Simple movement
if upkey()=1 then move camera 25
if downkey()=1 then move camera -25
remend


	sync
loop

`======================
`LOWER THE MATRIX AGAIN
`======================
lowermatrix:
for t=255 to 15 step -20
set gamma t,t,t
sync
next t
mmh#=0
position matrix 1,-200,-5+mmh#,-10
for t=15 to 255 step 20
set gamma t,t,t
sync
next t
return


`============
`============
`MAKE OBJECTS
`============
`============
createobjects:
`==========
`SNOWFLAKES
`==========
	for t=1 to 700
		make object box (t),1,0.01,1
		position object (t),-19+x#,-10+rnd(50),20+rnd(10)
		texture object (t),1
		set object (t),1,0,1
		inc x#,0.2
		xrotate object t,90
	next t
`=========
`SKYSPHERE
`=========

	make object sphere 701,700
	texture object 701,2
	set object 701,1,1,0
	position object 701,0,0,0
`======
`MATRIX
`======
	make matrix 1,400,400,40,40
	position matrix 1,-200,0,-10
	position camera 30,5,-10
	prepare matrix texture 1,3,1,1
	randomize matrix 1,6
	  for t=0 to 40
		for mhy=21 to 40
			set matrix height 1,t,mhy,-91+(mhy*5)+rnd(20)
		next mhy
	  next t

   update matrix 1
	Normalise(1)

return


`======
`IMAGES
`======
images:
cls
	ink rgb(255,255,255),0
	box 90,0,110,200
	box 0,90,200,110


	for t=40 to 60
		circle 100,100,t
	next t

	get image 1,0,0,201,201
cls
	for t=0 to 100
		ink rgb(55+(t),55+(t),100+t),0
		line 0,t,100,t
	next t
	ink rgb(255,255,255),0
	box 0,100,100,120
	get image 2,0,0,101,121
cls
	for t=0 to 100
   ink rgb(255-(t/5),255-(t/5),255-(t/5)),0
	box 0+t,0+t,100-t,100-t
	next t
	get image 3,0,0,101,101

return


Function Normalise(MatNum)
  For z=1 to 40
    For x=1 to 40
      h8#=get matrix height(MatNum,x,z-1)*5
      h4#=get matrix height(MatNum,x-1,z)*5
      h#=get matrix height(MatNum,x,z)*5
      h2#=get matrix height(MatNum,x,z)*5
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
EndFunction

gosub setup
gosub images
gosub fog
gosub matrix
gosub lights
gosub sun
gosub camera
gosub sky
Peak(1)

ink rgb(255,255,255),0

`LOOP
REPEAT
   text 0,0,"Press RETURN to generate a random mountain."
   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f

   if ReturnKey()=1 then repeat:until Returnkey()=0 : Peak(1)
   sync
UNTIL Mouseclick()=1

end

`--------------------
` Functions
`--------------------
FUNCTION Peak(m)
   For z = 0 to 20
      For x = 0 to 20
         diff#=ABS(10-x)+ABS(10-z)
         h#=(100-(diff#*6))-rnd(diff#^1.5)
         if h#<0 then h#=0

         set matrix height m,x,z,h#
         if x=0 or z=0 or x=20 or z=20 then set matrix height m,x,z,0
      Next x
   Next z

   Normalise(m)
   Update Matrix m
ENDFUNCTION
`----
`By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
Function Normalise(MatNum)
  For z=1 to 20
    For x=1 to 20
      h8#=get matrix height(MatNum,x,z-1)*5
      h4#=get matrix height(MatNum,x-1,z)*5
      h#=get matrix height(MatNum,x,z)*5
      h2#=get matrix height(MatNum,x,z)*5
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
EndFunction

`--------------------
` Gosubs
`--------------------
Setup:
   set display mode 1024,768,32
   randomize timer()
   hide mouse
   sync on
   sync rate 30
   autocam off
Return
`----
Matrix:
   make matrix 1,100,100,20,20
   set matrix wireframe off 1
   prepare matrix texture 1,1,20,20
   for z = 0 to 19
      for x = 0 to 19
         set matrix tile 1,x,z,x+(z*20)
      next x
   next z
Return
`----
Lights:
   color ambient light 0
   set ambient light 20
   make light 1
   set directional light 0,0,0,1
   set directional light 1,1,-.5,1
   color backdrop rgb(0,100,255)
Return
`----
Sun:
   for s = 10 to 25
      make object sphere 10+s,s*3
      color object 10+s,rgb(255,180,50)
      ghost object on 10+s
      position object 10+s,-210,80,200
   next s
`----
Camera:
   position camera 200,70,-200
   point camera -20,60,50
   set camera fov 0.8
Return
`----
Images:
   `mountain image
   ink RGB(200,200,180),rgb(40,40,45)
   cls
   for n = 1 to 200
      x=rnd(256):y=rnd(256)
      line x,y,x+rnd(64),y+rnd(64)
   next n
   get image 1,0,0,256,256

   `clouds image
   cls rgb(255,255,255)
   for n = 1 to 1000
      x=rnd(255)
      ink rgb(x,x,x),0
      dot rnd(63),rnd(63)
   next n
   get image 3,0,0,64,64
Return
`----
Sky:
   color backdrop 0
Return
`----
Fog:
   for f = 1 to 6
      make object plain 10+f,1000,1000
      texture object 10+f,3
      xrotate object 10+f,90
      fix object pivot 10+f
      yrotate object 10+f,45
      if f>1 then ghost object on 10+f
      position object 10+f,50,10+(5*f),50
   next f
Return

set display mode 800,600,32
autocam off
sync on

for r=0 to 128
   c=255-(1.8*r)
   ink rgb(c,c,200),0
   circle 128,128,r
   circle 128,127,r
next r
get image 1,0,0,256,256
sync

make object plain 1,1000,1000
texture object 1,1
set object 1,1,0,1

make matrix 1,1000,1000,25,25
set matrix wireframe off 1
position object 1,500,0,400

position camera 500,50,0

wait key

`======================
`SNOW: A WEATHER EFFECT
`BY ALEX JONES (INH)
`======================

sync on
sync rate 30
autocam off
gosub images
gosub createobjects

`=========
`MAIN LOOP
`=========
x#=0
ink rgb(0,0,0),0
do
   for t=1 to 700
      if rnd(3)=0 then sy#=0
      if rnd(3)=1 then sy#=0.2
      if rnd(3)=2 then sy#=0.4
      if rnd(3)=3 then sy#=0.6
      yrotate object t,wrapvalue(object angle y(t)+rnd(2))
      zrotate object t,wrapvalue(object angle z(t)+10+rnd(10))

      move object t,sy#
      if object position y(t)<-5+mhh# then position object t,-19+x#,30+rnd(50),30+rnd(10) : inc sfn,1 : inc x#,0.2 : inc mmh#,0.0007
      position object (t),object position x(t),object position y(t)-0.2,object position z(t)
   next t
   if sfn=>700 then x#=0 : sfn=0
   position matrix 1,-200,-5+mmh#,-10
   if matrix position y(1)>0.4 then gosub lowermatrix



remstart

rem Use MOUSEMOVE to alter camera angles
cx#=wrapvalue(cx#+mousemovey())
cy#=wrapvalue(cy#+mousemovex())
cz#=wrapvalue(cz#+mousemovez())
rotate camera cx#,cy#,cz#

rem Simple movement
if upkey()=1 then move camera 25
if downkey()=1 then move camera -25
remend


   sync
loop

`======================
`LOWER THE MATRIX AGAIN
`======================
lowermatrix:
for t=255 to 15 step -20
set gamma t,t,t
sync
next t
mmh#=0
position matrix 1,-200,-5+mmh#,-10
for t=15 to 255 step 20
set gamma t,t,t
sync
next t
return


`============
`============
`MAKE OBJECTS
`============
`============
createobjects:
`==========
`SNOWFLAKES
`==========
   for t=1 to 700
      make object box (t),1,0.01,1
      position object (t),-19+x#,-10+rnd(50),20+rnd(10)
      texture object (t),1
      set object (t),1,0,1
      inc x#,0.2
      xrotate object t,90
   next t
`=========
`SKYSPHERE
`=========

   make object sphere 701,700
   texture object 701,2
   set object 701,1,1,0
   position object 701,0,0,0
`======
`MATRIX
`======
   make matrix 1,400,400,40,40
   position matrix 1,-200,0,-10
   position camera 30,5,-10
   prepare matrix texture 1,3,1,1
   randomize matrix 1,6
     for t=0 to 40
      for mhy=21 to 40
         set matrix height 1,t,mhy,-91+(mhy*5)+rnd(20)
      next mhy
     next t

   update matrix 1
   Normalise(1)

return


`======
`IMAGES
`======
images:
cls
   ink rgb(255,255,255),0
   box 90,0,110,200
   box 0,90,200,110


   for t=40 to 60
      circle 100,100,t
   next t

   get image 1,0,0,201,201
cls
   for t=0 to 100
      ink rgb(55+(t),55+(t),100+t),0
      line 0,t,100,t
   next t
   ink rgb(255,255,255),0
   box 0,100,100,120
   get image 2,0,0,101,121
cls
   for t=0 to 100
   ink rgb(255-(t/5),255-(t/5),255-(t/5)),0
   box 0+t,0+t,100-t,100-t
   next t
   get image 3,0,0,101,101

   rem add a little lighting for dbc 1.20
   color ambient light 0
   set ambient light 50
   make light 1
   set directional light 0,.5,-1,0

return


Function Normalise(MatNum)
  For z=1 to 40
    For x=1 to 40
      h8#=get matrix height(MatNum,x,z-1)*5
      h4#=get matrix height(MatNum,x-1,z)*5
      h#=get matrix height(MatNum,x,z)*5
      h2#=get matrix height(MatNum,x,z)*5
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
EndFunction

gosub setup
gosub images
gosub fog
gosub matrix
gosub lights
gosub sun
gosub camera
gosub sky
Peak(1)



mpy#=-60
ink rgb(255,255,255),0
set text size 25
position matrix 1,50,mpy#,-160
position object 11,0,45,0


for t=0 to 255 step 2
	ink rgb(t,t,t),0
`   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f
	text 0,0,"Once upon a time, this country was a happy, bright place."
	sync
next t

for t=255 to 0 step -2
	ink rgb(t,t,t),0
`   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f
	text 0,0,"Once upon a time, this country was a happy, bright place."
	sync
next t

for t=0 to 255 step 2
	ink rgb(t,t,t),0
`   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f
	text 0,0,"Then one day, a mighty mountain rose up and blocked out the sun."
	sync
next t

for t=255 to 0 step -2
	ink rgb(t,t,t),0
`   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f
	text 0,0,"Then one day, a mighty mountain rose up and blocked out the sun."
	sync
next t

gp#=45
for t=0 to 120
   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f
	inc mpy#,0.5
	position matrix 1,50,mpy#,-160
	gm=255
	set gamma gm,gm,gm
	dec gm,1
	position object 11,0,gp#,0
	dec gp#,0.3	
	sync
next t

end

`--------------------
` Functions
`--------------------
FUNCTION Peak(m)
   For z = 0 to 20
      For x = 0 to 20
         diff#=ABS(10-x)+ABS(10-z)
         h#=(100-(diff#*6))-rnd(diff#^1.5)
         if h#<0 then h#=0

         set matrix height m,x,z,h#
         if x=0 or z=0 or x=20 or z=20 then set matrix height m,x,z,0
      Next x
   Next z

   Normalise(m)
   Update Matrix m

ENDFUNCTION
`----
`By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
Function Normalise(MatNum)
  For z=1 to 20
    For x=1 to 20
      h8#=get matrix height(MatNum,x,z-1)*5
      h4#=get matrix height(MatNum,x-1,z)*5
      h#=get matrix height(MatNum,x,z)*5
      h2#=get matrix height(MatNum,x,z)*5
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
EndFunction

`--------------------
` Gosubs
`--------------------
Setup:
   set display mode 1024,768,32
   randomize timer()
   hide mouse
   sync on
   sync rate 30
   autocam off
Return
`----
Matrix:

   make matrix 1,100,100,20,20
   set matrix wireframe off 1
   prepare matrix texture 1,1,20,20
   for z = 0 to 19
      for x = 0 to 19
         set matrix tile 1,x,z,x+(z*20)
      next x
   next z
Return

`----
Lights:
   color ambient light 0
   set ambient light 20
   make light 1
   set directional light 0,0,0,1
   set directional light 1,1,-.5,1
   color backdrop rgb(0,100,255)
Return
`----
Sun:
   for s = 10 to 25
      make object sphere 10+s,s*3
      color object 10+s,rgb(255,180,50)
      ghost object on 10+s
      position object 10+s,-210,80,200
   next s
`----
Camera:
   position camera 200,70,-200
   point camera -20,60,50
   set camera fov 0.8
Return
`----
Images:
   `mountain image
   ink RGB(200,200,180),rgb(40,40,45)
   cls
   for n = 1 to 200
      x=rnd(256):y=rnd(256)
      line x,y,x+rnd(64),y+rnd(64)
   next n
   get image 1,0,0,256,256

   `clouds image
   cls rgb(255,255,255)
   for n = 1 to 1000
      x=rnd(255)
      ink rgb(x,x,x),0
      dot rnd(63),rnd(63)
   next n
   get image 3,0,0,64,64
	`groundimage
	cls rgb(0,100,0)
	ink rgb(0,50,0),0
	for t=0 to 1000
	dot rnd(100),rnd(100)
	next t
	get image 2,0,0,100,100
Return
`----
Sky:
   color backdrop 0
Return
`----
Fog:
   for f = 1 to 6
      make object plain 10+f,1000,1000
      texture object 10+f,3
      xrotate object 10+f,90
      fix object pivot 10+f
      yrotate object 10+f,45
      if f>1 then ghost object on 10+f,30
      position object 10+f,50,10+(5*f),50
   next f
	texture object 11,2
Return

gosub setup
gosub images
gosub fog
gosub matrix
gosub lights
gosub sun
gosub camera
gosub sky
Peak(1)

ink rgb(255,255,255),0

`LOOP
REPEAT
   text 0,0,"Press RETURN to generate a random mountain."
   inc scroll#,.000003
   for f = 1 to 5
      scroll object texture f+10,scroll#*f,scroll#*rnd(f)
   next f

   if ReturnKey()=1 then repeat:until Returnkey()=0 : Peak(1)
   sync
UNTIL Mouseclick()=1

end

`--------------------
` Functions
`--------------------
FUNCTION Peak(m)
   For z = 0 to 20
      For x = 0 to 20
         diff#=ABS(10-x)+ABS(10-z)
         h#=(100-(diff#*6))-rnd(diff#^1.5)
         if h#<0 then h#=0

         set matrix height m,x,z,h#
         if x=0 or z=0 or x=20 or z=20 then set matrix height m,x,z,0
      Next x
   Next z

   Normalise(m)
   Update Matrix m
ENDFUNCTION
`----
`By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
Function Normalise(MatNum)
  For z=1 to 20
    For x=1 to 20
      h8#=get matrix height(MatNum,x,z-1)*5
      h4#=get matrix height(MatNum,x-1,z)*5
      h#=get matrix height(MatNum,x,z)*5
      h2#=get matrix height(MatNum,x,z)*5
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set matrix normal MatNum,x,z,nx#,ny#,nz#
    next x
  next z
  Update Matrix MatNum
EndFunction

`--------------------
` Gosubs
`--------------------
Setup:
   set display mode 1024,768,32
   randomize timer()
   hide mouse
   sync on
   sync rate 30
   autocam off
Return
`----
Matrix:
   make matrix 1,100,100,20,20
   set matrix wireframe off 1
   prepare matrix texture 1,1,20,20
   for z = 0 to 19
      for x = 0 to 19
         set matrix tile 1,x,z,x+(z*20)
      next x
   next z
Return
`----
Lights:
   color ambient light 0
   set ambient light 20
   make light 1
   set directional light 0,0,0,1
   set directional light 1,1,-.5,1
   color backdrop rgb(0,100,255)
Return
`----
Sun:
   for s = 10 to 25
      make object sphere 10+s,s*3
      color object 10+s,rgb(255,100,0)
      ghost object on 10+s
      position object 10+s,-230,40,200
   next s
`----
Camera:
   position camera 200,70,-200
   point camera -20,60,50
   set camera fov 0.8
Return
`----
Images:
   `mountain image
   ink RGB(200,200,180),rgb(40,40,45)
   cls
   for n = 1 to 200
      x=rnd(256):y=rnd(256)
      line x,y,x+rnd(64),y+rnd(64)
   next n
   get image 1,0,0,256,256

   `clouds image
   cls rgb(255,255,255)
   for n = 1 to 1000
      x=rnd(255)
      ink rgb(x,x,x),0
      dot rnd(63),rnd(63)
   next n
   get image 3,0,0,64,64

   `sky image
   for a=0 to 128
      r=255-(1.8*a)
      g=148-(0.8*a)
      ink rgb(r,g,200),0
      circle 100,128,a
      circle 100,127,a
   next a
   get image 4,0,0,256,256
Return
`----
Sky:
   make object plain 40,1000,1000
   position object 40,-150,0,250
   yrotate object 40,360-45
   texture object 40,4
   set object 40,1,0,1
Return
`----
Fog:
   for f = 1 to 6
      make object plain 10+f,1000,1000
      texture object 10+f,3
      xrotate object 10+f,90
      fix object pivot 10+f
      yrotate object 10+f,45
      if f>1 then ghost object on 10+f
      position object 10+f,50,10+(5*f),50
   next f
Return

Rem Volumetric Particle Weather - By TDK_Man
Rem DBC Challenges Feb 2008

Gosub Setup
T1=Timer(): T2=Timer()
Repeat
  If Timer()-T1 > 300 Then Gosub Move_Clouds: T1=Timer()
  If Timer()-T2 > 10 Then Gosub Handle_Weather: T2=Timer()
  If Spacekey()=1
    Gosub Change_Weather_Type
  Endif
  Sync
  Center Text 400,580,"Move Around With The Mouse And Press Space To Alter The Weather"
  Select WType
    Case 1: Text 0,580," Clear         ": EndCase
    Case 2: Text 0,580," Rain         ": EndCase
    Case 3: Text 0,580," Hail         ": EndCase
    Case 4: Text 0,580," Snow         ": EndCase
  EndSelect
  Text 740,580,"FPS: "+Str$(Screen FPS())
Until OKToExit=True
End

MouseLook:
  CX#=CAMERA ANGLE X(): CY#=CAMERA ANGLE Y(): CZ#=CAMERA ANGLE Z()
  CX#=Wrapvalue(CX#+mousemovey())
  CY#=Wrapvalue(CY#+mousemovex())
  Rotate Camera CX#,CY#,CZ#
  If MouseClick()=1 Then Move Camera 0.4
  If MouseClick()=2 Then Move Camera -0.4
  Gh#=Get Ground Height(1,Camera Position X(),Camera Position Z())
  Position Camera Camera Position X(),Gh#+1.5,Camera Position Z()
Return

Handle_Weather:
  Gosub MouseLook
  Select WType
    Case 2
      Rem Rain
      If Rnd(200)=0
        Color Ambient Light RGB(255,255,255)
        Sync
        Color Ambient Light RGB(AmbLight,AmbLight,AmbLight)
      Endif
      Gosub Move_Weather
    EndCase
    Case 3
      Rem Hail
      Gosub Move_Weather
    EndCase
    Case 4
      Rem Snow
      Gosub Move_Weather
    EndCase
  EndSelect
Return

Change_Weather_Type:
  Inc WType: If WType=5 Then WType=1
  Select WType
    Case 1
      Rem All Calm
        FirstObj=4000
        For N=FirstObj To FirstObj+1200
          If Object Exist(N) Then Delete Object N
        Next N
        EndAmbLight=255
        For N=AmbLight To EndAmbLight
          Color Ambient Light RGB(N,N,N)
          Fog Distance N*50
          Gosub MouseLook
          Wait .1
        Next N
        Fog Off
        AmbLight=EndAmbLight
        FirstObj=1000
    EndCase
    Case 2
      Rem Rain 10003
      FirstObj=1000
      For N=FirstObj To FirstObj+1200
        If Object Exist(N) Then Delete Object N
      Next N
      EndAmbLight=16
      Fog On: Fog Color RGB(5,25,5): Fog Distance AmbLight*50
      For N=AmbLight To EndAmbLight Step -1
        Color Ambient Light RGB(N,N,N)
        Fog Distance N*50
        Gosub MouseLook
        Wait .1
      Next N
      AmbLight=EndAmbLight
      Rem Rain Parameters
      NumParticles(WType,0)=1200
      Gravity#=-1.1
      PLife(WType,0) = 120
      PSizeX(WType,0) = 2.0: PSizeZ(WType,0) = 10.0
      XDir#(WType,0) = 3.0: YDir#(WType,0) = 20.0: ZDir#(WType,0) = 3.0
      FirstObj=2000
      Gosub Make_Weather_Particles
    EndCase
    Case 3
      Rem Hail 10004
      FirstObj=2000
      For N=FirstObj To FirstObj+1200
        If Object Exist(N) Then Delete Object N
      Next N
      EndAmbLight=48
      Fog On: Fog Color RGB(35,35,35): Fog Distance AmbLight*50
      For N=AmbLight To EndAmbLight Step -1
        Color Ambient Light RGB(N,N,N)
        Fog Distance N*50
        Gosub MouseLook
        Wait .1
      Next N
      AmbLight=EndAmbLight
      Rem Hail Parameters
      NumParticles(WType,0)=1000
      Gravity#=-0.4
      PLife(WType,0)=80
      PSizeX(WType,0) = 1.0: PSizeZ(WType,0) = 1.0
      XDir#(WType,0) = 1.1: YDir#(WType,0) = 4.0: ZDir#(WType,0) = 1.1
      FirstObj=3000
      Gosub Make_Weather_Particles
    EndCase
    Case 4
      Rem Snow 10005
      FirstObj=3000
      For N=FirstObj To FirstObj+1200
        If Object Exist(N) Then Delete Object N
      Next N
      EndAmbLight=16
      Fog On: Fog Color RGB(185,225,185): Fog Distance AmbLight*50
      For N=AmbLight To EndAmbLight Step -1
        Color Ambient Light RGB(N,N,N)
        Fog Distance N*50
        Gosub MouseLook
        Wait .1
      Next N
      AmbLight=EndAmbLight
      Rem Snow Parameters
      NumParticles(WType,0)=1000
      Gravity#=-0.002
      PLife(WType,0)=1000
      PSizeX(WType,0) = 4.0: PSizeZ(WType,0) = 4.0
      XDir#(WType,0) = 6.0: YDir#(WType,0) = 3.0: ZDir#(WType,0) = 6.0
      FirstObj=4000
      Gosub Make_Weather_Particles
    EndCase
  EndSelect
  Repeat
  Until Spacekey()=0
Return

Make_Clouds:
  Rem Create Cloud Particles
  For N = 1 To NumParticles(0,0)
    Make Object Plain N,PSizeX(0,0),PSizeZ(0,0)
    Set Object N, 1, 1, 1, 0, 1, 0, 1
    XRotate Object N,270
    Texture Object N,Glow_Particle
    XRange = (Container_Width/10)-(PSizeX(0,0)/10)
    ParticleX#(0,N) = (Rnd(XRange)-(XRange/2))*10.0 + Container_X
    YRange = Container_Height
    ParticleY#(0,N) = Container_Y + (Rnd(YRange)-(YRange/2))
    ZRange = (Container_Depth/10)-(PSizeZ(0,0)/10)
    ParticleZ#(0,N) = (Rnd(ZRange)-(ZRange/2))*10.0 + Container_Z
    XVel#(0,N) = Rnd(XDir#(0,0)) - (XDir#(0,0)/2.0)
    YVel#(0,N) = Rnd(YDir#(0,0)) - (YDir#(0,0)/2.0)
    ZVel#(0,N) = Rnd(ZDir#(0,0)) - (ZDir#(0,0)/2.0)
    Position Object N,ParticleX#(0,N),ParticleY#(0,N),ParticleZ#(0,N)
    Ghost Object On N
  Next N
Return

Move_Clouds:
  Rem Move Cloud Particles
  For N = 1 To NumParticles(0,0)
    ParticleX#(0,N) = ParticleX#(0,N) + XVel#(0,N)
    If ParticleX#(0,N)>Right#-(PSizeX(0,0)/2) Or ParticleX#(0,N)<Left#+(PSizeX(0,0)/2) Then XVel#(0,N) = 0.0-XVel#(0,N)
    ParticleY#(0,N) = ParticleY#(0,N) + YVel#(0,N)
    If ParticleY#(0,N)>Top# Or ParticleY#(0,N)<Bottom# Then YVel#(0,N) = 0.0-YVel#(0,N)
    ParticleZ#(0,N) = ParticleZ#(0,N) + ZVel#(0,N)
    If ParticleZ#(0,N)>Back#-(PSizeZ(0,0)/2) Or ParticleZ#(0,N)<Front#+(PSizeZ(0,0)/2) Then ZVel#(0,N) = 0.0-ZVel#(0,N)
    Position Object N,ParticleX#(0,N),ParticleY#(0,N),ParticleZ#(0,N)
  Next N
Return

Make_Weather_Particles:
  Rem Create Weather Particles
  For N = 1 To NumParticles(WType,0)
    Make Object Plain N+FirstObj,PSizeX(WType,0),PSizeZ(WType,0)
    Set Object N+FirstObj,1,0,1,1,0,1,0
    Select WType
      Case 2
        Rem Rain
        Texture Object N+FirstObj,10003
      EndCase
      Case 3
        Rem Hail
        Texture Object N+FirstObj,10004
      EndCase
      Case 4
        Rem Snow
        Texture Object N+FirstObj,10005
      EndCase
    EndSelect
    PLife(WType,N)=Rnd(PLife(WType,0))+PLife(WType,0)
    XVel#(WType,N) = Rnd(XDir#(WType,0))
    YVel#(WType,N) = 0.0-(Rnd(YDir#(WType,0))+(YDir#(WType,0)/2))
    ZVel#(WType,N) = Rnd(ZDir#(WType,0))
    ParticleX#(WType,N) = (Rnd(5000)-2500) + 2500
    ParticleY#(WType,N) = Bottom#-5000
    ParticleZ#(WType,N) = (Rnd(5000)-2500) + 2500
    Bouncing(WType,N)=0
    Position Object N+FirstObj,ParticleX#(WType,N),ParticleY#(WType,N),ParticleZ#(WType,N)
    Ghost Object On N+FirstObj
  Next N
  ParticlesDead = False
Return

Move_Weather:
  Rem Move Weather Particles
  For N = 1 To NumParticles(WType,0)
    ParticleX#(WType,N) = ParticleX#(WType,N) + XVel#(WType,N)
    ParticleY#(WType,N) = ParticleY#(WType,N) + YVel#(WType,N)
    ParticleZ#(WType,N) = ParticleZ#(WType,N) + ZVel#(WType,N)
    Rem Add Gravity
    ParticleY#(WType,N) = ParticleY#(WType,N) + Gravity#
    PLife(WType,N) = PLife(WType,N)-1
    Position Object N+FirstObj,ParticleX#(WType,N),ParticleY#(WType,N),ParticleZ#(WType,N)
    If WType <> 4 Then Set Object To Camera Orientation N+FirstObj
    Floor# = Get Ground Height(1,ParticleX#(WType,N),ParticleZ#(WType,N))
    If WType = 2: Rem Rain
      If ParticleY#(WType,N) < Floor#
        XVel#(WType,N) = Rnd(XDir#(WType,0))
        YVel#(WType,N) = 0.0-(Rnd(YDir#(WType,0))+(YDir#(WType,0)))
        ZVel#(WType,N) = Rnd(ZDir#(WType,0))
        ParticleX#(WType,N) = (Rnd(800)-400) + Camera Position X()
        ParticleY#(WType,N) = Bottom#-5000
        ParticleZ#(WType,N) = (Rnd(800)-400) + Camera Position Z()
        PLife(WType,N) = PLife(WType,0)
      Endif
    Endif
    If WType = 3: Rem Hail
      If ParticleY#(WType,N) < Floor#+0.2
        Rem Hit Floor - No Time To Finish Bouncing...
        rem If Bouncing(WType,N)=0 Then YVel#(WType,N) = -0.1: Bouncing(WType,N)=1
        If PLife(WType,N) > 0: Rem Still Life Left
          ParticleY#(WType,N)=Floor#+0.2
          Position Object N+FirstObj,ParticleX#(WType,N),ParticleY#(WType,N),ParticleZ#(WType,N)
          RemStart
          If Bouncing(WType,N)=1
            Position Object N+FirstObj,ParticleX#(WType,N),Floor#+1.0,ParticleZ#(WType,N)
            ParticleX#(WType,N) = 0.0
            ParticleY#(WType,N) = ParticleY#(WType,N) + YVel#(WType,N)
            ParticleZ#(WType,N) = 0.0
            Bouncing(WType,N)=0
          Endif
          Remend
        Else
          Rem No Life Left
          XVel#(WType,N) = Rnd(XDir#(WType,0))/32.0
          YVel#(WType,N) = 0.0-(Rnd(YDir#(WType,0))+(YDir#(WType,0)/2))
          ZVel#(WType,N) = Rnd(ZDir#(WType,0))/32.0
          ParticleX#(WType,N) = Camera Position X() + (Rnd(200)-100)
          ParticleY#(WType,N) = Bottom#-5000
          ParticleZ#(WType,N) = Camera Position Z() + (Rnd(200)-100)
          PLife(WType,N) = PLife(WType,0)
          rem Bouncing(WType,N)=0
        Endif
      Else
        Rem Moving
        ParticleY#(WType,N) = ParticleY#(WType,N) + YVel#(WType,N)
        Position Object N+FirstObj,ParticleX#(WType,N),ParticleY#(WType,N),ParticleZ#(WType,N)
      Endif
    Endif
    If WType = 4: Rem Snow
      If ParticleY#(WType,N) < Floor#
        XVel#(WType,N) = Rnd(XDir#(WType,0))
        YVel#(WType,N) = 0.0-(Rnd(YDir#(WType,0))+(YDir#(WType,0)/6))
        ZVel#(WType,N) = Rnd(ZDir#(WType,0))
        ParticleX#(WType,N) = (Rnd(500)-250.0) + Camera Position X()
        ParticleY#(WType,N) = Bottom#-5000
        ParticleZ#(WType,N) = (Rnd(500)-250.0) + Camera Position Z()
        PLife(WType,N) = PLife(WType,0)
      Endif
    Endif
  Next N
Return

Make_Textures:
  Create Bitmap 1,256,256
  Rem Cloud Particle
  C#=200: D#=0.0
  For N=1 To 54
    Ink RGB(C#,C#,C#),0
    Circle 63,63,N
    Circle 63,64,N
    Dec C#,D#: Inc D#,0.12
  Next N
  Get Image 10003,0,0,129,129
  CLS
  For N=1 To 12
    Paste Image 10003,Rnd(128),Rnd(128),1
  Next N
  For N=1 To 8
    Blur Bitmap 1,3
  Next N
  Get Image 10002,0,0,256,256
  Delete Image 10003
  Rem Rain Particle 10003
  CLS 0
  Ink RGB(255,255,255),0
  For N=1 To 6
    Circle 31,47,N
    Circle 31,48,N
  Next N
  For N=26 To 37
    Line 31,6,N,47
    Line 31,6,N,46
  Next N
  Blur Bitmap 1,4
  Get Image 10003,0,0,65,65
  Rem Hail Particle 10004
  CLS 0
  Ink RGB(255,255,255),0
  For N=1 To 6
    Circle 31,31,N
    Circle 31,32,N
  Next N
  Blur Bitmap 1,1
  Get Image 10004,0,0,65,65
  Rem Snow Particle 10005 (T)
  Set Text Font "Wingdings",1
  Set Text Size 64
  Text 6,0,"T"
  Blur Bitmap 1,4
  Get Image 10005,0,0,65,65
  Set Text Font "Tahoma",1
  Set Text Size 16
  Set Current Bitmap 0
  Delete Bitmap 1
Return

Setup:
  Set Display Mode 800,600,32
  Hide Mouse
  Sync On: Sync Rate 0: CLS 0
  AutoCam Off
  Randomize Timer()
  Backdrop On
  Color Backdrop 0
  True=1: False=0

  Dim NumParticles(10,0)
  Dim PLife(10,1200)
  Dim PSizeX(10,0)
  Dim PSizeZ(10,0)
  Dim Bouncing(10,1200)
  Dim ParticleX#(10,1200)
  Dim ParticleY#(10,1200)
  Dim ParticleZ#(10,1200)
  Dim XDir#(10,0)
  Dim YDir#(10,0)
  Dim ZDir#(10,0)
  Dim XVel#(10,1200)
  Dim YVel#(10,1200)
  Dim ZVel#(10,1200)

  Glow_Particle = 10002
  Container_Width=30000
  Container_Height=1000
  Container_Depth=30000
  WType=1: FirstObj=1000

  AmbLight=255: Color Ambient Light RGB(AmbLight,AmbLight,AmbLight)
  Fog On: Fog Distance AmbLight*50

  NumParticles(0,0) = ((Container_Width+Container_Depth)/Container_Height)*2.5
  XDir#(0,0) = 8.0
  YDir#(0,0) = 2.0
  ZDir#(0,0) = 8.0
  PSizeX(0,0) = Container_Width/2.5
  PSizeZ(0,0) = Container_Depth/3.5

  Gosub Make_Textures
  RandomWorld(1,5000,5000,50,50,128,1)
  Container_X=2500
  Container_Y=Get Ground Height(1,2500.0,2500.0)+6000
  Container_Z=2500

  Left# = 0.0-(Container_Width/2.0)+Container_X: Right# = Container_Width/2.0+Container_X
  Bottom# = Container_Y - (Container_Height/2.0)
  Top# = Container_Y + (Container_Height/2.0)
  Front# = 0.0-(Container_Depth/2.0)+Container_Z: Back# = Container_Depth/2.0+Container_Z
  Gosub Make_Clouds

  Position Camera 2440.0,Get Ground Height(1,2440.0,2440.0)+2.0,2440.0
  Ink RGB(255,255,255),0
Return

Function RandomWorld(MatNum,MatWid,MatHig,TilesX,TilesZ,TextureSize,Hilly)
  Set Camera Range 1.0,500000
  Create Bitmap 1,640,480
  CLS RGB(0,50,0)
  For N=1 To 3000
    Shade = Rnd(100)+50
    Ink RGB(0,Shade,0),0
    Dot RND(TextureSize),RND(TextureSize)
  Next N
  Blur Bitmap 1,3
  Get Image 10000,0,0,TextureSize,TextureSize
  CLS 0
  For N=0 To 128
    Ink RGB(N,N,255-N),0
    Line 0,N,256,N
  Next N
  Get Image 10001,0,0,256,256: Rem Sides
  Set Current Bitmap 0
  Delete Bitmap 1
  Make Matrix MatNum,MatWid,MatHig,TilesX,TilesZ
  Prepare Matrix Texture MatNum,10000,1,1
  If Hilly=1
    For N=1 To 140
      X=Rnd(46)+2: Z=Rnd(46)+2
      Set Matrix Height MatNum,X,Z,3000.0
    Next N
    For N=0 To TilesX
      Set Matrix Height MatNum,0,N,Rnd(100)+400
      Set Matrix Height MatNum,50,N,Rnd(100)+400
      Set Matrix Height MatNum,N,0,Rnd(100)+400
      Set Matrix Height MatNum,N,50,Rnd(100)+400
    Next N
    For N=1 To 20
      For Z=0 to TilesZ
        For X=0 to TilesX
          P0#=Get Matrix Height(MatNum,X,Z)
          If Z-1>=0
            P1#=Get Matrix Height(MatNum,X,Z-1)
          Else
            P1#=P0#
          Endif
          If X+1<=TilesX
            P2#=Get Matrix Height(MatNum,X+1,Z)
          Else
            P2#=P0#
          Endif
          If Z+1<=TilesZ
            P3#=Get Matrix Height(MatNum,X,Z+1)
          Else
            P3#=P0#
          Endif
          If X-1>=0
            P4#=Get Matrix Height(MatNum,X-1,Z)
          Else
            P4#=P0#
          Endif
          Average#=(P0#+P1#+P2#+P3#+P4#)/5.0
          RHeight#=Average#
          Set Matrix Height MatNum,X,Z,RHeight#
        Next X
      Next Z
    Next N
  Endif
  For Z=1 to TilesZ
    For X=1 to TilesX
      h8#=get matrix height(MatNum,x,z-1)*3
      h4#=get matrix height(MatNum,x-1,z)*3
      h#=get matrix height(MatNum,x,z)*3
      h2#=get matrix height(MatNum,x,z)*3
      x1#=(x-1)*25.0
      y1#=h#
      x2#=(x+0)*25.0
      y2#=h4#
      dx#=x2#-x1#
      dy#=y2#-y1#
      ax#=atanfull(dx#,dy#)
      ax#=wrapvalue(90-ax#)
      z1#=(z-1)*25.0
      y1#=h2#
      z2#=(z+0)*25.0
      y2#=h8#
      dz#=z2#-z1#
      dy#=y2#-y1#
      az#=atanfull(dz#,dy#)
      az#=wrapvalue(90-az#)
      nx#=sin(ax#)
      ny#=cos(ax#)
      nz#=sin(az#)
      Set Matrix Normal MatNum,x,z,nx#,ny#,nz#
    next X
  next Z
  Update Matrix MatNum
  Rem SkySphere
  Make Object Sphere 10500,0.0-(MatWid*9.0)
  ZRotate Object 10500,180
  Fix Object Pivot 10500
  Set Object 10500,1,1,1,0,1,0,1
  Texture Object 10500,10001
  Position Object 10500,MatWid/2,-1000,MatHig/2
EndFunction

I like the carving up of the terrain with the tornado.
Would've liked to see you expand on the idea a bit more.
Maybe alter the look of the Tornado to be less cuby.

Good rain effect.  The particle generator was a little 
heavy on the processor.  I wouldn've liked to see if your 
update with the particles only spawning if they were in front 
of the camera would've helped.  A single added sync would've 
gotten rid of the line in the splash texture:

gosub make_texture
sync

I don't know if I've seen you do 3d before.  Good job for 
one of your first attempts!  Very nice fog effect.  Very 
simple and straight forward code. I would've liked to see 
some interesting lighting effects to change the mood and 
perhaps the time.  Also, a rising or falling fog would've 
been nice.

This came out pretty interesting.  The swirling flakes were
 kinda neat and I could see this kind of generator used for 
falling confetti.

You have a taste for theatrics!  I got cold when 
Obese's mountain blocked out the sun.  Nice update.

You put together what looked like you wanted to have 
random lines appear on the screen as rain.  You took a 
quick stab then never tried to fix it...

This looked like it would've been truly exceptional if 
you had finished it to your desired level.  The transitions 
were really quite interesting.  I was most impressed with the 
snow, though it only snowed in one area in front of the camera 
that I could never seem to reach.  The program though, crawled
 along at between 10 and 15 fps.  Great job over all!

Insert Name Here: Snowy

OBese87: Foggy Mountain Top

rem ***********************
rem  A Mouse's Best Friend
rem ***********************

Sync On
Sync rate 60

DO
   mx=mousex():my=mousey()

   `calculate
   if abs(mx-x#)>10 or abs(my-y#)>10
      a# = curvevalue( atanfull(mx-x#,my-y#) ,a#,20)
      if s<5 then s=s+1
      x# = x# + sin(a#)*s
      y# = y# + cos(a#)*s
   else
      s=0
   endif

   `draw
   circle x#,y#,10
   line x#,y#,x#+sin(a#)*15,y#+cos(a#)*15

   sync:cls
LOOP

`The number of checkpoints in the race
checkpoints=20

gosub setupgame
`___________________________________________________________________________________

do
   if endgame=0
      if endgame=0 then Elapsed#=(Timer()-T#)/1000
      if waypoint#>ai_waypoint# then pos$="1st"
      if waypoint#=ai_waypoint# and root#<ai_root# then pos$="1st"
      if waypoint#=ai_waypoint# and root#>ai_root# then pos$="2nd"
      if waypoint#<ai_waypoint# then pos$="2nd"

      Text 10,10,pos$
      Text 10,60,Str$(waypoint#-2)+"/"+Str$(checkpoints-2)
   endif

   if endgame=0
      if upkey()=1 and speed#=>0 then speed#=speed#+0.02
      if upkey()=1 and speed#<0 then speed#=speed#+0.05
      if downkey()=1 and speed#>-1 then speed#=speed#-0.05
      if downkey()=0 and upkey()=0 then speed#=speed#/1.02
   endif
   if endgame=1 and speed#>0 then speed#=speed#-0.05

   if rightkey()=1 and steer#<2.5 then steer#=steer#+0.1
   if leftkey()=1 and steer#>-2.5 then steer#=steer#-0.1
   if rightkey()=0 and leftkey()=0 then steer#=steer#/1.2
   if speed#>0 then angleY#=angleY#+steer#
   if speed#<0 then angleY#=angleY#-steer#

   if endgame=0
      gosub collision
      gosub ai_collision
   endif
`___________________________________________________________________________________

   rotate object 1,0,wrapvalue(angleY#),wrapvalue(0-angleZ#)
   X#=newXvalue(X#,angleY#,speed#)
   Z#=newZvalue(Z#,angleY#,speed#)
   if X#>200 then X#=200:speed#=speed#/1.02
   if X#<0 then X#=0:speed#=speed#/1.02
   if Z#>200 then Z#=200:speed#=speed#/1.02
   if Z#<0 then Z#=0:speed#=speed#/1.02
   Position object 1,X#,0,Z#

   cam_angleY#=cam_angleY#+(angleY#-cam_angleY#)/10
   angleZ#=angleZ#+(AngleY#-angleZ#)/10
   camX#=newXvalue(object position x(1),cam_angleY#+180,speed#+20)
   camZ#=newZvalue(object position z(1),cam_angleY#+180,speed#+20)
   position camera camX#,speed#+10,camZ#
   point camera object position x(1),1,object position z(1)

   fov#=speed#/5
   set camera fov fov#+1

   root#=sqrt((((object position X(waypoint#)-X#)/2)^2)+(((object position Z(waypoint#)-Z#)/2)^2))
`___________________________________________________________________________________

   ai_ang#=wrapvalue(atanfull(ai_X#-object position X(ai_waypoint#),ai_Z#-object position Z(ai_waypoint#))-ai_angleY#)

   if wrapvalue(ai_ang#-ai_steer#)<180 then ai_behaviour=2
   if wrapvalue(ai_ang#-ai_steer#)>180 then ai_behaviour=1
   if wrapvalue(ai_ang#-ai_steer#)=180 then ai_behaviour=0

   ai_root#=sqrt((((object position X(ai_waypoint#)-ai_X#)/2)^2)+(((object position Z(ai_waypoint#)-ai_Z#)/2)^2))

   if ai_speed#*2<ai_root#/10 then ai_speed#=ai_speed#+0.02 else ai_speed#=ai_speed#/1.02
   if ai_behaviour=1 and ai_steer#<2.5 then ai_steer#=ai_steer#+0.5
   if ai_behaviour=2 and ai_steer#>-2.5 then ai_steer#=ai_steer#-0.5
   if ai_behaviour<>1 and ai_behaviour<>2 then ai_steer#=ai_steer#/1.2
   if ai_speed#>0 then ai_angleY#=ai_angleY#+ai_steer#
   if ai_speed#<0 then ai_angleY#=ai_angleY#-ai_steer#

   rotate object 2,0,wrapvalue(ai_angleY#),wrapvalue(0-ai_angleZ#)
   ai_X#=newXvalue(ai_X#,ai_angleY#,ai_speed#)
   ai_Z#=newZvalue(ai_Z#,ai_angleY#,ai_speed#)
   if ai_X#>200 then ai_X#=200:ai_speed#=ai_speed#/1.02
   if ai_X#<0 then ai_X#=0:ai_speed#=ai_speed#/1.02
   if ai_Z#>200 then ai_Z#=200:ai_speed#=ai_speed#/1.02
   if ai_Z#<0 then ai_Z#=0:ai_speed#=ai_speed#/1.02
   Position object 2,ai_X#,0,ai_Z#
   ai_angleZ#=ai_angleZ#+(ai_AngleY#-ai_angleZ#)/10

   if endgame=1 and speed#<0 then gosub finnish
   if endgame=0 then gosub update_map
loop
`___________________________________________________________________________________

setupgame:
   checkpoints=checkpoints+2
   waypoint#=3
   ai_waypoint#=3
   set display mode 1280,1024,32
   sync on:sync rate 30
   hide mouse
   randomize timer()

   make matrix 1,200,200,10,10
   position matrix 1,0,-2,0

   make object cube 1,4
   make object cube 2,4

   color object 1,RGB(55,55,55)
   color object 2,RGB(20,20,20)

   create bitmap 1,200,200
   set current bitmap 1
   get image 1,0,0,200,200
   set current bitmap 0
   ink rgb(255,255,255),0

   make object plain 32,200,200
   lock object on 32
   position object 32,-490,-320,800
   ghost object on 32
   texture object 32,1

   for t=3 to checkpoints
   make object cube t,4
   position object t,rnd(200),0,rnd(200)
   next t
   color object 3,RGB(225,0,0)

   T#=Timer()
   set text font "Berlin Sans FB"
   set text size 50
return

collision:
   if object collision(1,waypoint#)=1
      hide object waypoint#
      if waypoint#=checkpoints
         message$="FINISH!!"
         endgame=1
         return
         `gosub finnish
      endif
      color object waypoint#+1,RGB(225,0,0)
      waypoint#=waypoint#+1
   endif
return

ai_collision:
   if object collision(2,ai_waypoint#)=1
      ghost object on ai_waypoint#
      if ai_waypoint#=checkpoints
         message$="YOU LOZE!!"
         endgame=1
         return
         `gosub finnish
      endif
      ai_waypoint#=ai_waypoint#+1
   endif
return

update_map:
   set current bitmap 1
   ink rgb(0,100,0),rgb(0,100,0)
   cls

   `the player cube (yellow, 2x as big)
   ink rgb(255,255,0),0
   box X#-2,Z#-2,X#+2,Z#+2

   `the ai cube (black)
   ink 0,0
   box ai_X#-1,ai_Z#-1,ai_X#+1,ai_Z#+1
   ink rgb(255,255,255),0

   `the waypoint cubes (white)
   for t=waypoint# to checkpoints
      box object position X(t)-1,object position Z(t)-1,object position X(t)+1,object position Z(t)+1
   next t

   `the destination waypoint cube (red, 2x as big)
   ink rgb(255,0,0),0
   box object position X(waypoint#)-2,object position Z(waypoint#)-2,object position X(waypoint#)+2,object position Z(waypoint#)+2
   flip bitmap 1

   get image 1,0,0,200,200
   set current bitmap 0
   ink rgb(255,255,255),0
   texture object 32,1

   zrotate object 32,object angle y(1)
return

finnish:
   if Elapsed#>60 then Elapsed#=Elapsed#-60:min=min+1:goto finnish
   repeat
      cls rgb(225,30,30)

      a=rnd(5)
      if a=0 then ink rgb(225,30,30),0 else ink rgb(0,0,0),0
      set text font "impact"
      set text size 100
      center text screen width()/2,screen height()/2-100,message$

      ink rgb(0,0,0),0
      set text font "Courier"
      set text size 15
      if min>0
         center text screen width()/2,screen height()/2-10,"In just "+Str$(min)+" minute(s) and "+Str$(int(Elapsed#))+" seconds"
      else
         center text screen width()/2,screen height()/2-10,"In just "+Str$(int(Elapsed#))+" seconds"
      endif

      sync
   until world_domination=1


remstart
   this is the part where I explain what all the varaibles are

   ai_behaviour      = used for the ai steering behaviour; 0=no steeing 1=right 2=left
   checkpoints       = the total number of checkpoints
   endgame           = if 1 then the game has ended
   min               = number of minutes the player used to get all the checkpoints; used only in the finnish subroutine
   t                 = used for displaying white dots on the map; used only in the update_map subroutine
   world_domination  = used at the end of the game; to make the end message flikker on and off

   ai_ang#           = if 0 then the ai player is facing directly to the current ai checkpoint
   ai_angleY#        = the angle of the ai player; viewed from above
   ai_angleZ#        = the angle of the ai player; viewed from the back
   ai_root#          = the distance between the ai and the current active checkpoint for the ai
   ai_speed#         = the speed of the ai
   ai_steer#         = the steering angle for the ai
   ai_waypoint#      = the active checkpoint for the ai
   ai_X#             = the X position of the ai player
   ai_Z#             = the Z position of the ai player
   angleY#           = the angle of the player; viewed from above
   angleZ#           = the angle of the player; viewed from the back (where the camera sits)
   cam_angleY#       = the angle of the camera; viewed from above
   camX#             = the X position of the camera
   camZ#             = the Z position of the camera
   Elapsed#          = the time that has elapsed in the game
   fov#              = the field of vieuw for the camera
   root#             = the distance between the player and the current active checkpoint for the player
   speed#            = the speed of the player
   steer#            = the steering angle (the angle of the front wheels)
   T#                = the time at the beginning of the game
   waypoint#         = the current active (red) checkpoint for the player
   X#                = the X position of the player
   Z#                = the Z position of the player

   message$          = the end message
   pos$              = your position in the game

rem ***********************
rem  A Mouse's Best Friend
rem ***********************

Sync On
Sync rate 60

DO
   mx=mousex():my=mousey()

   `calculate
   if abs(mx-x#)>10 or abs(my-y#)>10
      a# = curveangle( atanfull(mx-x#,my-y#) ,a#, abs((mx-x#)+(my-y#))/10)
      if s<6 then s=s+1
      x# = x# + sin(a#)*s
      y# = y# + cos(a#)*s
   else
      s=0
   endif

   `draw
   circle x#,y#,10
   line x#,y#,x#+sin(a#)*15,y#+cos(a#)*15

   sync:cls
LOOP

randomize timer()

make matrix 1,100,100,20,20
randomize matrix 1,3

for v = 0 to 20
   set matrix height 1,v,0,8
   set matrix height 1,v,20,8
   set matrix height 1,0,v,8
   set matrix height 1,20,v,8
next v

update matrix 1

make object cube 1,2
x=50:z=50

Dim dest(1)

sync on
sync rate 20

DO
   set cursor 0,0
   print screen fps()

   `find lowest neighbouring point
   move(x,z)

   `move player towards destination
   if x < dest(0) then x=x+1
   if x > dest(0) then x=x-1
   if z < dest(1) then z=z+1
   if z > dest(1) then z=z-1
   `   inc x,(dest(0)>x)-(dest(0)<x)
`   inc z,(dest(1)>z)-(dest(1)<z)

   position object 1,x,get ground height(1,x,z),z

   position camera x,10,z-10
   point camera x,get ground height(1,x,z),z
   sync
LOOP
END

`---------------
` Functions
`---------------
Function move(x,z)
   x=(x/5)*5 : z=(z/5)*5
   print x
   print z
   low_height=999

   `Find lowest surrounding point
   for v = -5 to 5 step 5
      for u = -5 to 5 step 5
         `don't include current position
         if u<>0 or v<>0
            check_height = get ground height(1,x+u,z+v)
            if check_height < low_height then low_height = check_height : Dest(0)=X+U : Dest(1)=Z+V
         endif
      next u
   next v
Endfunction

rem ***********************
rem  A Mouse's Best Friend
rem ***********************

Sync On
Sync rate 65

DO
   mx=mousex():my=mousey()

   `calculate
   if abs(mx-x#)>10 or abs(my-y#)>10
      a# = curveangle( atanfull(mx-x#,my-y#) ,a#, abs((mx-x#)+(my-y#))/10)
      if s<6 then s=s+1
      x# = x# + sin(a#)*s
      y# = y# + cos(a#)*s
   else
      s=0
   endif

if abs(mx-d#)>5 or abs(my-e#)>5
      f# = curveangle( atanfull(mx-d#,my-e#) ,f#, abs((mx-d#)+(my-e#))/5)
      if g<6 then g=g+1
      d# = d# + sin(f#)*g
      e# = e# + cos(f#)*g
   else
      g=0
   endif

if abs(mx-h#)>7.5 or abs(my-i#)>7.5
      j# = curveangle( atanfull(mx-h#,my-i#) ,j#, abs((mx-h#)+(my-i#))/7.5)
      if k<6 then k=k+1
      h# = h# + sin(j#)*k
      i# = i# + cos(j#)*k
   else
      k=0
   endif


   Rem Start bullet creation
     bulletposX= x#
     bulletposY= y#
rem I had orginally had it like this (mx-x#) but thought that doesn't make sense, and it wouldn't
rem let me use circle x#,y# for coords so I started to use this.


  if mx and my <> 0 and bulletinit=0 then bulletinit=1
     if bulletinit=1 then gosub movebullet

  rem what I have here is whether or not the mouse is moving a flag
  rem will be turned on to create the bullet which will go to the subroutine and make our bullet and set it loose. But this is my problem
  rem I have been looking over tdk's tut on shooting, must've read it twenty,thirty times, I 'know I'm close.
  rem I don't want the answer in code if it all possible, I really do want to figure it out, but could anyone maybe
  rem answer in psuedo-code or through another form of writing?

   `draw
   circle x#,y#,10
   circle d#,e#,10
   circle h#,i#,10

    line x#,y#,x#+sin(a#)*15,y#+cos(a#)*15
    line d#,e#,d#+sin(f#)*15,e#+cos(f#)*15
    line h#,i#,h#+sin(j#)*15,i#+cos(j#)*15
   sync:cls
LOOP

movebullet:

  Dec bulletposX,10
  Dec bulletposY,10
  Text bulletposX,bulletposY,">"
  Sleep 1
  Text bulletposX,bulletposY," "
  Rem Check to see if we hit anything here and if we did
  Rem handle it. Reset flag if bullet is done with
  If bulletposX<=0 Then bullletinit=0
Return

`##########################################################################
`### Ai Project                                                           #
`### by Link102                                                           #
`### v2 (v1 lost when the computer crashed X_X, always save your project) #
`### 20 Febuari 2008                                                     ##
`#########################################################################

set display mode 1280,1024,32
print "loading..."
sync on:sync rate 60
hide mouse
gosub make_texture
gosub make_matrix
gosub make_map
ink rgb(255,255,255),0
do
   set cursor 0,0
   print "fps: ",screen fps()
   print "number of objects used: ",obj
   cam_angx#=cam_angx#+mousemovey()
   cam_angy#=cam_angy#+mousemovex()
   cam_x#=newxvalue(cam_x#,cam_angy#,(keystate(17)=1)-(keystate(31)=1))
   cam_z#=newzvalue(cam_z#,cam_angy#,(keystate(17)=1)-(keystate(31)=1))
   cam_x#=newxvalue(cam_x#,cam_angy#-90,(keystate(30)=1)-(keystate(32)=1))
   cam_z#=newzvalue(cam_z#,cam_angy#-90,(keystate(30)=1)-(keystate(32)=1))
   position camera cam_x#+15,5,cam_z#+15
   rotate camera wrapvalue(cam_angx#),wrapvalue(cam_angy#),0
sync
loop

make_texture:
   cls rgb(200,200,200)
   ink rgb(50,94,109),0:line 0,0,40,0:line 0,0,0,40:line 40,40,40,0:line 40,40,0,40
   get image 1,0,0,41,41

   cls rgb(50,94,109)
   get image 2,0,0,1,1
return

make_matrix:
   make matrix 1,200,200,20,20
   prepare matrix texture 1,1,1,1
return

make_map:
   for x= 0 to 19
       for z= 0 to 19
         read id$
         for ang= 0 to 3
            if mid$(id$,ang+1)="1"
               obj=obj+1
               make object plain obj,10,10
               position object obj,newxvalue(x*10,ang*90,4.5)+5,5,newzvalue(z*10,ang*90,4.5)+5
               yrotate object obj,ang*90
               texture object obj,2
            endif
            if mid$(id$,ang+1)="2"
               obj=obj+1
               make object plain obj,0.72,10
               position object obj,newxvalue(newxvalue(x*10,ang*90,4.75)+5,ang*90+90,4.75),5,newzvalue(newzvalue(z*10,ang*90,4.75)+5,ang*90+90,4.75)
               yrotate object obj,ang*90+45
               texture object obj,2
            endif
         next ang
       next z
   next x
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0011","1001","0011","0001", "0001","1001","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0110","1200","2010","0100", "2200","1100","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0011","2022","0222","1001", "1010","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0110","2202","2220","1100", "1010","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0011","1020","0012","0001", "0022","1001","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0110","1100","0110","0100", "0100","1100","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"

   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
return

sync on
sync rate 60
set display mode 800,600,32
autocam off

make matrix 1,510,510,21,21
set matrix wireframe off 1
randomize matrix 1,30
calc_mat_normals(1,21,21,5.0,5.0)

set ambient light 20
color ambient light 0
set directional light 0,0,-1,1

position camera 255,500,255
xrotate camera 90
sync

do
   text 0,0,str$(rgbg(point(mousex(),mousey())))
   sync
loop

end

   function calc_mat_normals(mat,tilex,tilez,sizex#,sizez#)
   Rem By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
   rem added tile and tile size factor for normal depth adjustment - latch
      for z=1 to tilez
         for x=1 to tilex

            rem Get matrix heights
            h8#=get matrix height(mat,x,z-1)
            h4#=get matrix height(mat,x-1,z)
            h#=get matrix height(mat,x,z)
            h2#=get matrix height(mat,x,z)

            rem Calculate projected angle X using heights
            x1#=(x-1)*sizex# : y1#=h#
            x2#=(x+0)*sizex# : y2#=h4#
            dx#=x2#-x1#
            dy#=y2#-y1#
            ax#=atanfull(dx#,dy#)
            ax#=wrapvalue(90-ax#)

            rem Calculate projected angle Z using heights
            z1#=(z-1)*sizez# : y1#=h2#
            z2#=(z+0)*sizez# : y2#=h8#
            dz#=z2#-z1#
            dy#=y2#-y1#
            az#=atanfull(dz#,dy#)
            az#=wrapvalue(90-az#)

            rem Make normal from projected angle
            nx#=sin(ax#)
            ny#=cos(ax#)
            nz#=sin(az#)

            rem Setting matrix normal for smoothness
            set matrix normal mat,x,z,nx#,ny#,nz#

         next x
      next z
      update matrix mat
   EndFunction

rem ***********************
rem  A Mouse's Best Friend
rem ***********************

Sync On
Sync Rate 60
Randomize timer()

`Array to store sprite data
rem The temporary name for these little sprite things is "Lads"
Number_of_Lads = 5
Dim lad#(Number_of_Lads,4)
`Labels for the 4 lad parameters
X = 1 : Y = 2 : Angle = 3 : Speed = 4

`---------------------
` Main Loop
`---------------------
DO
   mx=mousex() : my=mousey()

   `Work on the Lads
   For n = 1 to Number_of_Lads
      work(n,mx,my)
      Circle lad#(n,x),lad#(n,y),10
      Line lad#(n,x),lad#(n,y),lad#(n,x)+sin(lad#(n,angle))*15,lad#(n,y)+cos(lad#(n,angle))*15
   Next n

   Sync:CLS
LOOP

`---------------------
` Functions
`---------------------
Function work(n,mx,my)
   `Array Labels
   X = 1 : Y = 2 : Angle = 3 : Speed = 4

   if abs(mx-lad#(n,x))>20 or abs(my-lad#(n,y))>20
      lad#(n,angle) = curveangle( atanfull(mx-lad#(n,x),my-lad#(n,y)) ,lad#(n,angle), abs((mx-lad#(n,x))+(my-lad#(n,y)))/10)
      if lad#(n,speed)<8 then lad#(n,speed)=lad#(n,speed)+rnd(2)
      lad#(n,x) = lad#(n,x) + sin(lad#(n,angle)+rnd(10))*lad#(n,speed)
      lad#(n,y) = lad#(n,y) + cos(lad#(n,angle)+rnd(10))*lad#(n,speed)
   else
      lad#(n,speed)=0
   endif
Endfunction

`##########################################################################
`### Ai Project                                                           #
`### by Link102                                                           #
`### v2 (v1 lost when the computer crashed X_X, always save your project) #
`### 20 Febuari 2008                                                     ##
`#########################################################################

set display mode 800,600,16
print "loading..."
sync on:sync rate 0
hide mouse
gosub make_texture
gosub make_matrix
gosub make_map
ink rgb(255,255,255),0
do
   set cursor 0,0
   print "fps: ",screen fps()
   `print "number of objects used: ",obj
   print "object ",msh
   cam_angx#=cam_angx#+mousemovey()
   cam_angy#=cam_angy#+mousemovex()
   cam_x#=newxvalue(cam_x#,cam_angy#,(keystate(17)=1)-(keystate(31)=1))
   cam_z#=newzvalue(cam_z#,cam_angy#,(keystate(17)=1)-(keystate(31)=1))
   cam_x#=newxvalue(cam_x#,cam_angy#-90,(keystate(30)=1)-(keystate(32)=1))
   cam_z#=newzvalue(cam_z#,cam_angy#-90,(keystate(30)=1)-(keystate(32)=1))
   position camera cam_x#+15,5,cam_z#+15
   rotate camera wrapvalue(cam_angx#),wrapvalue(cam_angy#),0


sync
loop

make_texture:
   cls rgb(200,200,200)
   ink rgb(50,94,109),0:line 0,0,40,0:line 0,0,0,40:line 40,40,40,0:line 40,40,0,40
   get image 1,0,0,41,41

   cls rgb(50,94,109)
   get image 2,0,0,1,1
return

make_matrix:
   make matrix 1,200,200,20,20
   prepare matrix texture 1,1,1,1
return

make_map:

   rem add variables to create limbs
   msh=1
   lmb=0

   for x= 0 to 19
       for z= 0 to 19
         read id$
         for ang= 0 to 3
            if mid$(id$,ang+1)="1"
               obj=obj+1
               make object plain obj,10,10
               position object obj,newxvalue(x*10,ang*90,4.5)+5,5,newzvalue(z*10,ang*90,4.5)+5
               yrotate object obj,ang*90
               `texture object obj,2

               rem add limbs to the main object
               if obj > 1
                  inc lmb
                  make mesh from object obj,obj
                  delete object obj
                  add limb msh,lmb,obj
                  offset limb msh,lmb,-15,-5,-10.5
                  delete mesh obj
               endif

            endif
            if mid$(id$,ang+1)="2"
               obj=obj+1
               make object plain obj,0.72,10
               position object obj,newxvalue(newxvalue(x*10,ang*90,4.75)+5,ang*90+90,4.75),5,newzvalue(newzvalue(z*10,ang*90,4.75)+5,ang*90+90,4.75)
               yrotate object obj,ang*90+45
               `texture object obj,2

               rem add limbs to the main object
               if obj > 1
                  inc lmb
                  make mesh from object obj,obj
                  delete object obj
                  add limb msh,lmb,obj
                  offset limb msh,lmb,-15,-5,-10.5
                  delete mesh obj
               endif

            endif
         next ang
       next z
   next x

   rem delete all the limbs and texture the whole thing
   yrotate object msh,wrapvalue(object angle y(msh)+180)
   make mesh from object obj,msh
   delete object msh
   make object msh,obj,2
   delete mesh obj
   set object msh,1,1,0
   sync

   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0011","1001","0011","0001", "0001","1001","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0110","1200","2010","0100", "2200","1100","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0011","2022","0222","1001", "1010","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0110","2202","2220","1100", "1010","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0011","1020","0012","0001", "0022","1001","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0110","1100","0110","0100", "0100","1100","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"

   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
   data "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000", "0000","0000","0000","0000","0000"
return

Rem DBC Programming Challenges
Rem a.i. Challenge
Rem By:Ton3e

Gosub Setup

Do
 gosub movement

 Sync
 Loop
End


Setup:
  Sync On
  CLS 0

  `make 3 big cubes and texture them
  Ink RGB(0,0,255),0: Box 2,2,254,254
  Ink RGB(125,125,125),0
  box 0,0,20,254
  box 20,0,254,20
  box 234,20,254,254
  box 20,234,234,254
  ink 0,0
  line 0,0,20,20
  line 0,254,20,234
  line 234,20,254,0
  line 234,234,254,254
  circle 10,127,7
  circle 10,63,7
  circle 10,190,7
  circle 63,10,7
  circle 127,10,7
  circle 190,10,7
  circle 63,244,7
  circle 127,244,7
  circle 190,244,7
  circle 244,63,7
  circle 244,127,7
  circle 244,190,7
  Get Image 1,0,0,256,256

   make object sphere 1,3
   texture object 1,1

  `make one small cube and texture it
  Ink 0,0: Box 2,2,254,254
  Ink RGB(255,255,255),0
  box 0,0,20,254
  box 20,0,254,20
  box 234,20,254,254
  box 20,234,234,254
  ink 0,0
  line 0,0,20,20
  line 0,254,20,234
  line 234,20,254,0
  line 234,234,254,254
  circle 10,127,7
  circle 10,63,7
  circle 10,190,7
  circle 63,10,7
  circle 127,10,7
  circle 190,10,7
  circle 63,244,7
  circle 127,244,7
  circle 190,244,7
  circle 244,63,7
  circle 244,127,7
  circle 244,190,7
  Get Image 2,0,0,256,256
  make object SPHERE 4,3
  texture object 4,2

  `make platform
  ink rgb(255,255,255),0
  box 0,0,32,32
  ink 0,0
  line 16,0,16,32
  line 0,16,32,16
  line 8,0,8,32
  line 0,8,32,8
  line 0,24,32,24
  line 24,0,24,32
  get image 3,0,0,32,32
  make object box 5,25,1,25
  texture object 5,3
Return


movement:
   `player movement with arrow keys
   KEY=0
   if upkey()=1 and key=0
      zpos#=zpos#+.5
      XRotate Object 4,WrapValue(Object Angle X(4)+45)
      key=1
   endif
   if downkey()=1 and key=0
      zpos#=zpos#-.5
      XRotate Object 4,WrapValue(Object Angle X(4)-45)
      key=1
   endif
   If rightkey()=1 and key=0
      xpos#=xpos#+.5
      zRotate Object 4,WrapValue(Object Angle Z(4)+45)
      key=1
   endif
   if leftkey()=1 and key=0
      xpos#=xpos#-.5
      zRotate Object 4,WrapValue(Object Angle Z(4)-45)
      key=1
   `make a 25x25 boundary
   if xpos#>12.5 then xpos#=12.5
   if xpos#<-12.5 then xpos#=-12.5
   if zpos#<-12.5 then zpos#=-12.5
   if zpos#>12.5 then zpos#=12.5

   `position object
   position object 4,xpos#,0,zpos#
   position object 5,0,-1,0

   `camera
   position camera 0,20,-20
   point camera 0,0,0
return

   if leftkey()=1 and key=0
      xpos#=xpos#-.5
      zRotate Object 4,WrapValue(Object Angle Z(4)-45)
      key=1

`##########################################################################
`### Ai Project - Topdown shooting                                        #
`### by Link102                                                           #
`### version 3.0                                                          #
`### 24 Febuari 2008                                                     ##
`#########################################################################

`set display mode 1280,1024,32
hide mouse
randomize timer()
print "loading..."
sync on : sync rate 60

dim bullet#(50,3)
dim enemy#(10,3)
dim e_speed#(0)
dim player#(2)
dim score(2)

start:
for e = 0 to 5 : init_enemy(e) : next e
e_speed#(0) = 1

white = rgb(255,255,255)
player#(0) = screen width()/2
player#(1) = screen height()/2
player#(2) = 10.0

ink 0,0


do
   cls white
   set cursor 0,0
   print "Life: ",int(player#(2)*10),"%"
   print "Score: ",score(0)

   xvel# = xvel# + keystate(32) - keystate(30)
   yvel# = yvel# + keystate(31) - keystate(17)

   if xvel# >  5 then xvel# =  5
   if xvel# < -5 then xvel# = -5
   if yvel# >  5 then yvel# =  5
   if yvel# < -5 then yvel# = -5

   if 1 - keystate(32) and 1 - keystate(30)
      if xvel# > 0 then xvel# = xvel# - 1
      if xvel# < 0 then xvel# = xvel# + 1
   endif
   if 1 - keystate(31) and 1 - keystate(17)
      if yvel# > 0 then yvel# = yvel# - 1
      if yvel# < 0 then yvel# = yvel# + 1
   endif

   player#(0) = player#(0) + xvel#
   player#(1) = player#(1) + yvel#

   if player#(0) < player#(2)                   then player#(0) = player#(2)
   if player#(0) > screen width()  - player#(2) then player#(0) = screen width() - player#(2)
   if player#(1) < player#(2)                   then player#(1) = player#(2)
   if player#(1) > screen height() - player#(2) then player#(1) = screen height() - player#(2)

   circle player#(0),player#(1),player#(2)
   draw_cursor(mousex(),mousey(),1)
   update_bullets()
   update_enemy()
   if player#(2) =< 0 then gosub dead
sync
loop

dead:
   show mouse
   do
      cls white
      center text screen width() / 2,screen height() / 2 - 20,"You Died - Game over"
      if score(0) > 0 then center text screen width() / 2,screen height() / 2 + 20,"Score: " + str$(score(0))
      if score(1) > 0 then center text screen width() / 2,screen height() / 2 + 40,"Bullets fired: " + str$(score(1))
      if score(2) > 0 then center text screen width() / 2,screen height() / 2 + 60,"Bullets hit: " + str$(score(2))
      if score(1) > 0 then center text screen width() / 2,screen height() / 2 + 80,"Hit ratio: " + str$((100 / score(1)) * score(2))
      if button("Retry",screen width() / 2 - 100,screen height() / 2,screen width() / 2 - 10,screen height() / 2 + 15) then goto start
      if button("Exit",screen width() / 2 + 10,screen height() / 2,screen width() / 2 + 100,screen height() / 2 + 15) then end
   sync
   loop
   hide mouse
return

function draw_cursor(x,y,scale)
   dot x,y
   circle x,y,8*scale
   line x,y+6*scale,x,y+10*scale
   line x,y-6*scale,x,y-10*scale
   line x+6*scale,y,x+10*scale,y
   line x-6*scale,y,x-10*scale,y
endfunction

function update_bullets()
   if mouseclick() = 1
      rand = rnd(2)-1
      bullet#(nr,0) = player#(0)
      bullet#(nr,1) = player#(1)
      angle# = atanfull(mousex() - player#(0),mousey() - player#(1))
      bullet#(nr,2) = newxvalue(0,angle# + rand,11)
      bullet#(nr,3) = newzvalue(0,angle# + rand,11)
      nr = nr + 1
      if nr = 51 then nr = 0
      score(1) = score(1) + 1
   endif
   for b = 0 to 50
     `position    = position    + velocity
      bullet#(b,0) = bullet#(b,0) + bullet#(b,2)
      bullet#(b,1) = bullet#(b,1) + bullet#(b,3)
      dot bullet#(b,0),bullet#(b,1)
   next b
endfunction

function init_enemy(nr)
   rand = rnd(3)
   if rand = 0
      enemy#(nr,0) = -10
      enemy#(nr,1) = rnd(screen height() - 10) + 5
   endif
   if rand = 1
      enemy#(nr,0) = screen width() + 10
      enemy#(nr,1) = rnd(screen height() - 10) + 5
   endif
   if rand = 2
      enemy#(nr,0) = rnd(screen width()  - 10) + 5
      enemy#(nr,1) = -10
   endif
   if rand = 3
      enemy#(nr,0) = rnd(screen width()  - 10) + 5
      enemy#(nr,1) = screen height() + 10
   endif
   enemy#(nr,2) = 10
endfunction

function update_enemy()
   for e = 0 to 5
      angle# = atanfull(player#(0)-enemy#(e,0),player#(1)-enemy#(e,1))
      if dist(player#(0),enemy#(e,0),player#(1),enemy#(e,1)) < player#(2) + enemy#(e,2)
         player#(2) = player#(2) - 0.1
      else
         enemy#(e,0) = newxvalue(enemy#(e,0),angle#,e_speed#(0))
         enemy#(e,1) = newzvalue(enemy#(e,1),angle#,e_speed#(0))
      endif
      for b = 0 to 50
         if dist(bullet#(b,0),enemy#(e,0),bullet#(b,1),enemy#(e,1)) < enemy#(e,2) + 5
            score(0) = score(0) + 1
            score(2) = score(2) + 1
            bullet#(b,0) = 0
            bullet#(b,1) = 0
            bullet#(b,2) = 0
            bullet#(b,3) = 0
            if enemy#(e,2) < 3
               score(0) = score(0) + 100
               e_speed#(0) = e_speed#(0) + 0.1
               init_enemy(e)
            else
               enemy#(e,2) = enemy#(e,2) - 1
            endif
         endif
      next b
      circle enemy#(e,0),enemy#(e,1),enemy#(e,2)
   next e
endfunction

function dist(x1#,x2#,y1#,y2#)
   d# = sqrt((x2# - x1#)^2+(y2# - y1#)^2)
endfunction d#

function button(tag$,x1,y1,x2,y2)
   line_box(x1,y1,x2,y2)
   if mousex() > x1 and mousex() < x2 and mousey() > y1 and mousey() < y2
      line_box(x1 - 1,y1 - 1,x2 + 1,y2 + 1)
      clicked = mouseclick()
   endif
   text x1 + (x2 - x1) / 2 - (text width(tag$) / 2),y1 + (y2 - y1) / 2 - (text height(tag$) / 2),tag$
endfunction clicked

function line_box(x1,y1,x2,y2)
   line x1,y1,x2,y1
   line x1,y1,x1,y2
   line x2,y1,x2,y2
   line x1,y2,x2,y2
endfunction

rem ***********************
rem  A Mouse's Best Friend
rem ***********************

Sync On
Sync Rate 60
Randomize timer()

`Array to store sprite data
rem The temporary name for these little sprite things is "Lads"
Number_of_Lads = 5
Dim lad#(Number_of_Lads,6)
`Labels for the 4 lad parameters
X = 1 : Y = 2 : Angle = 3 : Speed = 4 : WayX = 5 : WayY = 6

`---------------------
` Main Loop
`---------------------
DO
   gosub Waypoint

   `Work on the Lads
   For n = 1 to Number_of_Lads
      work(n,lad#(n,WayX),lad#(n,WayY))
      Circle lad#(n,x),lad#(n,y),10
      Line lad#(n,x),lad#(n,y),lad#(n,x)+sin(lad#(n,angle))*15,lad#(n,y)+cos(lad#(n,angle))*15
   Next n

   Sync:CLS
LOOP

`---------------------
` Functions
`---------------------
Function work(n,wx#,wy#)
   `Array Labels
   X = 1 : Y = 2 : Angle = 3 : Speed = 4

   if abs(wx#-lad#(n,x))>20 or abs(wy#-lad#(n,y))>20
      lad#(n,angle) = curveangle( atanfull(wx#-lad#(n,x),wy#-lad#(n,y)) ,lad#(n,angle), abs((wx#-lad#(n,x))+(wy#-lad#(n,y)))/10)
      if lad#(n,speed)<8 then lad#(n,speed)=lad#(n,speed)+rnd(2)
      lad#(n,x) = lad#(n,x) + sin(lad#(n,angle)+rnd(10))*lad#(n,speed)
      lad#(n,y) = lad#(n,y) + cos(lad#(n,angle)+rnd(10))*lad#(n,speed)
   else
      lad#(n,speed)=0
   endif
Endfunction

`---------------------
` Gosubs
`---------------------
Waypoint:
   oldmx=mx : oldmy=my
   mx=mousex() : my=mousey()

   `static mouse
   if oldmx=mx and oldmy=my
      `idle
      inc mwait,1
      `if idle for a period set random waypoint
      if mwait = 100
         `set random point as waypoint
         for n = 1 to Number_of_Lads
            lad#(n,WayX)=rnd(620)+10 : lad#(n,WayY)=rnd(460)+10
         next n
         `reset mouse wait
         mwait=0
      endif
   else
      `set mouse position as waypoint
      for n = 1 to Number_of_Lads
         lad#(n,WayX)=mx : lad#(n,WayY)=my
      next n
      `reset mouse wait
      mwait=0
   endif
Return

`##########################################################################
`### Ai Project - Topdown shooting                                        #
`### by Link102                                                           #
`### version 3.0                                                          #
`### 24 Febuari 2008                                                     ##
`#########################################################################

`set display mode 1280,1024,32
hide mouse
randomize timer()
print "loading..."
sync on : sync rate 60

dim bullet#(50,3)
dim enemy#(10,3)
dim e_speed#(0)
dim player#(2)
dim score(2)

start:
for e = 0 to 5 : init_enemy(e) : next e
e_speed#(0) = 1

white = rgb(255,255,255)
player#(0) = screen width()/2
player#(1) = screen height()/2
player#(2) = 10.0

ink 0,0


do
   cls white
   set cursor 0,0
   print "Life: ",int(player#(2)*10),"%"
   print "Score: ",score(0)

   xvel# = xvel# + keystate(32) - keystate(30)
   yvel# = yvel# + keystate(31) - keystate(17)

   if xvel# >  5 then xvel# =  5
   if xvel# < -5 then xvel# = -5
   if yvel# >  5 then yvel# =  5
   if yvel# < -5 then yvel# = -5

   if 1 - keystate(32) and 1 - keystate(30)
      if xvel# > 0 then xvel# = xvel# - 1
      if xvel# < 0 then xvel# = xvel# + 1
   endif
   if 1 - keystate(31) and 1 - keystate(17)
      if yvel# > 0 then yvel# = yvel# - 1
      if yvel# < 0 then yvel# = yvel# + 1
   endif

   player#(0) = player#(0) + xvel#
   player#(1) = player#(1) + yvel#

   if player#(0) < player#(2)                   then player#(0) = player#(2)
   if player#(0) > screen width()  - player#(2) then player#(0) = screen width() - player#(2)
   if player#(1) < player#(2)                   then player#(1) = player#(2)
   if player#(1) > screen height() - player#(2) then player#(1) = screen height() - player#(2)

   circle player#(0),player#(1),player#(2)
   draw_cursor(mousex(),mousey(),1)
   update_bullets()
   update_enemy()
   if player#(2) =< 0 then gosub dead
sync
loop

dead:
   show mouse
   do
      cls white
      center text screen width() / 2,screen height() / 2 - 20,"You Died - Game over"
      if score(0) > 0 then center text screen width() / 2,screen height() / 2 + 20,"Score: " + str$(score(0))
      if score(1) > 0 then center text screen width() / 2,screen height() / 2 + 40,"Bullets fired: " + str$(score(1))
      if score(2) > 0 then center text screen width() / 2,screen height() / 2 + 60,"Bullets hit: " + str$(score(2))
      if score(1) > 0 then center text screen width() / 2,screen height() / 2 + 80,"Hit ratio: " + str$((100 / score(1)) * score(2))
      if button("Retry",screen width() / 2 - 100,screen height() / 2,screen width() / 2 - 10,screen height() / 2 + 15) then goto start
      if button("Exit",screen width() / 2 + 10,screen height() / 2,screen width() / 2 + 100,screen height() / 2 + 15) then end
   sync
   loop
   hide mouse
return

function draw_cursor(x,y,scale)
   dot x,y
   circle x,y,8*scale
   line x,y+6*scale,x,y+10*scale
   line x,y-6*scale,x,y-10*scale
   line x+6*scale,y,x+10*scale,y
   line x-6*scale,y,x-10*scale,y
endfunction

function update_bullets()
   if mouseclick() = 1
      rand = rnd(2)-1
      bullet#(nr,0) = player#(0)
      bullet#(nr,1) = player#(1)
      angle# = atanfull(mousex() - player#(0),mousey() - player#(1))
      bullet#(nr,2) = newxvalue(0,angle# + rand,11)
      bullet#(nr,3) = newzvalue(0,angle# + rand,11)
      nr = nr + 1
      if nr = 51 then nr = 0
      score(1) = score(1) + 1
   endif
   for b = 0 to 50
     `position    = position    + velocity
      bullet#(b,0) = bullet#(b,0) + bullet#(b,2)
      bullet#(b,1) = bullet#(b,1) + bullet#(b,3)
      dot bullet#(b,0),bullet#(b,1)
   next b
endfunction

function init_enemy(nr)
   rand = rnd(3)
   if rand = 0
      enemy#(nr,0) = -10
      enemy#(nr,1) = rnd(screen height() - 10) + 5
   endif
   if rand = 1
      enemy#(nr,0) = screen width() + 10
      enemy#(nr,1) = rnd(screen height() - 10) + 5
   endif
   if rand = 2
      enemy#(nr,0) = rnd(screen width()  - 10) + 5
      enemy#(nr,1) = -10
   endif
   if rand = 3
      enemy#(nr,0) = rnd(screen width()  - 10) + 5
      enemy#(nr,1) = screen height() + 10
   endif
   enemy#(nr,2) = 10
endfunction

function update_enemy()
   for e = 0 to 5
      angle# = atanfull(player#(0)-enemy#(e,0),player#(1)-enemy#(e,1))
      if dist(player#(0),enemy#(e,0),player#(1),enemy#(e,1)) < player#(2) + enemy#(e,2)
         player#(2) = player#(2) - 0.1
      else
         enemy#(e,0) = newxvalue(enemy#(e,0),angle#,e_speed#(0))
         enemy#(e,1) = newzvalue(enemy#(e,1),angle#,e_speed#(0))
      endif
      for b = 0 to 50
         if dist(bullet#(b,0),enemy#(e,0),bullet#(b,1),enemy#(e,1)) < enemy#(e,2) + 5
            score(0) = score(0) + 1
            score(2) = score(2) + 1
            bullet#(b,0) = 0
            bullet#(b,1) = 0
            bullet#(b,2) = 0
            bullet#(b,3) = 0
            if enemy#(e,2) < 3
               score(0) = score(0) + 100
               e_speed#(0) = e_speed#(0) + 0.1
               init_enemy(e)
            else
               enemy#(e,2) = enemy#(e,2) - 1
            endif
         endif
      next b
      circle enemy#(e,0),enemy#(e,1),enemy#(e,2)
   next e
endfunction

function dist(x1#,x2#,y1#,y2#)
   d# = sqrt((x2# - x1#)^2+(y2# - y1#)^2)
endfunction d#

function button(tag$,x1,y1,x2,y2)
   line_box(x1,y1,x2,y2)
   if mousex() > x1 and mousex() < x2 and mousey() > y1 and mousey() < y2
      line_box(x1 - 1,y1 - 1,x2 + 1,y2 + 1)
      clicked = mouseclick()
   endif
   c = clicked : clicked = 0
   text x1 + (x2 - x1) / 2 - (text width(tag$) / 2),y1 + (y2 - y1) / 2 - (text height(tag$) / 2),tag$
endfunction c

function line_box(x1,y1,x2,y2)
   line x1,y1,x2,y1
   line x1,y1,x1,y2
   line x2,y1,x2,y2
   line x1,y2,x2,y2
endfunction