[Add program examples
kztk@kb.ecei.tohoku.ac.jp**20100915155559
 Ignore-this: b3b151ebb644e715a53e7830a315c20b
] adddir ./example_programs
addfile ./example_programs/falling.ml
hunk ./example_programs/falling.ml 1
+open Graphics
+
+type vec = { x : float; y : float }
+type obj = { pos : vec; vel : vec; col : color }
+
+let gravity = 100.
+
+let maxX = 300.
+let minX = 0.
+
+let eps    = 0.000001
+let radius = 10.0
+
+let margin = eps +. radius 
+
+let one_step objs tm = 
+  let f obj = 
+    let tmp = { obj with 
+		  pos = {  x = obj.pos.x +. tm *. obj.vel.x;
+			   y = obj.pos.y +. tm *. obj.vel.y};
+		  vel = { obj.vel with y = 0.9999 *. obj.vel.y -. tm *. gravity } } in 
+    let vel = 
+      if tmp.pos.x <= minX +. margin && tmp.vel.x <= eps then 
+	{ tmp.vel with x = -. tmp.vel.x } 
+      else if tmp.pos.x >= maxX -. margin && tmp.vel.x >= eps then 
+	{ tmp.vel with x = -. tmp.vel.x } 
+      else 
+	tmp.vel 
+    in 
+    let vel =
+      if tmp.pos.y <= margin && vel.y <= eps then 
+	{ vel with y = -. vel.y} 
+      else 
+	vel in 
+      { tmp with vel = vel } in 
+    List.map f objs 
+
+let draw_obj obj =
+  let x = int_of_float obj.pos.x in 
+  let y = int_of_float obj.pos.y in 
+  let c = obj.col in 
+    (set_color c;
+     fill_circle x y (int_of_float radius))
+
+let _ = Random.self_init ()
+
+let rand_ball () = 
+  { pos = {x = Random.float maxX; y = 150. +. Random.float 150.};
+    vel = {x = -. 20. +. Random.float 40.; y = 0. };
+    col = Random.int 0xffffff }
+
+let rec upto n = 
+  if n < 0 then []
+  else n::upto (n-1)
+
+let balls = List.map (fun _ -> rand_ball ()) (upto 20)
+
+(* Unix.select [] [] [] b の代用 *)
+let rec busy_wait b =
+  let start = Sys.time () in 
+  let rec f () = 
+    if Sys.time () -. start > b then 
+      ()
+    else 
+      f () in 
+    f ()
+
+let rec loop prevTime balls = 
+  begin 
+    let cur   = Sys.time () in 
+    let diff  = cur -. prevTime in 
+    let balls = one_step balls diff in 
+      clear_graph ();
+      List.map draw_obj balls;      
+      synchronize ();
+      (* Unix.system ("sleep 0.01"); *)
+      busy_wait 0.032; 
+      loop cur balls
+  end 
+
+
+let start () =
+  clear_graph ();
+  auto_synchronize false;
+  loop (Sys.time()) balls 
addfile ./example_programs/koch.ml
hunk ./example_programs/koch.ml 1
+open Graphics
+
+let add_point (x,y) (xx,yy) = (x+.xx,y+.yy)
+
+let dr = (60. /. 180.) *. 3.141592653589793 (* 60 degrees *)
+
+let next_pos p dir len = 
+  add_point p (len *. cos dir, len *. sin dir)
+
+let linetoF (x1,y1) (x2,y2) =
+  (moveto (int_of_float x1) (int_of_float y1);
+   lineto (int_of_float x2) (int_of_float y2))
+
+let rec kochWork p dir len depth = 
+  if depth <= 0 then 
+    linetoF p (next_pos p dir len) 
+  else
+    let l3  = len /. 3. in 
+    let mp1 = next_pos p   dir         l3 in 
+    let mp2 = next_pos mp1 (dir +. dr) l3 in 
+    let mp3 = next_pos mp2 (dir -. dr) l3 in 
+      kochWork p   dir         l3 (depth-1);
+      kochWork mp1 (dir +. dr) l3 (depth-1);
+      kochWork mp2 (dir -. dr) l3 (depth-1);
+      kochWork mp3 dir         l3 (depth-1)
+
+let koch x y len d = 
+  kochWork (float_of_int x,float_of_int y)  0. (float_of_int len) d
+  
+let koch_snowflake x y len d =
+  let fx = float_of_int x in 
+  let fy = float_of_int y in
+  let fl = float_of_int len in 
+    kochWork (fx,    fy)                            0.           fl d;
+    kochWork (fx+.fl,fy)                            (-2.0 *. dr) fl d;
+    kochWork (fx+.fl *.cos dr, fy -. fl *. sin dr)  (-4.0 *. dr) fl d
+  
+
+let _ = begin
+  try 
+    open_graph "";
+    set_window_title "Koch";
+    resize_window 300 300;   
+    koch_snowflake 30 220 240 5
+  with _ -> 
+    clear_graph ();
+    koch_snowflake 30 220 240 5
+end 
+    
addfile ./example_programs/takagi.ml
hunk ./example_programs/takagi.ml 1
+open Graphics
+
+let rec ilog n = 
+  if n > 1 then 
+    1 + ilog (n/2) 
+  else 
+    1
+
+let takagi x y length = 
+  let rec takagiWork x y1 y2 len depth =
+    if depth < 0 || (len <= 1.) then 
+      (moveto (int_of_float x) (int_of_float y1);
+       lineto (int_of_float (x+.len)) (int_of_float y2))
+    else 
+      let midY = (y1+.y2)/.2. +. (len/.2.) in 
+	takagiWork x             y1   midY (len/.2.) (depth-1);
+	takagiWork (x+.len/.2.)  midY y2   (len/.2.) (depth-1) in 
+    takagiWork 
+      (float_of_int x) (float_of_int y) (float_of_int y) (float_of_int length) 
+      (ilog length)
+
+let _ = begin
+  try 
+    open_graph "";
+    set_window_title "Takagi";
+    resize_window 400 400;
+    takagi 10 10 380
+  with _ ->
+    clear_graph ();
+    takagi 10 10 380
+end
+
+  
+
+  
+