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 600scc
      
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 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 [size 1][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 2rt 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+scrolledXdifferentStones)
      
fd stonesize
   
]
end