home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / spirals / spir.ml < prev   
Encoding:
Text File  |  1995-06-01  |  2.1 KB  |  94 lines  |  [TEXT/MPS ]
  1. #open "graphics";;
  2.  
  3. (* Simple turtle graphics *)
  4.  
  5. type turtle_state =
  6.   { mutable x : float;
  7.     mutable y : float;
  8.     mutable heading : float };;
  9.  
  10. let t = { x = 0.0; y = 0.0; heading = 0.0 };;
  11.  
  12. let pi180 = 4.0 *. atan 1.0 /. 180.0;;
  13.  
  14. let round x =
  15.   if x >=. 0.0 then int_of_float(x +. 0.5) else -(int_of_float(0.5 -. x));;
  16.  
  17. let reset() =
  18.   t.x <- float_of_int(size_x() / 2);
  19.   t.y <- float_of_int(size_y() / 2);
  20.   t.heading <- 0.0;
  21.   moveto (round t.x) (round t.y)
  22. ;;
  23.  
  24. let forward d =
  25.   t.x <- t.x +. cos(t.heading) *. d;
  26.   t.y <- t.y +. sin(t.heading) *. d;
  27.   lineto (round t.x) (round t.y)
  28. ;;
  29.  
  30. let turn a =
  31.   t.heading <- t.heading +. a *. pi180
  32. ;;
  33.  
  34. (* A table of flashy colors *)
  35.  
  36. let colors =
  37.   [| 0xff0000; 0xff6000; 0xffc000; 0xdeff00;
  38.      0x7eff00; 0x1eff00; 0x1eff00; 0x00ff42;
  39.      0x00ffa2; 0x00fcff; 0x009cff; 0x003cff;
  40.      0x2400ff; 0x8400ff; 0xe400ff; 0xff00ba |];;
  41.  
  42. (* The main drawing function *)
  43.  
  44. let rec spir dist angle angle_incr color =
  45.   if key_pressed() then () else begin
  46.     set_color colors.(color);
  47.     forward dist;
  48.     turn angle;
  49.     spir dist (angle +. angle_incr) angle_incr ((color + 1) land 15)
  50.   end
  51. ;;
  52.   
  53. (* The interaction loop *)
  54.  
  55. let message s =
  56.   let (x, y) = current_point() in
  57.   draw_string s;
  58.   let (_, height) = text_size s in
  59.   moveto x (y + height)
  60. ;;
  61.  
  62. let format f =
  63.   format_float "%6.2f" f
  64. ;;
  65.  
  66. let rec loop dist angle_incr =
  67.   clear_graph();
  68.   set_color foreground;
  69.   moveto 0 0;
  70.   message "   -           d, D             to decrease";
  71.   message "   +           i, I             to increase";
  72.   message (format dist ^ "      " ^ format angle_incr);
  73.   message "Distance    Angle increment     'q' to quit";
  74.   reset();
  75.   spir dist 0.0 angle_incr 0;
  76.   match read_key() with
  77.     `-` -> loop (dist -. 2.0) angle_incr
  78.   | `+` -> loop (dist +. 2.0) angle_incr
  79.   | `d` -> loop dist (angle_incr -. 0.05)
  80.   | `D` -> loop dist (angle_incr -. 5.0)
  81.   | `i` -> loop dist (angle_incr +. 0.05)
  82.   | `I` -> loop dist (angle_incr +. 5.0)
  83.   | `q` -> ()
  84.   | _ -> loop dist angle_incr
  85. ;;
  86.  
  87. let spir () =
  88.   open_graph "";
  89.   loop 5.0 1.9;
  90.   close_graph()
  91. ;;
  92.  
  93. if sys__interactive then () else begin spir(); exit 0 end;;
  94.