nto.ml

   1 open Format;;
   2
   3 type swztype = Plain8 | Plain4 | Swz8 | Swz4
   4
   5 external to_rgba
   6   : string -> (int * int) -> (int * int) -> swztype -> string
   7   = "ml_to_rgba"
   8
   9 let r xff sbufxff ?dim () =
  10   if Array.length xff.Xff.sections != 2
  11   then
  12     Xff.sbuferr sbufxff 0 "number of xff sections is not 2"
  13   ;
  14   let ntopos = xff.Xff.sections.(1).Xff.off in
  15   let ntobuf = Xff.sbufplus sbufxff ntopos in
  16   if not (Xff.cmp ntobuf (`chars "NTO2"))
  17   then
  18     Xff.sbuferr ntobuf 0 "invalid NTO signature"
  19   ;
  20   let pixpos = Xff.rint ntobuf 20 in
  21   let palpos = Xff.rint ntobuf 24 in
  22   let kind = Xff.r8 ntobuf 28 in
  23   let wh = Xff.r8 ntobuf 30 in
  24   let w, h =
  25     match dim with
  26     | None ->
  27         let h = 1 lsl (wh land 0xf)
  28         and w = 1 lsl (wh lsr 4) in
  29         (w, h)
  30     | Some (w, h) ->
  31         w, h
  32   in
  33   let mipmaps = Xff.r8 ntobuf 29 in
  34   let _mipmaps = mipmaps lsr 4 in
  35   let swz = Xff.r8 ntobuf 31 in
  36
  37   if false then
  38     printf "%dx%d kind=%d mipmaps=%d swz=%d@."
  39       w h kind _mipmaps swz
  40   ;
  41
  42   let to_rgba swz =
  43     let s, p = ntobuf in
  44     to_rgba s (p+pixpos, p+palpos) (w, h) swz
  45   in
  46
  47   let rgba =
  48     match kind with
  49     | 0x00 ->                           (* 32 bit *)
  50         let len = w * h * 4 in
  51         let dst = String.create len in
  52         Xff.sbufblt ntobuf
  53           ~src_pos:pixpos
  54           ~dst
  55           ~dst_pos:0
  56           ~len
  57         ;
  58         dst
  59
  60     | 0x14 when swz = 0            -> to_rgba Plain4
  61     | 0x14 when swz = 1 || swz = 3 -> to_rgba Swz4
  62     | 0x13 when swz = 0            -> to_rgba Plain8
  63     | 0x13 when swz = 1 || swz = 3 -> to_rgba Swz8
  64
  65     | _ ->
  66         Xff.sbuferr ntobuf 28 "invalid kind"
  67   in
  68   w, h, rgba
  69 ;;