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/composite/hide-view.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/composite/hide-view.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* hide-view.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories See COPYRIGHT file for details.
4 :     *
5 :     * View for hideable button.
6 :     *)
7 :    
8 :     structure HideView : BUTTON_VIEW =
9 :     struct
10 :    
11 :     structure W = Widget
12 :    
13 :     open Geometry
14 :    
15 :     val dfltFont = "-Adobe-Helvetica-Bold-R-Normal--*-120-*"
16 :     val dfltBorderWidth = 2
17 :    
18 :     val attrs = [
19 :     (Attrs.attr_label, Attrs.AT_Str, Attrs.AV_Str ""),
20 :     (Attrs.attr_font, Attrs.AT_Font, Attrs.AV_Str dfltFont),
21 :     (Attrs.attr_color, Attrs.AT_Color, Attrs.AV_NoValue),
22 :     (Attrs.attr_background, Attrs.AT_Color, Attrs.AV_Str "white"),
23 :     (Attrs.attr_foreground, Attrs.AT_Color, Attrs.AV_Str "black")
24 :     ]
25 :    
26 :     fun mkFontInfo font = let
27 :     val {ascent=fonta,descent=fontd} = Font.fontHt font
28 :     in (font, fonta, fontd) end
29 :    
30 :     fun mkTextLabel (s,font) = let
31 :     val Font.CharInfo {left_bearing=lb,right_bearing=rb,...}
32 :     = #overall_info (Font.textExtents font s)
33 :     in (s,lb,rb) end
34 :    
35 :     fun sizeOfLabel ((s,lb,rb),(_,fa,fd)) =
36 :     SIZE{wid = rb - lb + 2, ht = fa + fd + 2}
37 :    
38 :     fun setLightWidth (_,fonta,fontd) = (80 * (fonta+fontd)) div 100
39 :    
40 :     datatype button_view = BV of {
41 :     shades : W.shades,
42 :     fontinfo : (W.EXB.font * int * int),
43 :     label : (string * int * int),
44 :     fg : W.EXB.color,
45 :     bg : W.EXB.color,
46 :     lightSz : int,
47 :     padx : int,
48 :     pady : int,
49 :     borderWidth : int,
50 :     onColor : W.EXB.color
51 :     }
52 :    
53 :     fun buttonView (root,view,args) = let
54 :     open Attrs
55 :     val attrs = W.findAttr (W.attrs(view, attrs, args))
56 :     val fontinfo as (f,_,_) = mkFontInfo(getFont(attrs attr_font))
57 :     val label = mkTextLabel(getString(attrs attr_label),f)
58 :     val forec = Attrs.getColor (attrs Attrs.attr_foreground)
59 :     val backc = Attrs.getColor (attrs Attrs.attr_background)
60 :     val color = case Attrs.getColorOpt (attrs Attrs.attr_color) of
61 :     SOME c => c
62 :     | _ => forec
63 :     val lightSz = setLightWidth fontinfo
64 :     in
65 :     BV {
66 :     fontinfo = fontinfo,
67 :     label = label,
68 :     fg = forec,
69 :     bg = backc,
70 :     shades = W.shades root color,
71 :     lightSz = lightSz,
72 :     borderWidth = dfltBorderWidth,
73 :     padx = lightSz div 2,
74 :     pady = lightSz div 4,
75 :     onColor = forec
76 :     }
77 :     end
78 :    
79 :     fun config (BV v, win, SIZE{wid,ht}) = let
80 :     open Drawing
81 :     val dr = drawableOfWin win
82 :     val {fontinfo,shades,label,borderWidth=bw,fg,onColor,...} = v
83 :     val (font,fonta,fontd) = fontinfo
84 :     val fonth = fonta + fontd
85 :     val fgPen = newPen[PV_Foreground fg, PV_LineWidth 2]
86 :     val onPen = newPen[PV_Foreground onColor]
87 :     val pts = let
88 :     val SIZE{wid=lwid,...} = sizeOfLabel (label,fontinfo)
89 :     val topy = #pady v + (fonth div 2)
90 :     val boty = ht - topy
91 :     val lightSz = #lightSz v
92 :     val x0 = #padx v + lightSz div 2
93 :     val x1 = #padx v
94 :     val x2 = wid - x1
95 :     val x3 = #padx v + 2*lightSz + lwid
96 :     in
97 :     [PT{x=x0,y=topy},PT{x=x1,y=topy},PT{x=x1,y=boty},
98 :     PT{x=x2,y=boty},PT{x=x2,y=topy},PT{x=x3,y=topy}]
99 :     end
100 :    
101 :     fun drawCheck (isOn,rel) = let
102 :     val lightSz = #lightSz v
103 :     val y = #pady v + (fonth - lightSz) div 2
104 :     val x = #padx v + (lightSz div 2)
105 :     val rect = RECT{x=x,y=y,wid=lightSz,ht=lightSz}
106 :     val arg = {rect=rect,width=bw,relief=rel}
107 :     in
108 :     if isOn then (
109 :     fillRect dr onPen rect;
110 :     ThreeD.drawRect dr arg shades
111 :     )
112 :     else ThreeD.drawFilledRect dr arg shades
113 :     end
114 :    
115 :     fun drawLine () = drawLines dr fgPen pts
116 :     fun drawLabel () = let
117 :     val lightSz = #lightSz v
118 :     val (font,fonta,_) = #fontinfo v
119 :     val (s,lb,_) = #label v
120 :     val x = #padx v + (2*lightSz) - lb + 1
121 :     val y = #pady v + fonta + 1
122 :     in drawString dr fgPen font (PT{x=x,y=y}, s) end
123 :    
124 :     fun init() = (clearDrawable dr; drawLabel (); drawLine ())
125 :    
126 :     fun setf (W.Inactive s,_,_) = (init(); drawCheck(s,W.Raised))
127 :     | setf (W.Active s,_,d) = let
128 :     val rel = if d then W.Sunken else W.Raised
129 :     in init(); drawCheck (s,rel) end
130 :     in
131 :     setf
132 :     end
133 :    
134 :     fun bounds (BV v) = let
135 :     val {label,lightSz,fontinfo,padx,pady,...} = v
136 :     val SIZE{wid,ht} = sizeOfLabel (label,fontinfo)
137 :     val halfLight = lightSz div 2
138 :     val wid = (2*padx + 3*lightSz + wid)
139 :     val ht = (2*pady + 2*ht)
140 :     val x_dim = W.flexDim wid
141 :     val y_dim = W.fixDim ht
142 :     in {x_dim=x_dim,y_dim=y_dim} end
143 :    
144 :     fun win_args (BV{bg,...}) = {background = SOME bg}
145 :    
146 :     end (* HideView *)

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