Skeg

(*

  skeg - Sex, Kinematics, Elegance and Glory.

  Copyright (C) 2004 David Baelde and Samuel Mimram.



  This program is free software; you can redistribute it and/or modify

  it under the terms of the GNU General Public License as published by

  the Free Software Foundation; either version 2 of the License, or

  (at your option) any later version.



  This program is distributed in the hope that it will be useful,

  but WITHOUT ANY WARRANTY; without even the implied warranty of

  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

  GNU General Public License for more details.



  You should have received a copy of the GNU General Public License

  along with this program; if not, write to the Free Software

  Foundation, Inc., 59 Temple Place - Suite 330,

  Boston, MA 02111-1307, USA.

*)



(* $Id: skeg.ml,v 1.36 2004/05/14 10:22:00 dbaelde Exp $ *)

(** Main file.

@author David Baelde, Samuel Mimram *)





open GlDraw

(** Camera *)





let rx = ref 0.

let ry = ref (-.70.)

let tx = ref 0.

let ty = ref 0.

let tz = ref (-.4.)



let cam_transfo () =

  GlMat.translate3 (!tx, !ty, !tz) ;

  GlMat.rotate ~angle:!rx ~x:1. ~y:0. ~z:0. () ;

  GlMat.rotate ~angle:!ry ~x:0. ~y:1. ~z:0. ()

(** Light *)





let lx = ref 1.

let ly = ref 1.

let lz = ref 1.

let lstep = 0.5

(** Metaballs smoothness depends on the grid_step. *)



let grid_step = ref 0.18

(** Command line *)





let walk = ref true



let usage = "skeg [options] file"

let _ =

  Printf.printf "%s %s\n\n"

    ("Skeg 0.1.0 - Sex, Kinematics, Elegance and Glory.\n\n"^

     "Copyright (C) 2004 David Baelde and Samuel Mimram.\n"^

     "Compiled with OCaml") Sys.ocaml_version ;

  Arg.parse_argv (Glut.init Sys.argv)

    [

      "-W", Arg.Clear walk, "Walk mode" 

    ]

    (fun s -> ()) usage;

(** Walking skeg *)





module Walk =

struct

  let skel =

    [| [| false ; false ; true  ; false |] ;

       [| false ; false ; true  ; false |] ;

       [| true  ; true  ; false ; true  |] ;

       [| false ; false ; true  ; false |] |] 

  let pos = [| -1.,0.,-0.5 ; 1.,0.,0. ; 0.,1.,0. ; 0.,2.,0.|]

  let root = 1

  let all = skel, pos, root

  let first = 0

end

(** Skeleton initialization *)





module P =

struct

  let skel,pos,root =

    if !walk then

      Walk.all

    else

      Ik.TestLongY.all

end

module A = Ik.Acyclic(P)

module Solver = Ik.Gauss (struct let epsilon = 0.05 end) (A)



let selected =

  ref (if !walk then 1-Walk.first else 0)



let display () =

  GlClear.clear [`color; `depth] ;

  GlMat.push ();



  cam_transfo () ;



  GlLight.light 0 (`position (!lx, !ly, !lz, 1.)) ;

  GlLight.material ~face:`both (`specular (1., 1., 1., 1.0)) ;

  GlLight.material ~face:`both (`diffuse (0., 0.5, 0., 1.0)) ;

  GlLight.material ~face:`both (`shininess 100.) ;



  if !walk then begin

    begins `lines ;

    GlLight.material ~face:`both (`ambient (0.,1.,0.,1.)) ;

    vertex3 (-1.,0.,-1000.) ;

    vertex3 (-1.,0.,1000.) ;

    GlLight.material ~face:`both (`ambient (1.,0.,0.,1.)) ;

    vertex3 (1.,0.,-1000.) ;

    vertex3 (1.,0.,1000.) ;

    GlLight.material ~face:`both (`ambient (1.,1.,1.,1.)) ;

    vertex3 (1.,0.,0.) ;

    vertex3 (-1.,0.,0.) ;

    vertex3 (-1.,0.,0.) ;

    vertex3 (0.,0.,0.8) ;

    vertex3 (0.,0.,0.8) ;

    vertex3 (1.,0.,0.) ;

    ends ()

  end ;



  GlLight.material ~face:`both (`ambient (0.6, 0.6, 0.6, 1.0)) ;



  if !walk then

    Visu.visu_mb 10. (Array.mapi (fun i (x, y, z) ->

                                    (x, y, z, if i = 2 then 5. else 1.))

                        Solver.pos)

  else

    Visu.visu_mb 10. (Array.map (fun (x, y, z) -> (x, y, z, 1.)) Solver.pos) ;

  

  GlMat.pop () ;

  Glut.swapBuffers ()



let on_key ~key:k ~x:x ~y:y =

  ( match k with

      | Glut.KEY_PAGE_UP -> tz := !tz +. 0.1

      | Glut.KEY_PAGE_DOWN -> tz := !tz -. 0.1

      | Glut.KEY_UP -> rx := !rx +. 10.

      | Glut.KEY_DOWN -> rx := !rx -. 10.

      | Glut.KEY_LEFT -> ry := !ry +. 10.

      | Glut.KEY_RIGHT -> ry := !ry -. 10.

      | _ -> ()

  ) ;

  Glut.postRedisplay ()



let do_move move =

  if !A.root <> !selected then

    ( Solver.begin_move ~steps:1 move ;

      Glut.idleFunc

        (Some (fun () ->

                 if Solver.move () then

                   Glut.idleFunc None ;

                 Glut.postRedisplay ())) )

 else

   Printf.printf "Can't move the root !%!\n"



let walk_step () =

  A.init !selected ;

  selected := 1 - !selected ;

  let move = Array.make (3*(Array.length Walk.skel)) None in

    move.(0+3* !selected) <- Some 0. ;

    move.(1+3* !selected) <- Some 0. ;

    move.(2+3* !selected) <- Some 1. ;

    Solver.begin_move_precise ~steps:(-1) move ;

    Glut.idleFunc

      (Some (fun () ->

               if Solver.move () then

                 begin

                   let (x,y,z) = Solver.pos.(!selected) in

                   let xgoal = if !selected = 1 then 1. else -1. in

                     (* A correction doesn't hurt ... *)

                     move.(0+3* !selected) <- Some (xgoal-.x) ;

                     move.(1+3* !selected) <- Some (0.-.y) ;

                     move.(2+3* !selected) <- Some (0.) ;

                     move.(2+3*3) <- Some 0.5 ;

                     Solver.begin_move_precise ~steps:(-1) move ;           

                     Glut.idleFunc

                       (Some (fun () ->

                                if Solver.move () then

                                  Glut.idleFunc None

                                else

                                  Glut.postRedisplay ()))

                 end

               else

                 Glut.postRedisplay ()))



let on_kbd ~key:k ~x:x ~y:y =

  ( match k with

      | 113

      | 27 ->  exit 0

      | 105 -> lx := !lx +. lstep ; Glut.postRedisplay ()

      | 107 -> lx := !lx -. lstep ; Glut.postRedisplay ()

      | 111 -> ly := !ly +. lstep ; Glut.postRedisplay ()

      | 108 -> ly := !ly -. lstep ; Glut.postRedisplay ()

      | 112 -> lz := !lz +. lstep ; Glut.postRedisplay ()

      | 109 -> lz := !lz -. lstep ; Glut.postRedisplay ()

      | 115 ->

          grid_step := !grid_step +. 0.01; Visu.set_step_mb !grid_step ;

          Glut.postRedisplay ()

      | 122 ->

          grid_step := !grid_step -. 0.01; Visu.set_step_mb !grid_step ;

          Glut.postRedisplay ()

      | 32 when !walk -> walk_step ()

      | _ -> Printf.printf "Unknown key pressed: %d\n%!" k )





let on_mouse ~button:btn ~state:state ~x:x ~y:y =

  if btn = Glut.LEFT_BUTTON && state = Glut.DOWN then

    let x, y =

      float_of_int x, float_of_int ((Glut.get Glut.WINDOW_WIDTH) - y - 1)

    in

    let p0, p1 =

      GlMat.push ();

      cam_transfo () ;

      (* Positions in z = 0. and in z = 1. *)

      let p0, p1 =

        GluMat.unproject (x, y, 0.),

        GluMat.unproject (x, y, 1.) in

        GlMat.pop (); p0, p1

    in

    let pv = Vect.normalize (Vect.sub p1 p0) in

      selected :=

      (

        let mi = ref (-1) in

        let md = ref infinity in

          for i = 0 to ((Array.length Solver.pos) - 1)

          do

            let md' = Vect.dist_from_point p0 pv Solver.pos.(i) in

              if md' < !md then

                (

                  mi := i;

                  md := md'

                )

          done; !mi

      ) ;

      let sx, sy, sz = Solver.pos.(!selected) in

      let zv = Vect.proj3 pv in

      let nx, ny, nz =

        Vect.add p0 (Vect.mult pv ((sz -. (Vect.proj3 p0)) /. zv))

      in

      let move = Skel.Constraints.empty (Array.length Solver.skel.(0)) in

        move.(!selected) <- Some (nx -. sx, ny -. sy, nz -. sz); 

        Printf.printf "moving %d from %f %f %f to %f %f %f\n%!"

          !selected sx sy sz nx ny nz;

        do_move move



let init_display () =

  Glut.initDisplayMode ~double_buffer:true ~depth:true ();

  Glut.initWindowSize 500 500;

  ignore (Glut.createWindow "Skeg - Sex, Kinematics, Elegance and Glory");



  GlClear.color (0., 0., 0.);

  shade_model `smooth ;

  GlLight.light_model (`two_side true) ;

  GlLight.light 0 (`ambient (0.5,0.,0.,1.)) ;

  GlLight.light 0 (`diffuse (0.,0.7,0.,1.)) ;

  GlLight.light 0 (`specular (0.,0.,0.7,1.)) ;



  List.iter Gl.enable

    [`depth_test;`lighting;`light0;`normalize] ;



  Glut.specialFunc on_key ;

  Glut.keyboardFunc on_kbd ;

  Glut.displayFunc display ;

  if not !walk then Glut.mouseFunc on_mouse ;

  Glut.reshapeFunc (fun ~w:x ~h:y -> Glut.postRedisplay ()) ;



  GlMat.mode `projection ;

  GlMat.load_identity () ;

  GluMat.perspective ~fovy:80. ~aspect:1. ~z:(0.1,100.);



  Visu.set_step_mb !grid_step



let i_help =

  "Click to move a vertex."

let w_help =

  "Use <space> to make mrblob have a step."



let () =

  init_display () ;

  Printf.printf "%s%!"

    ("\n"^(if !walk then w_help else i_help)^"\n"^

     "Use <escape> or 'q' to exit, arrows to move the camera.\n"^

     "Use 'i'/'k', 'o'/'l' and 'p'/'m' to move the light,\n"^

     "and 'z'/'s' to change the metaballs smoothness.\n"^

     "Please don't report bugs :)\n\n") ;

  Glut.mainLoop ()