aUCBLogo Demos and Tests / cylindertest

be cylindertest
   Level1=0.5
   Level2=0.8
   texx=0
   texxd=1
   texx2=0
   texx2d=-0.1
   texxmax=100

   mode=1
   rings=true
   blocking=false
   Cyl1=[]
   Cyl2=[]

   s=(Slider [][Level1] 0 Level1*100 100
   [   Level1=SliderValue/100
      genRings
      drawScene Level1 Level2
   ] wxsl_inverse+wxsl_vertical+wxsl_labels
   [0 0][60 150])

   s2=(Slider [][Level2] 0 Level2*100 100
   [   Level2=SliderValue/100
      genRings
      drawScene Level1 Level2
   ] wxsl_inverse+wxsl_vertical+wxsl_labels
   [70 0][60 150])

   srot=(Slider [][Rotation] -5 0 5
   [   rotateScene4::dphi=SliderValue/5
   ] wxsl_labels
   [0 180][150 50])

   sflow=(Slider [][Flow] -100 0 100
   [   texxd=SliderValue/50
   ] wxsl_labels
   [0 240][150 50])

   rb1=(RadioButton [][Mode1]
   [   mode=1
      drawScene Level1 Level2
   ] wxrb_group [0 300])
   rb2=(RadioButton [][Mode2]
   [   mode=2
      drawScene Level1 Level2
   ] 0 [0 320])

   cb_rings=(CheckBox [][Rings]
   [   rings=not rings
pr rings
      genRings
   ] 0 [80 300])
   CheckBoxSet cb_rings rings

   bStop=(Button [][Stop]
   [   rotateScene4::stoppingflag="stopping
      OnMouseLeftDown []
      OnMouseLeftUp []
      OnMouseMotion []
      redraw
      updateGraph
      ConsoleSetFocus
   ] 0 [0 350])

   setUpdateGraph false

   unperspective
   clearScreen
   bm=loadImage "water.jpg
   tex=Texture bm
   setFC "White
   PenUp
   for [x 0 1]
   [   for [y 0 1]
      [   setXY x*100 y*100
         fillRect [0 0][100 100]
      ]
   ]
   tex=(Array texxmax 0)
   repeat texxmax
   [   i=repcount-1
      setXY 0 i
      tex.i=Texture BitCopy 100 100
   ]

   clearScreen
   perspective
   hideTurtle
   genRings

   setEye {0 0 500}{0 0 0}{0 1 0}
   drawScene Level1 Level2

;   rotatescene
   rotatescene4
   erase [[][s s2 srot sflow rb1 rb2 cb_rings bStop]]
   redraw
   updateGraph

   be genRings
      if blocking [stop]
      blocking=true
      Cyl1=Graphic
      [   enableTexture
         setPC HSBA 120 1 1 0.4
         RingCylinder Level2*200 80 50
         PenUp
         forward Level2*200
         PenDown
         disableTexture
         setPC HSBA 120 0.2 1 0.1
         RingCylinder (1-Level2)*200 80 50
         pu back Level2*200 pd
      ]
      Cyl2=Graphic
      [   enableTexture
         setPC HSBA 240 1 1 0.4
         RingCylinder Level1*200 110 80
         PenUp
         forward Level1*200
         PenDown
         disableTexture
         setPC HSBA 240 0.2 1 0.1
         RingCylinder (1-Level1)*200 110 80
         pu back Level1*200 pd
      ]
      blocking=false
   end

   be RingCylinder l ra ri
      if l == 0 [stop]
      Cylinder l ra
      if rings == true
      [   ;disableTexture
         down 90
         PenDown
         Tesselation
         [   Circle ra
            TessContour
            Circle ri
         ]
         up 90
         PenUp forward l PenDown
         down 90
         Tesselation
         [   Circle ra
            TessContour
            Circle ri
         ]
         up 90
         PenUp back l PenDown
      ]
   end

   be drawScene L1 L2
      clearScreen
      setPC "black
      axes

      disableLighting
      disableDepthTest

      Texture tex.Int texx2
      drawGraphic Cyl1
      drawGraphic Cyl2

      enableLighting
      enableDepthTest
      Texture tex.Int texx
      enableTexture
      setPC HSBA 0 1 1 1
      Cylinder 200 50

      if mode==2
      [   Texture tex.Int texx2
         drawGraphic Cyl1
         drawGraphic Cyl2
      ]
   end

   be rotateScene4 [dphi 0][singleshot false][phi 0]
      local [eye r dr ddphi theta dtheta center upvector
         p p0 phi0 theta0 x y]
      stoppingflag="running
      eye=array 3
      light=array 3
      r=500
      dr=1.1
      theta=30
      dtheta=5
      center={0 0 0}
      upvector={0 1 0}
      ddphi=dphi/3
      mouseActive=false
   ;   pr [left, right changes rotation speed, up down set pitch, ESC exits]
      dispatchMessages
      OnMouseLeftDown
      [   if not rotatescene4::mouseActive
         [   p0=MousePos
            phi0=rotatescene4::phi
            theta0=rotatescene4::theta
            mouseActive=true
         ]
      ]
      OnMouseMotion
      [   if rotateScene4::mouseActive
         [   p=MousePos-p0
            x=  ((p.1*(cos phi)-p.3*sin phi)*cos theta)
               +(p.1*(cos phi)-p.2*sin phi)*sin theta
            y=p.2
            theta=theta0-y/5
            phi=phi0-x/5
         ]
      ]
      OnMouseLeftUp
      [   p=MousePos-p0
         x=  ((p.1*(cos phi)-p.3*sin phi)*cos theta)
            +(p.1*(cos phi)-p.2*sin phi)*sin theta
         y=p.2
         theta=theta0-y/5
         phi=phi0-x/5
         rotateScene4::mouseActive=false
      ]
      forever
      [   eye.1=r*(cos theta)*sin phi
         eye.2=r* sin theta
         eye.3=r*(cos theta)*cos phi
         setEye eye center upvector
         light.1=1000*(cos 45)*sin phi+45
         light.2=1000* sin 45
         light.3=1000*(cos 45)*cos phi+45
         setLightPos light
         drawscene Level1 Level2
         redraw
         if singleshot [break]
         phi=phi+dphi
         texx=mod texx+texxd texxmax
         texx2=mod texx2+texx2d texxmax
         if key?
         [   ;dispatchMessages
            local [ch]
            ch=readChar
            ifelse ch==char 255
            [   ch=readCharExt
               if ch==WXK_RIGHT [dphi=dphi+ddphi]
               if ch==WXK_LEFT  [dphi=dphi-ddphi]
               if ch==WXK_UP    [theta=theta+dtheta]
               if ch==WXK_DOWN  [theta=theta-dtheta]
               if ch==WXK_PRIOR [r=r/dr]
               if ch==WXK_NEXT  [r=r*dr]
            ][
               if ch==char 27
               [   OnMouseLeftDown []
                  OnMouseLeftUp []
                  OnMouseMotion []
                  stop
               ]
               if ch=="+ [r=r-dr]
               if ch=="- [r=r+dr]
            ]
         ]
         if stoppingflag=="stopping [break]
      ]
   end
end