home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / demo / X11 / logo / EXAMPLES.LOGO next >
Encoding:
Text File  |  1994-09-27  |  1.2 KB  |  71 lines  |  [TEXT/ttxt]
  1. (to nth :index :lst
  2.   (if (equal :index 1)
  3.      then (first :lst)
  4.      else (nth (difference :index 1) (butfirst :lst))))
  5.  
  6. (to makelist :begin :end
  7.   (fput :begin (if (equal :begin :end)
  8.                    then [[]]
  9.                    else (makelist (sum :begin 1) :end))))
  10.  
  11. (to wheel :centerright
  12.   [(hideturtle)
  13.    (pendown)
  14.    (setangle 90)
  15.    (setxy :centerright 350)
  16.    (repeat 72 times
  17.      [(forward 2)
  18.       (left 5)])])
  19.  
  20. (to car 
  21.   [(pendown)
  22.    (hideturtle)
  23.    (setxy 400 350)
  24.    (setangle 90)
  25.    (forward 70)
  26.    (left 90)
  27.    (forward 100)
  28.    (right 60)
  29.    (forward 80)
  30.    (left 60)
  31.    (forward 100)
  32.    (left 60)
  33.    (forward 80)
  34.    (right 60)
  35.    (forward 70)
  36.    (left 90)
  37.    (forward 70)
  38.    (left 90)
  39.    (forward 350)
  40.    (wheel 350)
  41.    (wheel 150)])
  42.  
  43. (to docar?
  44.   [(local "ans)
  45.    (print [do you want a car?])
  46.    (make "ans (read))
  47.    (if (equal (first ans) "yes)
  48.       then (car)
  49.       else [[oh well]])])
  50.  
  51. (to poly :size :angles
  52.     [(hideturtle)
  53.      (pendown)
  54.      (setangle 90)
  55.      (repeat :angles times
  56.              [(forward :size)
  57.               (right (div 360 :angles))])])
  58.  
  59. (make "x (makelist 3 12))
  60.  
  61. (while (less (first x) 12)
  62.  [(make "x (butfirst x))
  63.   (print x)])
  64.  
  65. (clean)
  66.  
  67. (car)
  68.  
  69. (poly 100 5)
  70.  
  71.