From 43d1f51f2b3c8966a6cd4f8a2419d9bd37d77664 Mon Sep 17 00:00:00 2001
From: malc <av1474@comtv.ru>
Date: Tue, 11 Nov 2008 01:34:15 +0300
Subject: [PATCH] Sell soul to the devil

---
 nmo.ml  |  61 +++++++++++++++++----------------
 rend.ml |  43 ++++++++++-------------
 skb.ml  | 119 ++++++++++++++++++++++++++++++----------------------------------
 3 files changed, 104 insertions(+), 119 deletions(-)

diff --git a/nmo.ml b/nmo.ml
index 0cb6e8c..a0fc197 100644
--- a/nmo.ml
+++ b/nmo.ml
@@ -448,37 +448,38 @@ let draw geom =
     );
 ;;
 
-let func geom =
+let obj geom =
   let draw = draw geom in
   let onoff c s b = c, "toggle " ^ s, if b then "on" else "off" in
-  let rec subfunc dodraw ~textures ~lighting ~solid ~colormaterial =
-    let f
-        ?(textures=textures)
-        ?(lighting=lighting)
-        ?(solid=solid)
-        ?(colormaterial=colormaterial) dodraw =
-      let hf () =
-        [onoff "t""textures" textures
-        ;onoff "l" "lighting" lighting
-        ;onoff "w" "wireframe" (not solid)
-        ;onoff "c" "color material" colormaterial
-        ;onoff "m" "model" dodraw
-        ]
-      in
-      Rend.Func (subfunc dodraw ~textures ~lighting ~solid ~colormaterial, hf)
-    in
-    function
-      | Rend.Char 't' -> f ~textures:(not textures) dodraw
-      | Rend.Char 'l' -> f ~lighting:(not lighting) dodraw
-      | Rend.Char 'w' -> f ~solid:(not solid) dodraw
-      | Rend.Char 'c' -> f ~colormaterial:(not colormaterial) dodraw
-      | Rend.Char 'm' -> f (not dodraw)
-      | Rend.Draw when dodraw ->
-          draw ~textures ~lighting ~solid ~colormaterial ();
-          f dodraw
-      | Rend.Char _ | Rend.Draw -> f dodraw
-  in
-  subfunc true ~textures:false ~lighting:false ~solid:true ~colormaterial:false
+  (object (self)
+    val dodraw = true
+    val textures = false
+    val lighting = false
+    val solid = true
+    val colormaterial = false
+
+    method help =
+      [onoff "t""textures" textures
+      ;onoff "l" "lighting" lighting
+      ;onoff "w" "wireframe" (not solid)
+      ;onoff "c" "color material" colormaterial
+      ;onoff "m" "model" dodraw
+      ]
+
+    method draw =
+      if dodraw
+      then
+        draw ~textures ~lighting ~solid ~colormaterial ()
+
+    method char c =
+      match c with
+      | 't' -> {< textures = not textures >}
+      | 'l' -> {< lighting = not lighting >}
+      | 'w' -> {< solid = not solid >}
+      | 'c' -> {< colormaterial = not colormaterial >}
+      | 'm' -> {< dodraw = not dodraw >}
+      | _ -> self
+  end)
 ;;
 
 let _ =
@@ -509,7 +510,7 @@ let _ =
     f (x, x, y, y, z, z) 3
   in
   Skb.main name;
-  Rend.add_func (func geom);
+  Rend.add_obj (obj geom);
   Rend.init minmax;
   Rend.main ()
 ;;
diff --git a/rend.ml b/rend.ml
index 4fb0665..91e2498 100644
--- a/rend.ml
+++ b/rend.ml
@@ -1,7 +1,8 @@
-type cmd = | Char of char | Draw;;
-type func = cmd -> func_ret
-and helpfunc = (unit -> (string * string * string) list)
-and func_ret = Func of (func * helpfunc)
+class type draw = object
+  method draw: unit
+  method char: char -> draw
+  method help: (string * string * string) list
+end;;
 
 let nmo_name = ref None
 let anb_names = ref []
@@ -18,8 +19,7 @@ type view =
     ; mutable zoom : float
     ; mutable center : (float * float * float)
     ; mutable radial_scale : float
-    ; mutable func : func list
-    ; mutable helpfunc : helpfunc list
+    ; mutable objs : draw list
     ; mutable persp : bool
     ; mutable last_time : float
     ; mutable animated : bool
@@ -44,8 +44,7 @@ let view =
   ; center = (0.0, 0.0, 0.0)
   ; radial_scale = 0.0
   ; zoom = 1.0
-  ; func = []
-  ; helpfunc = []
+  ; objs = []
   ; persp = true
   ; last_time = 0.0
   ; animated = false
@@ -148,7 +147,7 @@ let help () =
     ]
   in
   let help =
-    List.fold_left (fun accu hf -> accu @ hf ()) help view.helpfunc
+    List.fold_left (fun accu draw -> accu @ draw#help) help view.objs
   in
   loop 1
     (help @
@@ -190,7 +189,7 @@ let display () =
     GlMat.pop ();
   );
 
-  List.iter (fun f -> ignore (f Draw)) view.func;
+  List.iter (fun draw -> draw#draw) view.objs;
   if view.help then help ();
   Glut.swapBuffers ();
 
@@ -269,15 +268,9 @@ let reshape ~w ~h =
   setup w h;
 ;;
 
-let allfunc cmd =
-  let f, h =
-    List.split (
-      List.map (fun f -> let Func (fr, hf) = f cmd in fr, hf) view.func
-    )
-  in
-  view.func <- f;
-  view.helpfunc <-h;
-;;
+let mchar c draw = draw#char c;;
+let mdraw draw = draw#draw; draw;;
+let allfunc f = view.objs <- List.map f view.objs;;
 
 let idle () =
   let deadline = view.last_time +. 0.04 in
@@ -289,7 +282,7 @@ let idle () =
   else
     view.last_time <- view.last_time +. 0.04
   ;
-  allfunc (Char 'n');
+  allfunc (mchar 'n');
   Glut.postRedisplay ();
 ;;
 
@@ -315,7 +308,7 @@ let keyboard ~key ~x ~y =
         last_time <- Unix.gettimeofday ();
         Glut.idleFunc (Some idle)
       )
-  | 'f' | 'b' when not view.animated -> allfunc (Char (Char.chr key))
+  | ('f' | 'b') as c when not view.animated -> allfunc (mchar c);
   | '<' -> view.alpha <- max (view.alpha -. 0.01) 0.0;
   | '>' -> view.alpha <- min (view.alpha +. 0.01) 1.0;
   | '[' -> slerp_step := max (!slerp_step -. 0.1) 0.0;
@@ -324,7 +317,7 @@ let keyboard ~key ~x ~y =
   | '4' -> view.ambient <- view.ambient +. 0.1;
   | '5' -> view.diffuse <- view.diffuse -. 0.1;
   | '6' -> view.diffuse <- view.diffuse +. 0.1;
-  | c -> allfunc (Char c)
+  | c -> allfunc (mchar c)
   end;
   setup view.w view.h;
   Glut.postRedisplay ();
@@ -408,13 +401,13 @@ let main () =
   let () = Glut.specialFunc special in
   let () = Glut.mouseFunc mouse in
   let () = Glut.motionFunc motion in
-  allfunc (Char '\000');
+  allfunc (mchar '\000');
   let () = Glut.mainLoop () in
   ()
 ;;
 
-let add_func func =
-  view.func <- func :: view.func;
+let add_obj draw =
+  view.objs <- draw :: view.objs;
 ;;
 
 let init minmax =
diff --git a/skb.ml b/skb.ml
index 2e80e0c..1146b0d 100644
--- a/skb.ml
+++ b/skb.ml
@@ -97,7 +97,7 @@ let animate quats =
   Skin.anim ();
 ;;
 
-let func bones anim =
+let obj bones anim =
   let posecount, rotations = anim in
   let clip poseno =
     let poseno' = poseno mod posecount in
@@ -110,57 +110,56 @@ let func bones anim =
     | _ -> draw ~dsphere:true bones quats ()
   in
   let skbquats = skbquats bones in
-  let rec subfunc drawindex quats sposeno dposeno t dir =
-    let subf
-        ?(drawindex=drawindex)
-        ?(sposeno=sposeno)
-        ?(dposeno=dposeno)
-        ?(t=t)
-        ?(quats=quats)
-        ?(dir=dir) () =
-      let drawindex = drawindex mod 3 in
-      let hf () =
-        [("s", "toggle skeleton (S type)",
-         if drawindex = 0 then "off" else string_of_int drawindex)
-        ;"B", sprintf "toggle animation direction", string_of_int dir
-        ;"f", "forward one frame", sprintf "%d, %f" sposeno t
-        ;"b", "backward one frame", sprintf "%d, %f" sposeno t
-        ;"", "", "total frames " ^ string_of_int posecount
-        ;"r", "go to bind pose", ""
-        ;"1,2", "go to first/last frame", ""
-        ]
-      in
-      Rend.Func (subfunc drawindex quats sposeno dposeno t dir, hf)
-    in
-    let advance quats dir =
+  (object (self)
+    val drawindex = 0
+    val sposeno = 0
+    val dposeno = clip 1
+    val quats = skbquats
+    val t = 0.0
+    val dir = 1
+
+    method private advance quats dir =
       let t = t +. !Rend.slerp_step in
       if t >= 1.0
       then
         let sposeno = dposeno
         and dposeno = clip (dposeno + dir) in
-        subf ~quats ~sposeno ~dposeno ~t:0.0 ()
+        {< quats = quats; sposeno = sposeno; dposeno = dposeno; t = 0.0 >}
       else
-        subf ~quats ~sposeno ~dposeno ~t ()
-    in
-    function
-      | Rend.Char ('n' | 'f' | 'b' as c) ->
+        {< quats = quats; sposeno = sposeno; dposeno = dposeno; t = 0.0 >}
+
+    method help =
+      [("s", "toggle skeleton (S type)",
+       if drawindex = 0 then "off" else string_of_int drawindex)
+      ;"B", sprintf "toggle animation direction", string_of_int dir
+      ;"f", "forward one frame", sprintf "%d, %f" sposeno t
+      ;"b", "backward one frame", sprintf "%d, %f" sposeno t
+      ;"", "", "total frames " ^ string_of_int posecount
+      ;"r", "go to bind pose", ""
+      ;"1,2", "go to first/last frame", ""
+      ]
+
+    method draw = skeldraw drawindex quats
+
+    method char c =
+      match c with
+      | 'n' | 'f' | 'b' ->
           let quats = Anb.interpolated rotations sposeno dposeno t in
           animate quats;
-          advance quats
+          self#advance quats
             (match c with
             | 'n' -> dir
             | 'f' -> 1
             | _ -> -1)
 
-      | Rend.Char 'B' ->
-          subf ~dir:~-dir ()
+      | 'B' -> {< dir = -dir >}
 
-      | Rend.Char 'r' ->
+      | 'r' ->
           Skin.set_anim skbquats;
           Skin.anim ();
-          subf ~drawindex:1 ~quats:skbquats ()
+          {< drawindex = 1; quats = skbquats >}
 
-      | Rend.Char ('1' | '2' as c) ->
+      | '1' | '2' ->
           let sposeno, dposeno =
             if c = '1'
             then 0, clip 1
@@ -169,35 +168,23 @@ let func bones anim =
           let quats = Anb.exact rotations sposeno in
           animate quats;
           let t = if dir > 0 then 1.0 else 0.0 in
-          subf ~quats ~sposeno ~dposeno ~t ~dir ()
-
-      | Rend.Char 's' ->
-          subf ~drawindex:(drawindex lxor 1) ()
-
-      | Rend.Char 'S' ->
-          subf ~drawindex:(drawindex + 1) ()
+          {< quats = quats; sposeno = sposeno; dposeno = dposeno; t = t >}
 
-      | Rend.Draw ->
-          skeldraw drawindex quats;
-          subf ()
-
-      | _ ->
-          subf ()
-  in
-  subfunc 0 skbquats 0 (clip 1) 0.0 1
+      | 's' -> {< drawindex = drawindex lxor 1 >}
+      | 'S' -> {< drawindex = (drawindex + 1) mod 3 >}
+      | _ -> self
+  end)
 ;;
 
 let dummy draw =
-  let rec subfunc dodraw =
-    let hf () =
-      ["s", "toggle skeleton", if dodraw then "on" else "off"]
-    in
-    function
-      | Rend.Draw -> if dodraw then draw (); Rend.Func (subfunc dodraw, hf)
-      | Rend.Char 's' -> Rend.Func (subfunc (not dodraw), hf)
-      | _ -> Rend.Func (subfunc dodraw, hf)
-  in
-  subfunc false
+  (object (self)
+    val dodraw = false
+
+    method help = ["s", "toggle skeleton", if dodraw then "on" else "off"]
+    method draw = if dodraw then draw ()
+    method char c =
+      if c = 's' then {< dodraw = not dodraw >} else self
+  end)
 ;;
 
 let skin bones =
@@ -209,7 +196,7 @@ let skin bones =
 ;;
 
 let main name =
-  let func =
+  let obj =
     try
       let name =
         match !Rend.skb_name with
@@ -234,11 +221,15 @@ let main name =
               (fun accu name -> Anb.append accu (ranb name)) (ranb hd) tl
           in
           skin bones;
-          func bones anim;
+          obj bones anim;
       end;
     with exn ->
       prerr_endline (Printexc.to_string exn);
-      let rec f _ = Rend.Func (f, (fun () -> [])) in f
+      (object (self)
+        method help = []
+        method draw = ()
+        method char _ = self
+      end)
   in
-  Rend.add_func func
+  Rend.add_obj obj
 ;;
-- 
2.11.4.GIT