← Back to branch summary

~ubuntu-branches/ubuntu/hardy/ocaml-doc/hardy

« back to all changes in this revision

Viewing changes to examples/spirals/spir.ml

  • Committer: Bazaar Package Importer
  • Author(s): Samuel Mimram
  • Date: 2007-09-08 01:49:22 UTC
  • mfrom: (0.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070908014922-lvihyehz0ndq7suu
Tags: 3.10-1
* New upstream release.
* Removed camlp4 documentation since it is not up-to-date.
* Updated to standards version 3.7.2, no changes needed.
* Updated my email address.

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/spirals/spir.ml
1
 
(***********************************************************************)
2
 
(*                                                                     *)
3
 
(*                           Objective Caml                            *)
4
 
(*                                                                     *)
5
 
(*               Pierre Weis, projet Cristal, INRIA Rocquencourt       *)
6
 
(*                                                                     *)
7
 
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
8
 
(*  en Automatique.  All rights reserved.  This file is distributed    *)
9
 
(*  only by permission.                                                *)
10
 
(*                                                                     *)
11
 
(***********************************************************************)
12
 
open Graphics;;
13
 
 
14
 
(* Simple turtle graphics *)
15
 
 
16
 
type turtle_state =
17
 
  { mutable x : float;
18
 
    mutable y : float;
19
 
    mutable heading : float };;
20
 
 
21
 
let t = { x = 0.0; y = 0.0; heading = 0.0 };;
22
 
 
23
 
let pi180 = 4.0 *. atan 1.0 /. 180.0;;
24
 
 
25
 
let round x =
26
 
  if x >= 0.0 then int_of_float(x +. 0.5) else -(int_of_float(0.5 -. x));;
27
 
 
28
 
let reset() =
29
 
  t.x <- float_of_int(size_x() / 2);
30
 
  t.y <- float_of_int(size_y() / 2);
31
 
  t.heading <- 0.0;
32
 
  moveto (round t.x) (round t.y)
33
 
;;
34
 
 
35
 
let forward d =
36
 
  t.x <- t.x +. cos(t.heading) *. d;
37
 
  t.y <- t.y +. sin(t.heading) *. d;
38
 
  lineto (round t.x) (round t.y)
39
 
;;
40
 
 
41
 
let turn a =
42
 
  t.heading <- t.heading +. a *. pi180
43
 
;;
44
 
 
45
 
(* A table of flashy colors *)
46
 
 
47
 
let colors =
48
 
  [| 0xff0000; 0xff6000; 0xffc000; 0xdeff00;
49
 
     0x7eff00; 0x1eff00; 0x1eff00; 0x00ff42;
50
 
     0x00ffa2; 0x00fcff; 0x009cff; 0x003cff;
51
 
     0x2400ff; 0x8400ff; 0xe400ff; 0xff00ba |];;
52
 
 
53
 
(* The main drawing function *)
54
 
 
55
 
let rec spir dist angle angle_incr color =
56
 
  if key_pressed() then () else begin
57
 
    set_color colors.(color);
58
 
    forward dist;
59
 
    turn angle;
60
 
    spir dist (angle +. angle_incr) angle_incr ((color + 1) land 15)
61
 
  end
62
 
;;
63
 
  
64
 
(* The interaction loop *)
65
 
 
66
 
let message s =
67
 
  let (x, y) = current_point() in
68
 
  draw_string s;
69
 
  let (_, height) = text_size s in
70
 
  moveto x (y + height)
71
 
;;
72
 
 
73
 
let format f =
74
 
  Printf.sprintf "%6.2f" f
75
 
;;
76
 
 
77
 
let rec loop dist angle_incr =
78
 
  clear_graph();
79
 
  set_color foreground;
80
 
  moveto 0 0;
81
 
  message "   -           d, D             to decrease";
82
 
  message "   +           i, I             to increase";
83
 
  message (format dist ^ "      " ^ format angle_incr);
84
 
  message "Distance    Angle increment     'q' to quit";
85
 
  reset();
86
 
  spir dist 0.0 angle_incr 0;
87
 
  match read_key() with
88
 
  | '-' -> loop (dist -. 2.0) angle_incr
89
 
  | '+' -> loop (dist +. 2.0) angle_incr
90
 
  | 'd' -> loop dist (angle_incr -. 0.05)
91
 
  | 'D' -> loop dist (angle_incr -. 5.0)
92
 
  | 'i' -> loop dist (angle_incr +. 0.05)
93
 
  | 'I' -> loop dist (angle_incr +. 5.0)
94
 
  | 'q' -> ()
95
 
  | _ -> loop dist angle_incr
96
 
;;
97
 
 
98
 
let spir () =
99
 
  open_graph "";
100
 
  loop 5.0 1.9;
101
 
  close_graph()
102
 
;;
103
 
 
104
 
if !Sys.interactive then () else begin spir(); exit 0 end;;