skb.ml

   1 open Format;;
   2
   3 let qof f = Qtr.make f.(5) f.(6) f.(7) f.(8);;
   4 let vof f = Vec.make f.(1) f.(2) f.(3);;
   5
   6 type t = int * (string * int32 array * float array * int array * float);;
   7
   8 let rt sbuf strtab =
   9   let d = Array.init 3 (fun n -> Xff.r32 sbuf (n*4)) in
  10   let f9 = Array.init 9 (fun n -> Xff.rfloat sbuf (12 +n*4)) in
  11   let h = Array.init 3 (fun n -> Xff.rint sbuf (48 + n*4)) in
  12   let f = Xff.rfloat sbuf 60 in
  13   (Xff.rcstrtabent strtab 0 (Int32.to_int d.(0)), d, f9, h, f)
  14 ;;
  15
  16 let r1 xff sbufxff =
  17   if Array.length xff.Xff.sections != 2
  18   then
  19     Xff.sbuferr sbufxff 0 "number of xff sections is not 2"
  20   ;
  21   let sectpos = xff.Xff.sections.(1).Xff.off in
  22   let sectbuf = Xff.sbufplus sbufxff sectpos in
  23   let skbbuf = Xff.sbufplus sectbuf xff.Xff.entry in
  24   if not (Xff.check32 skbbuf 0 1l)
  25   then
  26     Xff.sbuferr skbbuf 0 "bad skb signature"
  27   ;
  28
  29   let count1 = Xff.rint skbbuf 4 in
  30   let _pos1 = Xff.rint skbbuf 8 in
  31   let tabpos1 = Xff.rint skbbuf 12 in
  32   let strtab1 = Xff.sbufplus sectbuf tabpos1 in
  33
  34   let bones = Array.init count1 (fun n ->
  35     let pos = Xff.rint skbbuf (44 + n*8) in
  36     let sbuf = Xff.sbufplus sectbuf pos in
  37     pos + sectpos, rt sbuf strtab1)
  38   in
  39   bones
  40 ;;
  41
  42 let vertices bones quats =
  43   let parentinfo = Array.make (Array.length bones + 1) (Qtr.id, Vec.origin) in
  44   let mapf i (pos, (name, offsets, floats, neighbors, float)) =
  45     let curq = quats.(i) in
  46     let curv = vof floats in
  47
  48     let parent = neighbors.(2) in
  49     let parentq, parentv = parentinfo.(parent + 1) in
  50
  51     let v = Qtr.apply parentq curv in
  52     let v = Vec.add v parentv in
  53
  54     let q = Qtr.compose curq parentq in
  55     parentinfo.(i + 1) <- (q, v);
  56     Vec.elts parentv, Vec.elts v;
  57   in
  58   Array.mapi mapf bones;
  59 ;;
  60
  61 let sphere =
  62   let quad = lazy (GluQuadric.create ()) in
  63   fun origin ->
  64     GlMat.mode `modelview;
  65     GlMat.push ();
  66     GlMat.translate3 (origin);
  67     let radius = Rend.view.Rend.radial_scale*.0.009 in
  68     let quad = Lazy.force quad in
  69     GluQuadric.sphere ~radius ~stacks:5 ~slices:5 ~quad ();
  70     GlMat.pop ();
  71 ;;
  72
  73 let draw bones =
  74   fun ?(dsphere=false) quats ->
  75     let rta = vertices bones quats in
  76     fun () ->
  77       GlDraw.polygon_mode `both `line;
  78       GlDraw.color (0., 0., 1.);
  79       Gl.disable  `depth_test;
  80       for i = 0 to Array.length bones - 1 do
  81         let v0, v1 = rta.(i) in
  82         if dsphere then (
  83           GlDraw.line_width 0.1;
  84           sphere v1;
  85         );
  86         GlDraw.line_width 2.0;
  87         GlDraw.begins `lines;
  88         GlDraw.vertex3 v0;
  89         GlDraw.vertex3 v1;
  90         GlDraw.ends ();
  91       done;
  92       Gl.enable `depth_test;
  93 ;;
  94
  95 let skbquats bones =
  96   Array.map (fun (_, (_, _, f, _, _)) -> qof f) bones
  97 ;;
  98
  99 let animate quats =
 100   Skin.set_anim quats;
 101   Skin.anim ();
 102 ;;
 103
 104 let obj bones anim =
 105   let posecount, rotations = anim in
 106   let clip poseno =
 107     let poseno' = poseno mod posecount in
 108     if poseno' < 0 then posecount + poseno' else poseno'
 109   in
 110   let skeldraw n quats =
 111     match n mod 3 with
 112     | 0 -> ()
 113     | 1 -> draw bones quats ()
 114     | _ -> draw ~dsphere:true bones quats ()
 115   in
 116   let skbquats = skbquats bones in
 117   (object (self)
 118     val drawindex = 0
 119     val sposeno = 0
 120     val dposeno = clip 1
 121     val quats = skbquats
 122     val t = 0.0
 123     val dir = 1
 124
 125     method private advance quats dir =
 126       let t = t +. !Rend.slerp_step in
 127       if t >= 1.0
 128       then
 129         let sposeno = dposeno
 130         and dposeno = clip (dposeno + dir) in
 131         {< quats = quats; sposeno = sposeno; dposeno = dposeno; t = 0.0 >}
 132       else
 133         {< quats = quats; sposeno = sposeno; dposeno = dposeno; t = t >}
 134
 135     method help =
 136       [("s", "toggle skeleton (S type)",
 137        if drawindex = 0 then "off" else string_of_int drawindex)
 138       ;"B", sprintf "toggle animation direction", string_of_int dir
 139       ;"f", "forward one frame", sprintf "%d, %f" sposeno t
 140       ;"b", "backward one frame", sprintf "%d, %f" sposeno t
 141       ;"", "", "total frames " ^ string_of_int posecount
 142       ;"r", "go to bind pose", ""
 143       ;"1,2", "go to first/last frame", ""
 144       ]
 145
 146     method draw = skeldraw drawindex quats
 147
 148     method char c =
 149       match c with
 150       | 'n' | 'f' | 'b' ->
 151           let quats = Anb.interpolated rotations sposeno dposeno t in
 152           animate quats;
 153           self#advance quats
 154             (match c with
 155             | 'n' -> dir
 156             | 'f' -> 1
 157             | _ -> -1)
 158
 159       | 'B' -> {< dir = -dir >}
 160
 161       | 'r' ->
 162           Skin.set_anim skbquats;
 163           Skin.anim ();
 164           {< drawindex = 1; quats = skbquats >}
 165
 166       | '1' | '2' ->
 167           let sposeno, dposeno =
 168             if c = '1'
 169             then 0, clip 1
 170             else clip (posecount - 1), 0
 171           in
 172           let quats = Anb.exact rotations sposeno in
 173           animate quats;
 174           let t = if dir > 0 then 1.0 else 0.0 in
 175           {< quats = quats; sposeno = sposeno; dposeno = dposeno; t = t >}
 176
 177       | 's' -> {< drawindex = if drawindex = 0 then 1 else 0 >}
 178       | 'S' -> {< drawindex = (drawindex + 1) mod 3 >}
 179       | _ -> self
 180   end)
 181 ;;
 182
 183 let dummy draw =
 184   (object (self)
 185     val dodraw = false
 186
 187     method help = ["s", "toggle skeleton", if dodraw then "on" else "off"]
 188     method draw = if dodraw then draw ()
 189     method char c =
 190       if c = 's' then {< dodraw = not dodraw >} else self
 191   end)
 192 ;;
 193
 194 let skin bones =
 195   let skel = Array.map
 196     (fun (_, (_, _, floats, neighbors, _)) -> (neighbors.(2), floats))
 197     bones
 198   in
 199   Skin.set_skel skel;
 200 ;;
 201
 202 let main name =
 203   let obj =
 204     try
 205       let name =
 206         match !Rend.skb_name with
 207         | Some s -> s
 208         | None ->
 209             Filename.chop_extension name ^ ".skb"
 210       in
 211       let xff, sbuf = Xff.test2 name in
 212       let bones = r1 xff sbuf in
 213       begin match !Rend.anb_names with
 214       | [] ->
 215           let quats = skbquats bones in
 216           dummy (draw bones quats)
 217       | list ->
 218           let ranb aname =
 219             let xff, sbuf = Xff.test2 (Filename.basename aname) in
 220             let anim = Anb.r xff sbuf in
 221             let (_, abones) = anim in
 222             if Array.length abones != Array.length bones
 223             then
 224               failwith (sprintf "invalid animation %s for skeleton %s"
 225                            aname name);
 226             anim
 227           in
 228           let rec run1 = function
 229             | [] -> failwith "no animations"
 230             | hd :: tl ->
 231                 try
 232                   let anim = ranb hd in
 233                   run2 anim tl
 234                 with exn ->
 235                   prerr_endline (Printexc.to_string exn);
 236                   run1 tl
 237           and run2 accu = function
 238             | [] -> accu
 239             | hd :: tl ->
 240                 let accu =
 241                   try
 242                     Anb.append accu (ranb hd)
 243                   with exn ->
 244                     prerr_endline (Printexc.to_string exn);
 245                     accu
 246                 in
 247                 run2 accu tl
 248           in
 249           let anim = run1 list in
 250           skin bones;
 251           obj bones anim;
 252       end;
 253     with exn ->
 254       prerr_endline (Printexc.to_string exn);
 255       (object (self)
 256         method help = []
 257         method draw = ()
 258         method char _ = self
 259       end)
 260   in
 261   Rend.add_obj obj
 262 ;;