aUCBLogo Demos and Tests / scrolltest4

to scrolltest4
   norefresh
   WindowMode
   white=rgb 1 1 1
   setsc white
   cs ht
   setUpdateGraph false
   scc=scrollcal [3 0]
   init_walker
   init_stones
   init_court
   rim=[400 299]
   m=[0 0]
   scrolledX=0
   _setpos [0 0]
   walkerbg=bitCopy walker_sizex walker_sizey
   forever
   [   _setpos [0 0]
      disableBlend
      bitPaste walkerbg

      _setPos [-400 299]
      scroll [800 600] scc
      enableBlend
      m=m+abs scc
      if m.1 > stonesize
      [   m=mod m stonesize
         scrolledX=scrolledX+1
      ]
      draw_rim

      _setpos [0 0]
      walkerbg=bitCopy walker_sizex walker_sizey
      bitPaste walker.wnr
      wnr=wnr+1
      if wnr > nphi [wnr=1]

      updateGraph
      gc
      if key? [stop]
   ]
end

to init_walker
   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

   walker_sizex=150
   walker_sizey=170
   nphi=50
   walker=array nphi
   repeat nphi
   [   cs
      x=250*repcount/nphi
      (draw_walker repcount 2 x)
      pu home
      walker.repcount=bitCopy walker_sizex walker_sizey
      bitMakeTransparent walker.repcount rgb 1 1 1
;      updateGraph
      if key? [stop]
   ]
   wnr=1
end

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

   pu _setpos (list (37-phiy/20)*size (65+phiy/10)*size)   pd

   draw_head
   draw_hair
   draw_nose
   draw_eyes
   draw_chin
   draw_mouth
   draw_neck

   setpc darkred
   draw_arm phi
   armpos=pos

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

   draw_feet

   setheading 180
   pu setpos armpos pd
   setpc darkred
   draw_arm -phi
end

to draw_head
   setpc skincolor
   setfc skincolor
   fillcircle 7*size
end

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

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

to draw_eyes
   setheading 90
   setpc blue
   setpensize [3 3]*size
   pu fd 7*size pd fd 1*size pu back 8*size pd
end

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

to 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

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

to 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

to draw_feet
   setpc darkblue
   draw_foot phi phi2
   setpc blue
   draw_foot -phi phi3
end

to 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

to init_stones
   cs
   stonesize=50
   differentStones=8
   stone=Array differentStones
   repeat differentStones
   [   hue=360*repcount/differentStones
      setpc hsb hue 1 1
      setfc hsb hue 1 1
      myfrbox stonesize
      stone.repcount=bitCopy stonesize stonesize
   ]
   setpc white
   setfc white
   myfrbox stonesize
   nostone=bitCopy stonesize stonesize
end

to myfrbox size
   pu rt 45  fd size/(sqrt 2)  lt 45 pd
   (frBox size)
   pu lt 135  fd size/(sqrt 2) rt 135 pd
end

to init_court
   cs
   pu
   _setpos [-400 299]
   setheading 90
   sx=int 800/stonesize
   sy=int 600/stonesize
   stones=0
   repeat sy
   [   repeat sx
      [   bitPaste stone.(1+mod repcount differentStones)
         stones=stones+1
         fd stonesize
      ]
      bk sx*stonesize
      rt 90  fd stonesize  lt 90
   ]
end

to draw_rim
   _setPos rim-m
   setHeading 180
   repeat sy
   [   bitPaste stone.(1+mod (sx+scrolledX) differentStones)
      fd stonesize
   ]
end