remstart
   ==============================================================
   =  Title  : Toolbar example
   =  Author : latch
   =  Date   : 11/13/2008
   =  Update : 11/14/2008
   =  Version:
   ==============================================================
   Comments    Use an ever present toolbar to enter different
               modes (or launch different programs) while some
               main prgram is running.  The modes can be anything.
               The toolbar is designed for up to 10 different
               operations.
               Any of the tools can be turned off or on.  The
               toolbar can be horizontal or vertical, can be sized
               and positioned anywhere on the screen
   ==============================================================
remend
 
rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,32
   sync on
   sync rate 60
 
rem =============================================================
rem = MAIN
rem =============================================================
_main:
   x1=10
   y1=10
   x2=50
   y2=50
   d=0
   white=rgb(255,255,255)
   gray192=rgb(192,192,192)
 
   dim toolinfo$(20)
   for n=0 to 6
      read toolinfo$(n)
   next n
   do
      cls
      ink white,0
      for n=0 to 6
         text 100,160+(n*20),toolinfo$(n)
      next n
 
      b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
      gosub _menu
      gosub _drag_bar
 
      sync
   loop
 
   end
 
rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _menu:
      rem based on the toolbar selection launch appropriate
      rem action
      select b
         case 0 : gosub _trig_demo : endcase
         case 1 : gosub _darklight_demo : endcase
         case 2 : gosub _sprite_fill_demo : endcase
         case 3 : gosub _cloth_demo : endcase
         case 4 : gosub _clock : endcase
 
      endselect
   return
`----------------------------------------------------------------
   _trig_demo:
      rem as a point moves around the circle, the x and y change
      rem through an equal positive range and an equal negative range.
      rem the change in x is a relationship to the radius (hypotenuse of a
      rem right triangle) called cosine.  The change in y is a relationship
      rem to the hypotenuse called sine.  The relationship between how y
      rem changes and how x changes is called tangent.
      rem Since y is opposite on the  viewing screen than a cartesian coordinate
      rem system, I multiply it by -1.
      radius=100
      centerx1=105
      centery1=105
      centerx2=105
      centery2=370
      n=3
 
      rem put toolbar to side, vertical, and slightly smaller
      d=1
      x1=screen width()-50
      y1=10
      x2=x1+40
      y2=y1+40
 
      rem available bitmap
      bmp=1
      while bitmap exist(bmp)
         inc bmp
      endwhile
      create bitmap bmp,screen width(),screen height()
      set current bitmap 0
 
      sync rate 0
 
      while b=0
         cls
         ink rgb(255,255,255),0
         circle centerx1,centery1,radius
 
         rem show change in y on circle
         ink rgb(255,0,0),0
         ang=ang+1
         if ang=360 then ang=0
         x1#=radius*cos(ang)+centerx1
         y1#=-1*radius*sin(ang)+centery1
         line centerx1,centery1,x1#,y1#
 
         ink RGB(192,192,192),0
         box 400,centery1-radius,400,centery1+radius
         box 400-radius,centery1,400+radius,centery1
 
         rem position y on coordinate grid
         ink RGB(255,255,0),0
         circle x1#,y1#,5
         line x1#,y1#,400,y1#
         circle 400,y1#,5
 
         rem draw wave
         set current bitmap bmp
         dot 400,y1#
         get image 1,400-radius,0,402,centery1+radius,1
         if n=4
            paste image 1,399-radius,0
            n=0
         else
            inc n
         endif
         set current bitmap 0
         paste image 1,400-radius,0,1
 
         ink rgb(255,255,255),0
         text 410,y1#,"Y = "+str$(centery1-y1#)
 
         rem show change in x on circle
         ink rgb(255,255,255),0
         circle centerx2,centery2,radius
 
         ink rgb(0,255,0),0
         x2#=radius*cos(ang)+centerx2
         y2#=-1*radius*sin(ang)+centery2
         line centerx2,centery2,x2#,y2#
 
         ink RGB(192,192,192),0
         box 400,centery2-radius,400,centery2+radius
         box 400-radius,centery2,400+radius,centery2
 
         ink RGB(255,255,0),0
         circle x2#,y2#,5
         line x2#,y2#,x2#+(400-radius),centery2
         circle x2#+(400-radius),centery2,5
 
         ink rgb(255,255,255),0
         text x2#+(400-radius),centery2-30,"X = "+str$(x2#-centerx2)
 
         text 220,220,"Assuming the center of the circles are at (0,0)"
         text 220,240,"Tangent of Angle"+str$(ang)+" = "+str$(tan(ang))
         text 220,260,"Y / X = "+str$((centery1-y1#)/(x2#-centerx2))
 
         text 700,100,str$(screen fps())
         b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
         sync
      endwhile
      delete bitmap bmp
      delete image 1
      rem reset the toolbar for the return to main screen
      x1=10
      y1=10
      x2=50
      y2=50
      d=0
      cls
   return
`----------------------------------------------------------------
   _darklight_demo:
      rem put toolbar to side, vertical, and slightly smaller
      d=1
      x1=screen width()-20
      y1=10
      x2=x1+15
      y2=y1+40
      backdrop on
 
      gosub _make_landscape
 
      camx#=5000
      camz#=-1000
      camy#=1000
 
      position camera camx#,camy#,camz#
      point camera 5000,0,5000
 
      gosub _lighting
 
      rem make sphere for regular light source
      make object sphere 1,50
      position object 1,5000,1200,0
 
      rem make sphere for dark light source
      make object sphere 2,50
      position object 2,5000,1000,1000
 
      rem choose darklight for key movement
      globe=2
 
      while b=1
         gosub _move_sphere
         text 0,0,globe$
         text 0,20,"FPS   "+str$(screen fps())
         text 0,40,"Press 1 or 2 to switch globes"
         text 0,60,"Move Globes with arrow keys"
         text 0,80,"and CTRL and SHIFT to demonstrate"
         text 0,100,"the effects of a Drak Light"
         text 0,120,"Globe 1 is regular light"
         text 0,140,"Globe 2 is dark light"
         b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
         sync
      endwhile
 
      rem cleanup
      delete matrix 1
      delete image 1
      delete object 1
      delete object 2
      set ambient light 100
      color ambient light rgb(255,255,255)
      delete light 1
      set directional light 0,0,1,0
      backdrop off
      cls
      x1=10
      y1=10
      x2=50
      y2=50
      d=0
   return
`---------------------------------------------------------
   _make_landscape:
      cls rgb(0,200,0)
      get image 1,0,0,10,10
      make matrix 1,10000,10000,25,25
      prepare matrix texture 1,1,1,1
      randomize matrix 1,1000
      update matrix 1
 
      calc_mat_normals(1,25,25,10000/50.0,10000/50.0)
 
   return
`----------------------------------------------------------------
   _lighting:
      set ambient light 10
      color ambient light rgb(132,132,132)
      set point light 0,5000,1200,1000
 
      rem here's the dark light
      make light 1
      color light 1,-200,-200,-200
   return
 
 
   return
`----------------------------------------------------------------
   _move_sphere:
 
      if keystate(2)=1
         globe=1
         globe$="Regular Point light selected"
      endif
      if keystate(3)=1
         globe=2
         globe$="Dark Light point light selected"
      endif
 
 
      x#=object position x(globe)
      y#=object position y(globe)
      z#=object position z(globe)
 
      if upkey()=1 then z#=z#+10
      if downkey()=1 then z#=z#-10
      if leftkey()=1 then x#=x#-10
      if rightkey()=1 then x#=x#+10
      if shiftkey()=1 then y#=y#+10
      if controlkey()=1 then y#=y#-10
 
      position object globe,x#,y#,z#
 
      rem move light with sphere
      set point light globe-1,x#,y#,z#
 
   return
 
`----------------------------------------------------------------
   _sprite_fill_demo:
      rem draw a shape with the mouse and it will kinda fill
      x1=100
      y1=10
      x2=120
      y2=30
      d=0
      ink rgb(255,255,255),0
      sync rate 0
      cls
      while b=2
         text 0,100,"Draw with mouse and left click"
         mx=mousex()
         my=mousey()
         rem draw shape
         while mouseclick()=1
            if start=0
               highx=0
               highy=0
               firstx=mx
               lowx=firstx
               firsty=my
               lowy=my
               start=1
            endif
            oldx=mx
            oldy=my
            mx=mousex()
            my=mousey()
            line oldx,oldy,mx,my
 
            if mx >= firstx and mx >= highx then highx=mx
            if mx < firstx and mx < lowx then lowx=mx
            if my >= firsty and my >=highy then highy=my
            if my < firsty and my < lowy then lowy=my
 
            if image exist(1) then delete image 1
            get image 1,lowx,lowy,highx+1,highy+1
            b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
            sync
         endwhile
         start=0
 
         rem fill image
         if image exist(1)
            rem figure out center
            cx#=((highx-lowx)/2)+lowx
            cy#=((highy-lowy)/2)+lowy
            rem exapansion
            xspan#=(highx-lowx)/200.0
            yspan#=(highy-lowy)/200.0
 
            sprite 1,lowx,lowy,1
            hide sprite 1
            set sprite 1,0,1
            for s=0 to 100
               `s#=s/10.0
               scale sprite 1,s
               `size sprite 1,s#,s#
               dec cx#,xspan#
               dec cy#,yspan#
               paste sprite 1,cx#,cy#
               sync
            next s
            delete image 1
         endif
         b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
         sync
      endwhile
      cls
      x1=10
      y1=10
      x2=50
      y2=50
      d=0
      sync rate 60
   return
`----------------------------------------------------------------
   _cloth_demo:
      sync rate 40
      autocam off
 
      backdrop on
 
      x1=300
      y1=10
      x2=350
      y2=50
      d=0
 
      matx#=2000
      matz#=2000
      tilex=40
      tilez=40
      mat=1
 
      set camera range 1,10000
 
      make matrix mat,matx#,matz#,tilex,tilez
      randomize matrix 1,200
 
      position camera matx#/2,1000,-700
      point camera matx#/2,0,matz#/2
 
      while b=3
         text 0,0,str$(screen fps())
         ht=rnd(1800)-9800
         if rnd(100) < 11
            set matrix height mat,rnd(tilex-2)+1,rnd(tilez-2)+1,ht
         endif
         for z=1 to tilez-1
            for x=1 to tilex-1
               avg#=(get matrix height(mat,x-1,z)+get matrix height(mat,x+1,z)+get matrix height(mat,x,z-1)+get matrix height(mat,x,z+1))/4
               set matrix height mat,x,z,avg#
            next x
         next z
         update matrix 1
         b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
         sync
      endwhile
      delete matrix mat
      backdrop off
      cls
      x1=10
      y1=10
      x2=50
      y2=50
      d=0
      sync rate 60
   return
`----------------------------------------------------------------
   _clock:
      cls 0
      cx1=screen width()-120
      cy1=120
      autocam on
      set text font "system",1
      set text size 20
      sync
      backdrop on
 
      make object plain 1,10.7,10
      make object plain 2,10.7,10
      make object plain 3,10.7,10
      make object plain 4,10.7,10
 
      create bitmap 1,bitmap width(0),bitmap height(0)
 
      position object 1,5,0,0
      position object 2,-5,0,0
 
      turn object right 1,20
      turn object left 2,20
 
      position object 3,3.5,-5,-4
      position object 4,-3.5,-5,-4
      ghost object on 3
      ghost object on 4
 
      turn object right 3,20
      pitch object down 3,270
      turn object left 4,20
      pitch object down 4,270
 
      t$="Can you tell me what time it is?"
 
       while b=4
         set current bitmap 1
         cls
         a$=get time$()
         sizet=len(a$)
 
         rem get seconds
         sec=val(right$(a$,2))
         rem get minutes
         min=val(mid$(a$,sizet-4)+mid$(a$,sizet-3))
         rem get hours
         hour=val(left$(a$,2))
         if hour > 12 then hour=hour-12
 
         `ink rgb(255,255,255),0
         ink gray192,0
         box cx1-90,cy1-90,cx1+90,cy1+90
 
         for n=300 to 630 step 30
            nx=60*cos(n)+cx1
            ny=60*sin(n)+cy1
            tx=70*cos(n)+cx1
            ty=70*sin(n)+cy1
            ink white,0
            dot nx,ny
            text tx-(text width("3")/2),ty-(text height("3")/2),str$(((n-300)/30)+1)
            ink 0,0
            dot nx+1,ny+1
            text tx-(text width("3")/2)+1,ty-(text height("3")/2)+1,str$(((n-300)/30)+1)
         next n
 
         sang=wrapvalue((sec*6)-90)
         sx2=48*cos(sang)+cx1
         sy2=48*sin(sang)+cy1
         ink white,0
         line cx1,cy1,sx2,sy2
         ink 0,0
         line cx1+1,cy1+1,sx2+1,sy2+1
 
         mang=wrapvalue((min*6)-90)
         sx2=55*cos(mang)+cx1
         sy2=55*sin(mang)+cy1
         ink white,0
         line cx1,cy1,sx2,sy2
         ink 0,0
         line cx1+1,cy1+1,sx2+1,sy2+1
 
         hang#=wrapvalue((hour*30)-90)
         sx2=35*cos(hang#+(mang/6.0))+cx1
         sy2=35*sin(hang#+(mang/6.0))+cy1
         ink white,0
         line cx1,cy1,sx2,sy2
         ink 0,0
         line cx1+1,cy1+1,sx2+1,sy2+1
 
         rem green
         get image 2,cx1-90,cy1-90,cx1+91,cy1+91
 
         wd=text width(t$)
         dec tn
         if tn <= 0-wd then tn=100
         rem red
         cls RGB(255,0,0)
         ink 0,0
         `box 0,0,10,10
         text tn,0,t$
         get image 1,0,0,101,text height(t$)
 
         texture object 1,1
         texture object 3,1
         texture object 2,2
         texture object 4,2
 
         set current bitmap 0
         paste image 2,cx1-90,cy1-90
         b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
         sync
       endwhile
      rem cleanup
      delete object 1
      delete object 2
      delete object 3
      delete object 4
      delete image 1
      delete image 2
      autocam off
      delete bitmap 1
      backdrop off
      set text font "arial",1
      set text size 16
      sync
   return
`----------------------------------------------------------------
   _drag_bar:
      rem figure out bar size
      wd=x2-x1
      ht=y2-y1
      if d=0
         fwd=(wd+2)*10
         fht=ht
      else
         fht=(ht+2)*10
         fwd=wd
      endif
 
      if mouse_within(x1,y1,x1+fwd,y1+fht)
         while mouseclick()=2
            cls
            mmx=mousemovex()
            mmy=mousemovey()
            x1=x1+mmx
            y1=y1+mmy
            x2=x2+mmx
            y2=y2+mmy
 
            b=toolbar(d,10,x1,y1,x2,y2,1,1,1,1,1,1,1,1,1,1)
            sync
         endwhile
      endif
   return
 
rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function toolbar(direction,numbuttons,x1,y1,x2,y2,t0,t1,t2,t3,t4,t5,t6,t7,t8,t9)
      remstart
         toolbar function by latch
         11/13/2008
 
         originally had clickflag as a parameter but changed it for
         a one time test when the function is first launched
         if you set clickflag to 0, then the buttons will toggle off
         after being clicked.
 
         if clickflag=1, the buttons will remain on
 
         direction = 0 horizontal bar
         direction = 1 vertical bar
         x1,y1,x2,y2 position and size of first button
         ts are the tools on the toolbar.  10 posibilities
         on=1
         off=0 for each tool
 
         the function returns tool number
         return -1 = no tool
      remend
      if clickflag=0 then button=-1
 
      dim t(9)
      t(0)=t0 : t(1)=t1 : t(2)=t2 : t(3)=t3 : t(4)=t4
      t(5)=t5 : t(6)=t6 : t(7)=t7 : t(8)=t8 : t(9)=t9
 
      if direction < 0 then direction=0
      if direction > 1 then direction=1
 
      if numbuttons<=0 then exitfunction -1
      if numbuttons > 10 then numbuttons=10
 
      rem figure out bar size
      wd=x2-x1
      ht=y2-y1
      if direction=0
         fwd=(wd+2)*numbuttons
         fht=ht
         ink rgb(170,170,170),0
         box x1-1,y1-1,x1+fwd-1,y2+1
      else
         fht=(ht+2)*numbuttons
         fwd=wd
         ink rgb(170,170,170),0
         box x1-1,y1-1,x2+1,y1+fht-1
      endif
 
      rem draw and detect buttons
      mx=mousex()
      my=mousey()
 
      for n=0 to numbuttons-1
         if direction=0
            if t(n)=1
               rem nonpressed button
               x3=x1+(n*wd)+(n*2) : x4=x2+(n*wd)+(n*2)
               ink rgb(192,192,192),0
               box x3,y1,x4,y2
               ink rgb(255,255,255),0
               box x3,y1,x4,y1
               box x3,y1,x3,y2
               ink rgb(32,32,32),0
               box x4,y1+1,x4,y2
               box x3,y2,x4,y2
 
               rem check for mouse position and click
               if mx >= x3 and mx <= x4 and my >=y1 and my <=y2
                  omc=nmc
                  nmc=mouseclick() & 1
                  if nmc>omc and button <> n
                     button=n
                     clickflag=1
                     exit
                  endif
                  if nmc > omc and button = n
                     button=-1
                     exit
                  endif
               endif
            endif
         endif
         if direction=1
            if t(n)=1
               rem nonpressed button
               y3=y1+(n*ht)+(n*2) : y4=y2+(n*ht)+(n*2)
               ink rgb(192,192,192),0
               box x1,y3,x2,y4
               ink rgb(255,255,255),0
               box x1,y3,x2,y3
               box x1,y3,x1,y4
               ink rgb(32,32,32),0
               box x2,y3+1,x2,y4
               box x1,y4,x2,y4
 
               rem check for mouse position and click
               if mx >= x1 and mx <= x2 and my >=y3 and my <=y4
                  omc=nmc
                  nmc=mouseclick() & 1
                  if nmc>omc and button <> n
                     button=n
                     clickflag=1
                     exit
                  endif
                  if nmc > omc and button = n
                     button=-1
                     exit
                  endif
               endif
 
            endif
         endif
      next n
 
      rem pressed buttons
      if button <> -1 and direction=0
         x3=x1+(button*wd)+(button*2) : x4=x2+(button*wd)+(button*2)
         ink rgb(192,192,192),0
         box x3,y1,x4,y2
         ink rgb(32,32,32),0
         box x3,y1,x4,y1
         box x3,y1,x3,y2
         ink rgb(255,255,255),0
         box x4,y1+1,x4,y2
         box x3,y2,x4,y2
      endif
      if button <> -1 and direction=1
         y3=y1+(button*ht)+(button*2) : y4=y2+(button*ht)+(button*2)
         ink rgb(192,192,192),0
         box x1,y3,x2,y4
         ink rgb(32,32,32),0
         box x1,y3,x2,y3
         box x1,y3,x1,y4
         ink rgb(255,255,255),0
         box x2,y3+1,x2,y4
         box x1,y4,x2,y4
      endif
 
   endfunction button
`----------------------------------------------------------------
   function mouse_within(x1,y1,x2,y2)
      result=0
      if mousex() <=x2 and mousex() >=x1 and mousey() <=y2 and mousey() >=y1
         result=1
      endif
   endfunction result
`----------------------------------------------------------------
   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-1,z-1)
 
            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 = DATA STATEMENTS
rem =============================================================
_toolinfo:
data "Tool 1 = Demonstrates the relationship of Sin and Cos to a Circle"
data "and Cartesian coordinates."
data "Tool 2 = Demonstrates a "Dark Light" - a DBC light with minus"
data "color values"
data "Tool 3 = Uses a Sprite to fill and area drawn with the mouse"
data "Tool 4 = Matrix behaving like a cloth or gel Demo."
data "Tool 5 = Analog Clock"