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 /eXene/releases/release-110.63/graph-util/bitmap-io.sml
ViewVC logotype

Annotation of /eXene/releases/release-110.63/graph-util/bitmap-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1368 - (view) (download)
Original Path: sml/trunk/src/eXene/graph-util/bitmap-io.sml

1 : monnier 2 (* bitmap-io.sml
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * This module provides code to read and write depth-1 images
6 :     * stored in X11 bitmap file format (see XReadBitmapFile(3X).
7 :     * It does not use any CML features, and thus can be compiled
8 :     * as part of a sequential SML program.
9 :     *)
10 :    
11 :     structure BitmapIO : BITMAP_IO =
12 :     struct
13 :    
14 :     structure EXB = EXeneBase
15 :     structure G = Geometry
16 :     structure SS = Substring
17 :     structure W8V = Word8Vector
18 :    
19 :     exception BitmapFileInvalid
20 :    
21 :     local
22 :     fun scan f s = valOf(f s) handle _ => []
23 :     val scanDefine = scan (Scan.sscanf "#define %s %d")
24 :     val scanUChar = scan (Scan.sscanf "static unsigned char %s = {")
25 :     val scanChar = scan (Scan.sscanf "static char %s = {")
26 :     in
27 :     datatype line = SKIP | DEFINE of (string * int) | BEGIN of string
28 :     fun scanString s = (case (scanDefine s)
29 :     of [Format.STR s, Format.INT n] => DEFINE(s, n)
30 :     | _ => (case (scanUChar s)
31 :     of [Format.STR s] => BEGIN s
32 :     | _ => (case (scanChar s)
33 :     of [Format.STR s] => BEGIN s
34 :     | _ => SKIP
35 :     (* end case *))
36 :     (* end case *))
37 :     (* end case *))
38 :     end
39 :    
40 :     val isDelim = Char.contains " \t\n,}"
41 :    
42 :     (* return true if s1 is a suffix of s2 *)
43 :     fun isSuffix (s1, s2) = let
44 :     val n1 = size s1 and n2 = size s2
45 :     in
46 :     (n1 <= n2) andalso SS.isPrefix s1 (SS.substring(s2, n2 - n1,n1))
47 :     end
48 :    
49 :     fun readBitmap inStrm = let
50 :     fun inputLine () = (case TextIO.inputLine inStrm
51 : mblume 1368 of NONE => raise BitmapFileInvalid
52 :     | SOME s => s
53 : monnier 2 (* end case *))
54 :     val inputSS = SS.all o inputLine
55 :     fun setWid ({wid, ht, x_hot, y_hot}, w) =
56 :     {wid=SOME w, ht=ht, x_hot=x_hot, y_hot=y_hot}
57 :     fun setHt ({wid, ht, x_hot, y_hot}, h) =
58 :     {wid=wid, ht=SOME h, x_hot=x_hot, y_hot=y_hot}
59 :     fun setXHot ({wid, ht, x_hot, y_hot}, x) =
60 :     {wid=wid, ht=ht, x_hot=SOME x, y_hot=y_hot}
61 :     fun setYHot ({wid, ht, x_hot, y_hot}, y) =
62 :     {wid=wid, ht=ht, x_hot=x_hot, y_hot=SOME y}
63 :     fun scanHdr (arg as {wid, ht, x_hot, y_hot}) = (
64 :     case (scanString (inputLine ()))
65 :     of SKIP => scanHdr arg
66 :     | (DEFINE("width", n)) => scanHdr(setWid(arg, n))
67 :     | (DEFINE("height", n)) => scanHdr(setHt(arg, n))
68 :     | (DEFINE("x_hot", n)) => scanHdr(setXHot(arg, n))
69 :     | (DEFINE("y_hot", n)) => scanHdr(setYHot(arg, n))
70 :     | (DEFINE(s, n)) =>
71 :     if isSuffix("_width", s)
72 :     then scanHdr(setWid(arg, n))
73 :     else if isSuffix("_height", s)
74 :     then scanHdr(setHt(arg, n))
75 :     else if isSuffix("_x_hot", s)
76 :     then scanHdr(setXHot(arg, n))
77 :     else if isSuffix("_y_hot", s)
78 :     then scanHdr(setYHot(arg, n))
79 :     else scanHdr arg
80 :     | (BEGIN s) => arg
81 :     (* end case *))
82 :     fun getNextInt ss = let
83 :     val ss' = SS.dropl isDelim ss
84 :     in
85 :     if SS.isEmpty ss' then getNextInt (inputSS())
86 :     else case Int.scan StringCvt.HEX (SS.getc) ss' of
87 :     NONE => raise BitmapFileInvalid
88 :     | SOME v => v
89 :     end
90 :     val (wid, ht, hot) = (
91 :     case (scanHdr{wid=NONE, ht=NONE, x_hot=NONE, y_hot=NONE})
92 :     of {wid=NONE, ...} => raise BitmapFileInvalid
93 :     | {ht=NONE, ...} => raise BitmapFileInvalid
94 :     | {wid=SOME w, ht=SOME h, x_hot=SOME x, y_hot=SOME y} =>
95 :     (w, h, SOME(G.PT{x=x, y=y}))
96 :     | {wid=SOME w, ht=SOME h, ...} => (w, h, NONE)
97 :     (* end case *))
98 :     val bytesPerLine = (wid+7) div 8
99 :     fun getScanLine ss = let
100 :     val scanLn = Unsafe.CharVector.create bytesPerLine
101 :     fun get (ss, k) = if (k < bytesPerLine)
102 :     then let
103 :     val (byte, ss) = getNextInt ss
104 :     in
105 :     Unsafe.CharVector.update (scanLn, k, Char.chr byte);
106 :     get(ss, k+1)
107 :     end
108 :     else (Byte.stringToBytes scanLn, ss)
109 :     in
110 :     get (ss, 0)
111 :     end (* getScanLine *)
112 :     fun getData (_, 0, l) = [rev l]
113 :     | getData (ss, n, l) = let
114 :     val (scanLn, ss) = getScanLine ss
115 :     in
116 :     getData(ss, n-1, scanLn::l)
117 :     end
118 :     in
119 :     { image = EXB.IMAGE{
120 :     sz = G.SIZE{wid=wid, ht=ht},
121 :     data = getData(inputSS(), ht, [])
122 :     },
123 :     hot_spot = hot
124 :     }
125 :     end
126 :    
127 :     val formatDefine = Format.format "#define %s%s %d\n"
128 :     val formatUChar = Format.format "static unsigned char %sbits[] = {\n"
129 :     val formatByte = Format.format "%#04x"
130 :    
131 :     exception NotBitmap
132 :     exception BadImageData = EXB.BadImageData
133 :    
134 :     fun writeBitmap (outStrm, name, {image, hot_spot}) = let
135 :     val name = (case name of "" => "" | _ => name ^ "_")
136 :     fun pr s = TextIO.output (outStrm, s)
137 :     fun writeDefine (s, n) =
138 :     pr(formatDefine [Format.STR name, Format.STR s, Format.INT n])
139 :     val (wid, ht, data) = (case image
140 :     of (EXB.IMAGE{sz=G.SIZE{wid, ht}, data=[data]}) => (wid, ht, data)
141 :     | _ => raise NotBitmap
142 :     (* end case *))
143 :     fun prData () = let
144 :     val bytesPerLine = (wid + 7) div 8
145 :     fun nextByte (s, r, i) = if (i < bytesPerLine)
146 :     then (W8V.sub(s, i), (s, r, i+1))
147 :     else nextLine r
148 :     and nextLine [] = raise BadImageData
149 :     | nextLine (s::r) = if (W8V.length s = bytesPerLine)
150 :     then nextByte(s, r, 0)
151 :     else raise BadImageData
152 :     fun prLine (0, _, _) = ()
153 :     | prLine (n, 12, data) = (pr ",\n"; prLine(n, 0, data))
154 :     | prLine (n, k, data) = let
155 :     val (byte, data) = nextByte data
156 :     in
157 :     if (k = 0) then pr " " else pr ", ";
158 :     pr(formatByte [Format.WORD8 byte]);
159 :     prLine (n-1, k+1, data)
160 :     end
161 :     in
162 :     if (length data = ht)
163 :     then prLine(ht*bytesPerLine, 0, (W8V.fromList[], data, bytesPerLine))
164 :     else raise BadImageData
165 :     end
166 :     in
167 :     writeDefine ("height", ht);
168 :     writeDefine ("width", wid);
169 :     case hot_spot
170 :     of (SOME(G.PT{x, y})) => (
171 :     writeDefine ("x_hot", x);
172 :     writeDefine ("y_hot", y))
173 :     | _ => ()
174 :     (* end case *);
175 :     pr(formatUChar [Format.STR name]);
176 :     prData ();
177 :     pr "\n};\n";
178 :     TextIO.flushOut outStrm
179 :     end
180 :    
181 :     end; (* structure BitmapIO *)
182 :    

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