-----------------------------

to main ; Gym
3d_frame
setpc 6 draw 12
end

to draw :s
sp -:s  4*:s sqr 2*:s ; head
sp   0  4*:s bk :s    ; neck
sp -2*:s -:s sqr 4*:s ; body
sp   -:s -:s bk 4*:s  ; lleg
sp    :s -:s bk 4*:s  ; rleg
repeat 7[px exersice ppt]
relax
end

to sqr :size
repeat 4[fd :size rt 90]
end

to exersice
lift wait 40 lift
side wait 40 side
end

to lift
sp -2*:s 3*:s setx -6*:s
sp  2*:s 3*:s setx  6*:s
end

to side
sp -2*:s 3*:s fd 5*:s
sp  2*:s 3*:s fd 5*:s
end

to relax
setpc 7
sph -2*:s 3*:s -120 fd 3*:s lt 120 fd 3*:s
sph  2*:s 3*:s  120 fd 3*:s rt 120 fd 3*:s
end

to procs
ed[main draw sqr exersice lift side relax procs]
end
-----------------------------

to main ; Clock
3d_frame
face
draw_hands
settimer 1 200[loop]
end

to face
setpensize[4 4] setpc 1 pu
for[tick 1 12][fd 80 pd fd 10 pu bk 90 rt 30]
end

to draw_hands
setpensize[4 4] setpc 4        ;                     hours hand
sph 0 0 hur*30+min/2+sec/120 bk 10 fd 60 make "hur_head heading
setpensize[2 2] setpc 4        ;                   minutes hand
sph 0 0 min*6+sec/10 bk 10 fd 85 make "min_head heading
setpensize[1 1] setpc 6        ;                   seconds hand
sph 0 0 sec*6 fd 65 make "sec_head heading
end

to loop
if not equalp :now last item 4 time~
   [erase_hands draw_hands]
end

to erase_hands
setpc 0 setpensize[5 5]
sph 0 0 :hur_head bk 10 fd 60  ;                    hours hand
sph 0 0 :min_head bk 10 fd 85  ;                  minutes hand
sph 0 0 :sec_head fd 65        ;                  seconds hand
end

to hur                         ;   extract the hours from TIME
op remainder word first item 4 time first bf item 4 time 12
end


to min                         ; extract the minutes from TIME
op word item 4 item 4 time item 5 item 4 time
end

to sec                         ; extract the seconds from TIME
make "now last item 4 time
op word last bl item 4 time last item 4 time
end

to procs
ed[main face draw_hands loop erase_hands hur min sec procs]
end
------------------------------

to main ; Xmas Tree
3d_frame
sph 0 -92 0 tree 62 6 80
end

to tree :size :level :ang
if :level<1[setpc 4 circle 3 setpc 6 circle 2 setpc 10 stop]
setpensize se :level :level fd :size
lt :ang tree .5*:size :level-1 :ang-12
rt :ang tree .7*:size :level-1 :ang-12
rt :ang tree .5*:size :level-1 :ang-12
lt :ang
setpensize se :level :level bk :size
end

to procs
ed[main tree procs]
end
------------------------------