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/styles/attr-value.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/styles/attr-value.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* attr-value.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 AT&T Bell Laboratories.
4 :     *
5 :     * Types to add: FontList, StdCursor, Atom, Tile
6 :     *)
7 :    
8 :     structure AttrValue : ATTR_VALUE =
9 :     struct
10 :    
11 :     datatype attr_type
12 :     = AT_Str
13 :     | AT_Int
14 :     | AT_Real
15 :     | AT_Bool
16 :     | AT_Font
17 :     | AT_Color
18 :    
19 :     datatype attr_value
20 :     = AV_Str of string
21 :     | AV_Int of int
22 :     | AV_Real of real
23 :     | AV_Bool of bool
24 :     | AV_Font of EXeneBase.font
25 :     | AV_Color of EXeneBase.color
26 :     | AV_NoValue
27 :    
28 :     exception BadAttrValue
29 :    
30 :     (* strip leading and trailing whitespace from a string. *)
31 :     fun strip s = let
32 :     fun front i = if (CType.isSpace(s, i)) then front(i+1) else i
33 :     fun back i = if (CType.isSpace(s, i-1)) then back(i-1) else i
34 :     val start = front 0
35 :     val len = back(size s) - start
36 :     in
37 :     if (len < size s)
38 :     then substring(s, start, len)
39 :     else s
40 :     end
41 :     handle _ => "" (* all white space *)
42 :    
43 :     fun cvtBool s = (case (strip s)
44 :     of ("true"|"yes"|"Yes"|"on"|"On") => true
45 :     | ("false"|"no"|"No"|"off"|"Off") => false
46 :     | _ => raise BadAttrValue
47 :     (* end case *))
48 :    
49 :     fun cvtInt s = let
50 :     val s = strip s
51 :     val start = if (CType.isDigit(s, 0)) then 0 else 1
52 :     in
53 :     if (ordof(s, start) = ord "0")
54 :     then (case ordof(s, start+1)
55 :     of (88 (* #"X" *) | 120 (* #"x" *)) => StringCvt.xatoi s
56 :     | _ => StringCvt.oatoi s
57 :     (* end case *))
58 :     else StringCvt.atoi s
59 :     end
60 :     handle _ => raise BadAttrValue
61 :    
62 :     fun cvtReal s = (#1 (StringCvt.strToReal(strip s, 0)))
63 :     handle _ => raise BadAttrValue
64 :    
65 :     (* convert a string to a color_spec *)
66 :     fun cvtColorSpec s = let
67 :     val s = strip s
68 :     fun split n = let
69 :     val shift = (4-n)*4
70 :     fun extract (s, i) =
71 :     Bits.lshift(StringCvt.xatoi(substring(s, i, n)), shift)
72 :     in
73 :     EXeneBase.CMS_RGB{
74 :     red = extract(s, 1),
75 :     green = extract(s, 1+n),
76 :     blue = extract(s, 1+n+n)
77 :     }
78 :     end
79 :     in
80 :     if (ordof(s, 0) = 35 (* #"#" *))
81 :     then (case (size s)
82 :     of 4 => split 1 (* "#RGB" *)
83 :     | 7 => split 2 (* "#RRGGBB" *)
84 :     | 10 => split 3 (* "#RRRGGGBBB" *)
85 :     | 13 => split 4 (* "#RRRRGGGGBBBB" *)
86 :     | _ => raise BadAttrValue
87 :     (* end case *))
88 :     else EXeneBase.CMS_Name s
89 :     end
90 :     handle _ => raise BadAttrValue
91 :    
92 :     (* convert a string to the specified kind of style attribute value;
93 :     * this raises BadAttrValue if the string has the wrong format.
94 :     *)
95 :     fun cvtAttrValue scr = let
96 :     val openFont = Font.openFont (EXeneBase.displayOfScr scr)
97 :     fun cvtFont s = (openFont(strip s)) handle _ => raise BadAttrValue
98 :     val colorOfScr = EXeneBase.colorOfScr scr
99 :     fun cvt (value, AT_Str) = AV_Str value
100 :     | cvt (value, AT_Int) = AV_Int(cvtInt value)
101 :     | cvt (value, AT_Real) = AV_Real(cvtReal value)
102 :     | cvt (value, AT_Bool) = AV_Bool(cvtBool value)
103 :     | cvt (value, AT_Font) = AV_Font(cvtFont value)
104 :     | cvt (value, AT_Color) = AV_Color(colorOfScr(cvtColorSpec value))
105 :     in
106 :     cvt
107 :     end (* cvtAttrValue *)
108 :    
109 :     fun getInt (AV_Int i) = i | getInt _ = raise BadAttrValue
110 :     fun getReal (AV_Real r) = r | getReal _ = raise BadAttrValue
111 :     fun getBool (AV_Bool b) = b | getBool _ = raise BadAttrValue
112 :     fun getString (AV_Str s) = s | getString _ = raise BadAttrValue
113 :     fun getColor (AV_Color c) = c | getColor _ = raise BadAttrValue
114 :     fun getFont (AV_Font f) = f | getFont _ = raise BadAttrValue
115 :    
116 :     fun getIntOpt (AV_Int i) = SOME i | getIntOpt _ = NONE
117 :     fun getRealOpt (AV_Real r) = SOME r | getRealOpt _ = NONE
118 :     fun getBoolOpt (AV_Bool b) = SOME b | getBoolOpt _ = NONE
119 :     fun getStringOpt (AV_Str s) = SOME s | getStringOpt _ = NONE
120 :     fun getColorOpt (AV_Color c) = SOME c | getColorOpt _ = NONE
121 :     fun getFontOpt (AV_Font f) = SOME f | getFontOpt _ = NONE
122 :    
123 :     end; (* AttrValue *)

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