aUCBLogo Demos and Tests / draw_medians

;draw_medians by Brian Harvey

be draw_medians [:command [repeat 4 [fd 200 rt 90]]][:num 10]
   setRedefinable true
   if not procedurep "real_fd [
     copydef "real_fd "::fd
     copydef "real_setpos "::setpos
     copydef "real_setxy "::setxy
   ]
   defineBe "draw_medians::fd [[dist] [localmake "old pos]
            [real_fd :dist]
            [push "medians median :old pos]]
   defineBe "draw_medians::forward [[dist] [localmake "old pos]
               [real_fd :dist]
               [push "medians median :old pos]]
   defineBe "draw_medians::setpos [[newpos] [localmake "old pos]
             [real_setpos :newpos]
             [push "medians median :old pos]]
   defineBe "draw_medians::setxy [[newx newy] [localmake "old pos]
               [real_setxy :newx :newy]
               [push "medians median :old pos]]
   localmake "medians []
   localmake "startpos pos
   ignore error
   catch "error :command
   err=error
   if not emptyp err
   [   print (word first butFirst err
         "\ in\  first bf bf err
         "( first bf bf bf bf err "))
   ]
   if equalp pos :startpos [push "medians last :medians]
   if emptyp error [catch "error [median_trace :num reverse :medians]]
   copydef "fd "real_fd
   copydef "forward "real_fd
   copydef "setpos "real_setpos
   copydef "setxy "real_setxy
   erase [real_fd real_forward real_setpos real_setxy]
   setRedefinable false

   be median :pos1 :pos2
      output list
         ((first :pos1)+(first :pos2))/2
         (( last :pos1)+( last :pos2))/2
   end

   be median_trace :num :positions
      if :num==0 [stop]
      pu setpos first :positions
      localmake "medians []
      localmake "startpos pos
      pd foreach bf :positions [setpos ?]
      if equalp pos :startpos [push "medians last :medians]
      median_trace :num-1 reverse :medians
   end
end