MinGW/Windows support
[dormin.git] / nto.ml
blob70812f2b9f58ea5b1ec4db1b705fcfd9edbd6c9c
1 open Format;;
3 type swztype = Plain8 | Plain4 | Swz8 | Swz4
5 external to_rgba
6 : string -> (int * int) -> (int * int) -> swztype -> string
7 = "ml_to_rgba"
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"
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"
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
33 let mipmaps = Xff.r8 ntobuf 29 in
34 let mipmaps = mipmaps lsr 4 in
35 let swz = Xff.r8 ntobuf 31 in
37 if false then
38 printf "%dx%d kind=%d mipmaps=%d swz=%d@."
39 w h kind mipmaps swz
42 let to_rgba swz =
43 let s, p = ntobuf in
44 to_rgba s (p+pixpos, p+palpos) (w, h) swz
47 let rgba w h =
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
58 dst
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
65 | _ ->
66 Xff.sbuferr ntobuf 28 "invalid kind"
68 Array.init mipmaps
69 (fun i ->
70 let w = w lsr i and h = h lsr i in
71 w, h, rgba w h)