rem #####################################################
rem #     Program : dotdemo
rem # 
rem #      Author : Marc Gale (Xalthorn)
rem #
rem #        Date : 8th September 2001
rem #
rem # Description : A 3D dot object that is rotated 
rem #               under the control of the user.  The
rem #               object also morphs between various
rem #               different shapes.
rem #
rem #####################################################

gosub initialise
gosub main_loop
exit

rem #####################################################
rem # Procedure name : main_loop
rem # 
rem #        Details : The main housekeeping routine.
rem #                  This is basically the heart of
rem #                  the program, calling routines 
rem #                  to do the various tasks required
rem #                  by the program.
rem #
rem #####################################################
label main_loop
 repeat
  gosub flip_screen
  clear window

  gosub process_input
  gosub draw_stars
  gosub display_name
  gosub display_scroller
  gosub morph
  gosub rotchange
  gosub cycle_colour

  buttons=peek("port1")
 until (and(buttons,16384)>0)
return

rem #####################################################
rem # Procedure name : display_scroller
rem # 
rem #        Details : This routine displays the scroll
rem #                  text message.  As well as 
rem #                  displaying the message, it deals
rem #                  with everything to do with it.
rem #                  This includes advancing the text
rem #                  and looping back to the start.
rem # 
rem #####################################################
label display_scroller
 setrgb 1,255,255,255
 mx=mx-2
 if mx<=0 then 
  mx=mx+10
  mpos=mpos+1
  if mpos>len(m$) then
   mpos=0
  fi
 fi

 text mx,500,mid$(m$,mpos,64)
 setrgb 1,0,0,0
 fill rectangle 0,490 to 10,512
return

rem #####################################################
rem # Procedure name : display_name
rem # 
rem #        Details : This routine displays the name
rem #                  of the current shape when it is
rem #                  fully formed.  It also fades the 
rem #                  text out.
rem # 
rem #####################################################
label display_name
 if textlife<=0 then return fi

 textlife=textlife-5
 setrgb 1,textlife,textlife,textlife
 text 0,20,name$,"lb"
return

rem #####################################################
rem # Procedure name : cycle_colour
rem # 
rem #        Details : This routine cycles the colour of
rem #                  the shape by comparing the current
rem #                  and target values of the red, 
rem #                  green, and blue variables.
rem #
rem #                  When the target values are met, 
rem #                  new target values are randomly
rem #                  selected.
rem # 
rem #####################################################
label cycle_colour
 if red=tred and green=tgreen and blue=tblue then
  tred=int(ran(100))/100
  tblue=int(ran(100))/100
  tgreen=int(ran(100))/100
  return
 fi

 if red<tred then
  red=red+0.01
  if red>tred then
   red=tred
  fi
 fi

 if red>tred then
  red=red-0.01
  if red<tred then
   red=tred
  fi
 fi

 if green<tgreen then
  green=green+0.01
  if green>tgreen then
   green=tgreen
  fi
 fi

 if green>tgreen then
  green=green-0.01
  if green<tgreen then
   green=tgreen
  fi
 fi

 if blue<tblue then
  blue=blue+0.01
  if blue>tblue then
   blue=tblue
  fi
 fi

 if blue>tblue then
  blue=blue-0.01
  if blue<tblue then
   blue=tblue
  fi
 fi
return

rem #####################################################
rem # Procedure name : rotchange
rem # 
rem #        Details : This routine changes the global
rem #                  rotation values based on the 
rem #                  current rotation offset values.
rem #
rem #                  It is the rotation offset values
rem #                  that are under the user's control.
rem # 
rem #####################################################
label rotchange
 xrot=xrot+xroto
 if xrot<0 then xrot=xrot+360 fi
 if xrot>360 then xrot=xrot-360 fi

 yrot=yrot+yroto
 if yrot<0 then yrot=yrot+360 fi
 if yrot>360 then yrot=yrot-360 fi

 zrot=zrot+zroto
 if zrot<0 then zrot=zrot+360 fi
 if zrot>360 then zrot=zrot-360 fi
return

rem #####################################################
rem # Procedure name : process_input
rem # 
rem #        Details : This routine deals with the joypad
rem #                  doing whatever is required.
rem # 
rem #####################################################
label process_input
 if and(buttons,32768)>0 then
  xroto=0:yroto=0:zroto=0
 fi

 if and(buttons,1024)>0 and zroto>-offmax then
  zroto=zroto-1
 fi

 if and(buttons,2048)>0 and zroto<offmax then
  zroto=zroto+1
 fi

 if and(buttons,128)>0 and yroto>-offmax then
  yroto=yroto-1
 fi

 if and(buttons,32)>0 and yroto<offmax then
  yroto=yroto+1
 fi

 if and(buttons,64)>0 and xroto>-offmax then
  xroto=xroto-1
 fi

 if and(buttons,16)>0 and xroto<offmax then
  xroto=xroto+1
 fi

return

rem #####################################################
rem # Procedure name : draw_stars
rem # 
rem #        Details : This is the main drawing routine
rem #                  that reads the position of each
rem #                  star, rotates it to the correct
rem #                  position in space, applies the 
rem #                  perspective calculation that throws
rem #                  the objects onto a 2D plane, and 
rem #                  finally draws the stars with a 
rem #                  suitably coloured and sized square.
rem # 
rem #####################################################
label draw_stars
 focus=2000

 for star=1 to numstars
  x=starx(star)
  y=stary(star)
  z=starz(star)

  rem x rotation
  xx=x
  yy=y*cosines(xrot)+z*sines(xrot)
  zz=z*cosines(xrot)-y*sines(xrot)

  rem y rotation
  x=xx*cosines(yrot)-zz*sines(yrot)
  y=yy
  z=xx*sines(yrot)+zz*cosines(yrot)

  rem z rotation
  xx=x*cosines(zrot)-y*sines(zrot)
  yy=x*sines(zrot)+y*cosines(zrot)
  zz=z

  rem perspective transformation
  xx=xx/((zz/focus)+1)
  yy=yy/((zz/focus)+1)

  brightness=128-(zz/2)
  size=brightness/20
  setrgb 1,red*brightness,green*brightness,blue*brightness
  fill rectangle ox+xx,oy+yy to ox+xx+size,oy+yy+size

 next star
return

rem #####################################################
rem # Procedure name : flip_screen
rem # 
rem #        Details : This is the screen buffer handling
rem #                  routine.  Call this routine just
rem #                  before you start drawing your 
rem #                  screen.  Oh, you might want to 
rem #                  clear the window just after you've
rem #                  called this routine.
rem # 
rem #####################################################
label flip_screen
 setdispbuf curbuf 
 curbuf=1-curbuf
 setdrawbuf curbuf
return

rem #####################################################
rem # Procedure name : setup_shapes
rem # 
rem #        Details : This routine sets up the shapes 
rem #                  that will be morphed between.
rem #
rem #                  To add your own shape, add one to
rem #                  the numshapes variable in the 
rem #                  initialise routine and then add 
rem #                  your own little piece of code in
rem #                  the relevant place.
rem # 
rem #####################################################
label setup_shapes

 dim shapes(numshapes,numstars,3)
 dim shapename$(numshapes)

 shapename$(1)="Pyramids"
 for a=1 to 20
  shapes(1,a,1)=(a*10)-100
  shapes(1,a,2)=-100
  shapes(1,a,3)=-100

  shapes(1,a+20,1)=(a*5)-100
  shapes(1,a+20,2)=-100
  shapes(1,a+20,3)=(a*10)-100

  shapes(1,a+40,1)=(a*5)
  shapes(1,a+40,2)=-100
  shapes(1,a+40,3)=((10-a)*10)

  shapes(1,a+60,1)=(a*5)-100
  shapes(1,a+60,2)=(a*10)-100
  shapes(1,a+60,3)=(a*5)-100

  shapes(1,a+80,1)=(a*5)
  shapes(1,a+80,2)=((10-a)*10)
  shapes(1,a+80,3)=((10-a)*5)-50

  shapes(1,a+100,1)=0
  shapes(1,a+100,2)=((10-a)*10)
  shapes(1,a+100,3)=(a*5)
 next a
 for a=1 to 5
  shapes(1,a+120,1)=(a*10)-25
  shapes(1,a+120,2)=-25
  shapes(1,a+120,3)=-25

  shapes(1,a+125,1)=(a*5)-25
  shapes(1,a+125,2)=-25
  shapes(1,a+125,3)=(a*10)-25

  shapes(1,a+130,1)=(a*5)
  shapes(1,a+130,2)=-25
  shapes(1,a+130,3)=((6-a)*10)-25

  shapes(1,a+135,1)=(a*5)-25
  shapes(1,a+135,2)=(a*10)-25
  shapes(1,a+135,3)=(a*5)-25

  shapes(1,a+140,1)=(a*5)
  shapes(1,a+140,2)=((6-a)*10)-25
  shapes(1,a+140,3)=((6-a)*5)-25

  shapes(1,a+145,1)=0
  shapes(1,a+145,2)=((6-a)*10)-25
  shapes(1,a+145,3)=(a*5)
 next a

 shapename$(2)="Coiled spring"
 for a=1 to numstars
  shapes(2,a,1)=int(sin((a*14)*(pi/180))*200)
  shapes(2,a,2)=int(cos((a*14)*(pi/180))*200)
  shapes(2,a,3)=int(cos((a)*(pi/180))*200)
 next a

 shapename$(3)="Bendy strip"
 for a=1 to numstars
  shapes(3,a,1)=int(sin((a)*(pi/180))*sin((a)*(pi/180))*200)
  shapes(3,a,2)=int(sin((a)*(pi/180))*cos((a)*(pi/180))*200)
  shapes(3,a,3)=int(cos((a)*(pi/180))*200)
 next a

 shapename$(4)="Bent infinity"
 for a=1 to numstars
  shapes(4,a,1)=int(sin((a*2.5)*(pi/180))*sin((a*2.5)*(pi/180))*200)
  shapes(4,a,2)=int(sin((a*2.5)*(pi/180))*cos((a*2.5)*(pi/180))*200)
  shapes(4,a,3)=int(cos((a*2.5)*(pi/180))*200)
 next a

 shapename$(5)="Ring sphere"
 long=0
 lat=0
 for a=1 to numstars
  if long>360 then
   long=long-360
   lat=lat+15
  fi
  shapes(5,a,1)=int(sin(long*(pi/180))*sin(lat*(pi/180))*200)
  shapes(5,a,2)=int(sin(long*(pi/180))*cos(lat*(pi/180))*200)
  shapes(5,a,3)=int(cos(long*(pi/180))*200)
  long=long+30
 next a

 shapename$(6)="One ring to show them all"
 for a=1 to numstars
  shapes(6,a,1)=int(sin((a*2.5)*(pi/180))*200)
  shapes(6,a,2)=int(cos((a*2.5)*(pi/180))*200)
  shapes(6,a,3)=0
 next a

 shapename$(7)="Random sphere"
 for a=1 to numstars
  long=int(ran(360))
  lat=int(ran(360))
  shapes(7,a,1)=int(sin(long*(pi/180))*sin(lat*(pi/180))*200)
  shapes(7,a,2)=int(sin(long*(pi/180))*cos(lat*(pi/180))*200)
  shapes(7,a,3)=int(cos(long*(pi/180))*200)
 next a

 shapename$(8)="Rod"
 for a=1 to numstars
  shapes(8,a,1)=int(sin((a*2)*(pi/180))*200)
  shapes(8,a,2)=int(sin((a*2)*(pi/180))*200)
  shapes(8,a,3)=0
 next a

 shapename$(9)="Big box"
 for a=1 to numstars
  x=int(mod(a,5))
  y=int(mod(a/5,5))
  z=int(mod(a/25,5))
  shapes(9,a,1)=x*80-160
  shapes(9,a,2)=y*80-160
  shapes(9,a,3)=z*80-160
 next a

 shapename$(10)="The sun"
 for a=1 to numstars
  r=200-(mod(a,5)*20)
  shapes(10,a,1)=int(sin((a*2.5)*(pi/180))*r)
  shapes(10,a,2)=int(cos((a*2.5)*(pi/180))*r)
  shapes(10,a,3)=0
 next a

 shapename$(11)="Crop circles"
 for a=1 to numstars
  r=200-(mod(a,5)*40)
  shapes(11,a,1)=int(sin((a*2.5)*(pi/180))*r)
  shapes(11,a,2)=int(cos((a*2.5)*(pi/180))*r)
  shapes(11,a,3)=0
 next a

 shapename$(12)="Clover"
 for a=1 to numstars
  r=cos((a*5)*(pi/180))*200
  shapes(12,a,1)=int(sin((a*2.5)*(pi/180))*r)
  shapes(12,a,2)=int(cos((a*2.5)*(pi/180))*r)
  shapes(12,a,3)=0
 next a

 shapename$(13)="Flower"
 for a=1 to numstars
  r=cos((a*10)*(pi/180))*200
  shapes(13,a,1)=int(sin((a*2.5)*(pi/180))*r)
  shapes(13,a,2)=int(cos((a*2.5)*(pi/180))*r)
  shapes(13,a,3)=0
 next a

 shapename$(14)="Double headed flower"
 for a=1 to numstars
  r=cos((a*10)*(pi/180))*200
  shapes(14,a,1)=int(sin((a*2.5)*(pi/180))*r)
  shapes(14,a,2)=int(cos((a*2.5)*(pi/180))*r)
  shapes(14,a,3)=r
 next a

 shapename$(15)="Double twist loop"
 for a=1 to numstars
  r=cos((a*5)*(pi/180))*200
  shapes(15,a,1)=int(sin((a*2.5)*(pi/180))*r)
  shapes(15,a,2)=int(cos((a*2.5)*(pi/180))*r)
  shapes(15,a,3)=r
 next a

 shapename$(16)="Folded circle"
 for a=1 to numstars
  z=int(cos((a*5)*(pi/180))*200)
  if z>0 then z=0 fi
  shapes(16,a,1)=int(sin((a*5)*(pi/180))*200)
  shapes(16,a,2)=int(cos((a*5)*(pi/180))*200)
  shapes(16,a,3)=z
 next a

 shapename$(17)="Clamshell"
 for a=1 to numstars
  z=int(cos((a*2.5)*(pi/180))*200)
  if z>0 then z=0 fi
  shapes(17,a,1)=int(sin((a*5)*(pi/180))*200)
  shapes(17,a,2)=int(cos((a*5)*(pi/180))*200)
  shapes(17,a,3)=z
 next a

 shapename$(18)="Table (or upside down crown)"
 for a=1 to numstars
  z=int(cos((a*20)*(pi/180))*200)
  if z>0 then z=0 fi
  shapes(18,a,1)=int(sin((a*5)*(pi/180))*200)
  shapes(18,a,2)=int(cos((a*5)*(pi/180))*200)
  shapes(18,a,3)=z
 next a
return

rem #####################################################
rem # Procedure name : set_target
rem # 
rem #        Details : This routine sets the target x,y,z
rem #                  coords for each star based on the
rem #                  target shape.
rem # 
rem #####################################################
label set_target
 for a=1 to numstars
  startx(a)=shapes(targetshape,a,1)
  starty(a)=shapes(targetshape,a,2)
  startz(a)=shapes(targetshape,a,3)
 next a
return

rem #####################################################
rem # Procedure name : morph
rem # 
rem #        Details : This routine does the actual 
rem #                  morphing of the shape.  It's very
rem #                  simple really.  It just looks at
rem #                  each star and works out if it needs
rem #                  moving.  When none need moving, it
rem #                  counts down a simple counter and 
rem #                  then picks a new shape to morph to.
rem # 
rem #####################################################
label morph
 change=0
 for a=1 to numstars
  x=starx(a):tx=startx(a)
  y=stary(a):ty=starty(a)
  z=starz(a):tz=startz(a)

  if x<tx then
   x=x+changespeed
   if x>tx then x=tx fi
   change=1
  fi
  if x>tx then
   x=x-changespeed
   if x<tx then x=tx fi
   change=1
  fi

  if y<ty then
   y=y+changespeed
   if y>ty then y=ty fi
   change=1
  fi
  if y>ty then
   y=y-changespeed
   if y<ty then y=ty fi
   change=1
  fi

  if z<tz then
   z=z+changespeed
   if z>tz then z=tz fi
   change=1
  fi
  if z>tz then
   z=z-changespeed
   if z<tz then z=tz fi
   change=1
  fi

  starx(a)=x
  stary(a)=y
  starz(a)=z
 next a

  if change=0 then
   if name$="" then
    name$=shapename$(targetshape)
    textlife=255
   fi
   changewait=changewait-1
   if changewait<=0 then
    name$=""
    changewait=changedelay
    targetshape=targetshape+1
    if targetshape>numshapes then
     targetshape=1
    fi
    gosub set_target
   fi
  fi
return

rem #####################################################
rem # Procedure name : setup_message
rem # 
rem #        Details : This routine sets up the scroll
rem #                  text message.  That's all it does.
rem # 
rem #####################################################
label setup_message
 m$="                                                 "
 m$=m$+"                    "
 m$=m$+"Welcome to the sedate dot demo.  You can rotate "
 m$=m$+"the shapes by using the joypad in port 1.  Press "
 m$=m$+"left and right to rotate the shape around the Y "
 m$=m$+"axis, press up and down to rotate the shape "
 m$=m$+"around the X axis, and use L1 and R1 to rotate "
 m$=m$+"the shape around the Z axis.  "
 m$=m$+"You can stop the rotation by pressing the square "
 m$=m$+"button.  Oh yes, and the cross button stops the "
 m$=m$+"demo.  "
 m$=m$+"The shape morphs between "+str$(numshapes)
 m$=m$+" preset shapes.  "
 m$=m$+"You can add your own shapes by increasing the "
 m$=m$+"numshapes variable in the initialise routine ("
 m$=m$+"at the end of the code) and by adding your own "
 m$=m$+"bit of code in the setup_shapes routine.  Oh, "
 m$=m$+"and don't forget to give your shape a name.  "
 m$=m$+"You may have noticed that this demo doesn't run "
 m$=m$+"at full speed.  This is hardly surprising.  "
 m$=m$+"There are "+str$(numstars)+" dots in the demo.  "
 m$=m$+"If anyone can speed up the code and get a "
 m$=m$+"noticeable speed improvement, please email me "
 m$=m$+"at marc.gale@ntlworld.com and let me know how ("
 m$=m$+"now there's a challenge).  "
 m$=m$+"Finally a little hello to some of the folks at "
 m$=m$+"www.yabasic.co.uk.  Hiya doctor, keep up the "
 m$=m$+"good work and determination.  Mr. Shockwave, keep"
 m$=m$+" those demos and games coming.  Rafryer. "
 m$=m$+"Jacob busby.  Master Tonberry.  Ps2yabasic, "
 m$=m$+"thank you again and again for giving us the "
 m$=m$+"site.  And to everyone else I have momentarily "
 m$=m$+"forgotten."
return

rem #####################################################
rem # Procedure name : initialise
rem # 
rem #        Details : This routine sets up all of the
rem #                  global variables and arrays.  I've
rem #                  placed it at the end of the code
rem #                  because it's out of the way and 
rem #                  can easily be reached by pressing
rem #                  the CTRL and END keys together.
rem # 
rem #####################################################
label initialise
 sw=640
 sh=512
 ox=sw/2
 oy=sh/2
 curbuf=0

 numstars=150
 numshapes=18
 targetshape=1
 changespeed=4
 changedelay=50
 changewait=changedelay
 name$=""
 textlife=0
 mx=10
 mpos=0

 red=1:blue=1:green=1
 tred=1:tblue=0:tgreen=0

 gosub setup_message

 dim starx(numstars)
 dim stary(numstars)
 dim starz(numstars)

 dim startx(numstars)
 dim starty(numstars)
 dim startz(numstars)

 dim cosines(360)
 dim sines(360)
 for angle=0 to 360
  cosines(angle)=cos(angle*(pi/180))
  sines(angle)=sin(angle*(pi/180))
 next angle

 gosub setup_shapes

 for a=1 to numstars
  starx(a)=0
  stary(a)=0
  starz(a)=0
 next a

 gosub set_target

 xrot=0:xroto=0
 yrot=0:yroto=0
 zrot=0:zroto=0
 offmax=4

 open window sw,sh
 clear window
return


