Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/widgets/util/read-bitmap.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/util/read-bitmap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 structure ReadBitmap :
2 :     sig
3 :     exception BadImageData
4 :    
5 :     val readBitmapFile : TextIO.instream ->
6 :     (EXeneBase.image * int option * int option)
7 :     end =
8 :     struct
9 :     exception BadImageData = EXeneBase.BadImageData
10 :    
11 :     open Geometry TextIO
12 :    
13 :     val << = Bits.lshift
14 :     val >> = Bits.rshift
15 :     val & = Bits.andb
16 :     val ++ = Bits.orb
17 :     infix << >> & ++
18 :    
19 :     val flip0_9 = #[0x0,0x8,0x4,0xc,0x2,0xa,6,0xe,0x1,0x9]
20 :     val flipA_F = #[0x5,0xd,0x3,0xb,0x7,0xf]
21 :    
22 :     val sfmt1 = Format.scan "#define %s %d"
23 :     val sfmt2 = Format.scan "static char %s = {"
24 :     val sfmt3 = Format.scan "static unsigned char %s = {"
25 :    
26 :     fun isSuffix (sfx,s,j) = let
27 :     fun loop (i,j) =
28 :     (ordof(sfx,i) = ordof(s,j)) andalso loop(i+1,j+1)
29 :     val start = (size s) - (size sfx)
30 :     in
31 :     if (size sfx) <> (size s - j) then false
32 :     else (loop (0,j)) handle _ => true
33 :     end
34 :    
35 :     fun done (wid,ht,hotx,hoty,[]) = raise BadImageData
36 :     | done (wid,ht,hotx,hoty,data) =
37 :     (EXeneBase.IMAGE{sz=SIZE{wid=wid,ht=ht},data = [data]},hotx,hoty)
38 :    
39 :     fun cvt x =
40 :     if ((48 <= x) andalso (x <= 57)) (* '0'..'9' *)
41 :     then Vector.sub(flip0_9,x - 48)
42 :     else if ((65 <= x) andalso (x <= 70)) (* 'A'..'F' *)
43 :     then Vector.sub(flipA_F,x - 65)
44 :     else if ((97 <= x) andalso (x <= 102)) (* 'a'..'f' *)
45 :     then Vector.sub(flipA_F,x - 97)
46 :     else raise BadImageData
47 :    
48 :     fun doDefine (nt,value,vals) = let
49 :     val type_idx = ((StringUtil.revindex "_" (nt,size nt))+1)
50 :     handle _ => 0
51 :     in
52 :     if isSuffix("width",nt,type_idx)
53 :     then (value,#2 vals, #3 vals, #4 vals, #5 vals)
54 :     else if isSuffix("height",nt,type_idx)
55 :     then (#1 vals, value, #3 vals, #4 vals, #5 vals)
56 :     else if isSuffix("hot",nt,type_idx)
57 :     then if type_idx < 2
58 :     then vals
59 :     else if isSuffix("x_hot",nt,type_idx-2)
60 :     then (#1 vals,#2 vals, SOME value, #4 vals, #5 vals)
61 :     else if isSuffix("y_hot",nt,type_idx-2)
62 :     then (#1 vals,#2 vals, #3 vals, SOME value, #5 vals)
63 :     else vals
64 :     else vals
65 :     end
66 :    
67 :     fun readBitmapFile ins = let
68 :     open Format CType
69 :     fun wrap f l = (f l) handle _ => []
70 :     val scan1 = wrap sfmt1
71 :     val scan2 = wrap sfmt2
72 :     val scan3 = wrap sfmt3
73 :     val ord_0 = ord "0"
74 :     val ord_x = ord "x"
75 :    
76 :     fun getc () = (ord(input(ins,1))) handle _ => raise BadImageData
77 :    
78 :     fun getChar () = let
79 :     fun get () =
80 :     if getc () <> ord_x then raise BadImageData
81 :     else let
82 :     val i1 = cvt(getc())
83 :     val i2 = cvt(getc())
84 :     in
85 :     if isXDigitOrd (getc()) then raise BadImageData
86 :     else chr ((i2 << 4) ++ i1)
87 :     end
88 :     fun skip c = if c <> ord_0 then skip(getc()) else get ()
89 :     in skip(getc()) end
90 :    
91 :     fun doData (nt, vals as (wid,ht,_,_,_)) = let
92 :     val type_idx = ((StringUtil.revindex "_" (nt,size nt))+1)
93 :     handle _ => 0
94 :     fun getLine (0,l) = implode(rev l)
95 :     | getLine (i,l) = getLine(i-1,(getChar())::l)
96 :     in
97 :     if not(isSuffix("bits[]",nt,type_idx)) then vals
98 :     else let
99 :     val bytes_per_line = ((wid + 7) >> 3)
100 :     fun loop (0,l) = rev l
101 :     | loop (i,l) = (
102 :     loop(i-1,getLine(bytes_per_line,[])::l)
103 :     )
104 :     in
105 :     if wid <= 0 andalso ht <= 0 then raise BadImageData
106 :     else (#1 vals,#2 vals, #3 vals, #4 vals, loop(ht,[]))
107 :     end
108 :     end
109 :    
110 :     fun tryScan (vals,line) =
111 :     case scan1 line of
112 :     [STR name_type, INT value] => doDefine(name_type,value,vals)
113 :     | _ => case scan2 line of
114 :     [STR name_type] => doData (name_type,vals)
115 :     | _ => case scan3 line of
116 :     [STR name_type] => doData (name_type,vals)
117 :     | _ => vals
118 :    
119 :     fun read (arg as (wid,ht,hotx,hoty,data)) =
120 :     case input_line ins
121 :     of "" => done arg
122 :     | line => read(tryScan (arg,line))
123 :     in read (0,0, NONE, NONE,[]) end
124 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0