skb.ml

   1 open Format;;
   2
   3 let xyzofvec v = (v.Vec.x, v.Vec.y, v.Vec.z)
   4
   5 let qof f = Qtr.make f.(5) f.(6) f.(7) f.(8);;
   6 let vof f = Vec.make f.(1) f.(2) f.(3);;
   7
   8 type t = int * (string * int32 array * float array * int array * float);;
   9
  10 let rt sbuf strtab =
  11   let d = Array.init 3 (fun n -> Xff.r32 sbuf (n*4)) in
  12   let f9 = Array.init 9 (fun n -> Xff.rfloat sbuf (12 +n*4)) in
  13   let h = Array.init 3 (fun n -> Xff.rint sbuf (48 + n*4)) in
  14   let f = Xff.rfloat sbuf 60 in
  15   (Xff.rcstrtabent strtab 0 (Int32.to_int d.(0)), d, f9, h, f)
  16 ;;
  17
  18 let r1 xff sbufxff =
  19   if Array.length xff.Xff.sections != 2
  20   then
  21     Xff.sbuferr sbufxff 0 "number of xff sections is not 2"
  22   ;
  23   let sectpos = xff.Xff.sections.(1).Xff.off in
  24   let sectbuf = Xff.sbufplus sbufxff sectpos in
  25   let skbbuf = Xff.sbufplus sectbuf xff.Xff.entry in
  26
  27   let count1 = Xff.rint skbbuf 4 in
  28   let _pos1 = Xff.rint skbbuf 8 in
  29   let tabpos1 = Xff.rint skbbuf 12 in
  30   let strtab1 = Xff.sbufplus sectbuf tabpos1 in
  31
  32   let bones = Array.init count1 (fun n ->
  33     let pos = Xff.rint skbbuf (44 + n*8) in
  34     let sbuf = Xff.sbufplus sectbuf pos in
  35     pos + sectpos, rt sbuf strtab1)
  36   in
  37   bones
  38 ;;
  39
  40 let vertices bones =
  41   let parentinfo = Array.make (Array.length bones + 1) (Qtr.id, Vec.origin) in
  42   let mapf i (_pos, (_name, _offsets, floats, neighbors, _float)) =
  43     let curq = qof floats in
  44     let curv = vof floats in
  45
  46     let parent = neighbors.(2) in
  47     let parentq, parentv = parentinfo.(parent + 1) in
  48
  49     let v = Qtr.apply parentq curv in
  50     let v = Vec.add v parentv in
  51
  52     let q = Qtr.compose curq parentq in
  53     parentinfo.(i + 1) <- (q, v);
  54     xyzofvec parentv, xyzofvec v;
  55   in
  56   Array.mapi mapf bones;
  57 ;;
  58
  59 let vertices1 bones rotations poseno =
  60   let parentinfo = Array.make (Array.length bones + 1) (Qtr.id, Vec.origin) in
  61   let mapf i (pos, (name, offsets, floats, neighbors, float)) =
  62     let curq = rotations.(i).(poseno) in
  63     let curv = vof floats in
  64
  65     let parent = neighbors.(2) in
  66     let parentq, parentv = parentinfo.(parent + 1) in
  67
  68     let v = Qtr.apply parentq curv in
  69     let v = Vec.add v parentv in
  70
  71     let q = Qtr.compose curq parentq in
  72     parentinfo.(i + 1) <- (q, v);
  73     xyzofvec parentv, xyzofvec v;
  74   in
  75   Array.mapi mapf bones;
  76 ;;
  77
  78 let draw data =
  79   let quad = GluQuadric.create () in
  80   let rta = vertices data in
  81
  82   let sphere origin =
  83     GlMat.mode `modelview;
  84     GlMat.push ();
  85     GlMat.translate3 (origin);
  86     let radius = Rend.view.Rend.radial_scale*.0.009 in
  87     GluQuadric.sphere ~radius ~stacks:5 ~slices:5 ~quad ();
  88     GlMat.pop ()
  89   in
  90
  91   fun () ->
  92     GlDraw.polygon_mode `both `line;
  93     Gl.disable  `depth_test;
  94     Array.iteri
  95       (fun i (pos, (n, d, m, h, f)) ->
  96         GlDraw.line_width 0.1;
  97         GlDraw.color (0., 0., 1.);
  98         let v0, v1 = rta.(i) in
  99         sphere v1;
 100         GlDraw.line_width 2.0;
 101         GlDraw.begins `lines;
 102         GlDraw.vertex3 v0;
 103         GlDraw.vertex3 v1;
 104         GlDraw.ends ();
 105       ) data;
 106     Gl.enable `depth_test;
 107 ;;
 108
 109 let draw1 bones =
 110   fun rotations poseno ->
 111     let rta = vertices1 bones rotations poseno in
 112     fun () ->
 113       GlDraw.polygon_mode `both `line;
 114       GlDraw.color (0., 0., 1.);
 115       Gl.disable  `depth_test;
 116       for i = 0 to Array.length bones - 1 do
 117         (* GlDraw.line_width 0.1; *)
 118         let v0, v1 = rta.(i) in
 119         (* sphere v1; *)
 120         GlDraw.line_width 2.0;
 121         GlDraw.begins `lines;
 122         GlDraw.vertex3 v0;
 123         GlDraw.vertex3 v1;
 124         GlDraw.ends ();
 125       done;
 126       Gl.enable `depth_test;
 127 ;;
 128
 129 let func bones anim =
 130   let posecount, rotations = anim in
 131   let draw0 = draw bones in
 132   let draw1 = draw1 bones in
 133   let rec subfunc dodraw poseno draw = function
 134     | Rend.Char ('f'|'b' as c) ->
 135         let poseno =
 136           if c = 'b' then
 137             let poseno = if poseno = 0 then posecount else poseno in
 138             (poseno - 1) mod posecount
 139           else
 140             (poseno + 1) mod posecount
 141         in
 142         let draw = draw1 rotations poseno in
 143         Anb.skin rotations poseno;
 144         Skin.anim ();
 145         Rend.Func (subfunc dodraw poseno draw)
 146     | Rend.Char 'r' ->
 147         Rend.Func (subfunc dodraw 0 draw0)
 148     | Rend.Draw ->
 149         if dodraw then draw ();
 150         Rend.Func (subfunc dodraw poseno draw)
 151     | Rend.Char 's' -> Rend.Func (subfunc (not dodraw) poseno draw)
 152     | Rend.Char _ -> Rend.Func (subfunc dodraw poseno draw)
 153   in
 154   subfunc false 0 (draw bones)
 155 ;;
 156
 157 let dummy draw =
 158   let rec subfunc = function
 159     | Rend.Draw -> draw (); Rend.Func subfunc
 160     | _ -> Rend.Func subfunc
 161   in
 162   subfunc
 163 ;;
 164
 165 let skin bones =
 166   let skel = Array.map
 167     (fun (_, (_, _, floats, neighbors, _)) -> (neighbors.(2), floats))
 168     bones
 169   in
 170   Skin.set_skel skel;
 171 ;;
 172
 173 let main name =
 174   let func =
 175     try
 176       let name = Filename.chop_extension name ^ ".skb" in
 177       let xff, sbuf = Xff.test2 name in
 178       let bones = r1 xff sbuf in
 179       begin try
 180           let anim_name =
 181             match !Rend.anb_name with
 182             | None -> raise (Failure "no animation set")
 183             | Some name ->name
 184           in
 185           let xff, sbuf = Xff.test2 (Filename.basename anim_name) in
 186           let anim = Anb.r xff sbuf in
 187           skin bones;
 188           func bones anim
 189         with exn ->
 190           prerr_endline (Printexc.to_string exn);
 191           dummy (draw bones)
 192       end;
 193     with exn ->
 194       prerr_endline (Printexc.to_string exn);
 195       dummy (fun () -> ())
 196   in
 197   Rend.add_func func
 198 ;;