aUCBLogo Demos and Tests / 3dwalk

be 3dwalk
   perspective
   enableCylinderLines
   ht setUpdateGraph false
   skincolor=hsb 20 .3 .9
   brown=hsb 0 .5 .3
   red=hsb 0 1 1
   darkred=hsb 0 1 .8
   blue=hsb 240 1 1
   darkblue=hsb 240 1 .8
   white=hsb 0 0 1
   black=hsb 0 0 0

   r=500
   dr=1.1
   nphi=30
   enphi=400
   singleshot=Name? "framenr
   ifelse singleshot [phi=framenr*5 i=framenr*3][phi=0 i=0]
   dphi=1
   ddphi=dphi/3
   theta=30
   dtheta=5
   eye=array 3
   pr [+ - changes walk speed, * / rotation speed, ESC exits]
   t=timefine
   forever
   [   cs
      phi=phi+dphi
      eye.1=r*(cos theta)*sin phi
      eye.2=r* sin theta
      eye.3=r*(cos theta)*cos phi
      setEye eye {0 0 0}{0 1 0}
      setLightPos {100 100 0}

      x=250*i/nphi
      a=abs sin 2*pi*i/nphi
      (draw_walker i  5 x a nphi)
      pu home setpos [0 -200]  seth 90 setpc 0
      label list "fps i/(timefine-t)
      if singleshot [break]
      i=i+1
      updateGraph
      if key?
      [   dispatchMessages
         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=="+ [nphi=nphi/1.2]
            if ch=="- [nphi=nphi*1.2]
            if ch=="* [dphi=dphi+ddphi]
            if ch=="/ [dphi=dphi-ddphi]
            if ch==char 27 [stop]
         ]
      ]
   ]

   be draw_walker i [size 1][x 0][angle 1][nphi 30]
      local [w phi phi2 phi3 phiy]
      w=i*360/nphi
      phi=80*angle*sin w
      phi3=120*angle*sqr sin w/2
      phi2=120*angle*sqr cos w/2
      phiy=60*angle*sin 45+2*w

      pu _setpos (list (7-phiy/20)*size (40+phiy/10)*size)   pd

      draw_head
      draw_hair
      draw_nose
      draw_eyes
      draw_chin
      draw_mouth
      draw_neck

      setpc darkred
      setpensize [8 8]*size
      setz zcor-10*size pd
      draw_arm phi
      pu setz zcor+10*size pd
      armpos=pos

      setheading 180
      setpensize [15 15]*size
      setpc red
      fd 20*size

      draw_feet

      setheading 180
      pu setpos armpos pd
      setpc darkred
      setpensize [8 8]*size
      setz zcor+10*size pd
      draw_arm -phi
      pu setz zcor-10*size pd

      be draw_head
         setpc skincolor
         setfc skincolor
         fillcircle 7*size
      end

      be draw_hair
         setpensize [8 8]*size
         setHeading -140
         setpc brown
         arc 190 9*size
         setHeading -140
         arc 120 3*size
      end

      be draw_nose
         setheading 100
         setpc skincolor
         setpensize [4 4]*size
         pu fd 8*size pd fd 2*size pu back 10*size pd
      end

      be draw_eyes
         setheading 90
         setpc white
         setpensize [3 3]*size
         pu fd 5*size
         setz zcor-3*size
         pd fd 0.2*size
         setpensize [2 2]*size
         setpc black
         fd 1.1*size
         setpc white
         setpensize [3 3]*size
         pu back 1.3*size
         setz zcor+6*size
         pd fd 0.2*size
         setpensize [2 2]*size
         setpc black
         fd 1.1*size
         pu setz zcor-3*size
         back 5.3*size pd
      end

      be draw_chin
         setheading 140
         setpc skincolor
         setpensize [9 9]*size
         pu fd 5*size pd fd 2*size pu back 7*size pd
      end

      be draw_mouth
         opos=pos
         setheading 126
         setpc red
         setpensize [1.5 1.5]*size
         pu fd 8*size left 20 pd fd 2*size
         pu setpos opos pd
      end

      be draw_neck
         setheading 180
         setpensize [8 8]*size
         setpc skincolor
         pu fd 7*size pd
         fd 8*size
      end

      be draw_arm phi
         opos=pos
         setpensize [8 8]*size
         setheading 220-phi
         fd 12*size
         left 70+phi*0.7
         fd 10*size
         setpc skincolor
         setpensize [6 6]*size
         fd 4*size
         pu setpos opos pd
      end

      be draw_feet
         setpc darkblue
         pu setz zcor-5*size pd
         draw_foot phi phi2
         setpc blue
         pu setz zcor+10*size pd
         draw_foot -phi phi3
         pu setz zcor-5*size pd
      end

      be draw_foot phi phi2
         opos=pos
         setheading 180-phi
         setpensize [12 12]*size
         fd 15*size
         right phi2
         fd 13*size
         setpensize [6 6]*size
         fd 3*size
         left 90
         back 2*size
         setpc brown
         fd 11*size
         pu setpos opos pd
      end
   end
end