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/examples/basicwin/basicwin.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/examples/basicwin/basicwin.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* basicwin.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *
5 :     * This code was transcribed from a C program that is under the following copyright:
6 :     *
7 :     * Copyright 1989 O'Reilly and Associates, Inc.
8 :     *)
9 :    
10 :     structure BasicWin : sig
11 :    
12 :     val doit' : (string list * string * Int32.int) -> OS.Process.status
13 :     val doit : string -> OS.Process.status
14 :     val main : (string * string list) -> OS.Process.status
15 :    
16 :     end = struct
17 :    
18 :     structure G = Geometry
19 :     structure EXB = EXeneBase
20 :    
21 :     val minWid = 300 and minHt = 200
22 :     val minSz = G.SIZE{wid = minWid, ht = minHt}
23 :    
24 :     (* a trace module for debugging output (see CML manual) *)
25 :     val basicWTM = TraceCML.traceModule(XDebug.eXeneTM, "basicWin")
26 :     fun trace f = TraceCML.trace (basicWTM, f)
27 :    
28 :     fun init dpyName = let
29 :     val _ = trace(fn () => ["open display ", dpyName, "\n"])
30 :     val dpy = (EXB.openDisplay (dpyName, NONE))
31 :     handle EXB.BadAddr s => (
32 :     TextIO.print s; TextIO.print "\n";
33 :     RunCML.shutdown OS.Process.failure)
34 :     val scr = EXB.defaultScreenOf dpy
35 :     val winSz = let val G.SIZE{wid, ht} = EXB.sizeOfScr scr
36 :     in
37 :     G.SIZE{wid = wid div 3, ht = ht div 4}
38 :     end
39 :     val (win, inEnv) =
40 :     EXeneWin.createSimpleTopWin scr {
41 :     geom = G.WGEOM{pos=G.PT{x=0, y=0}, sz=winSz, border=1},
42 :     border = EXB.blackOfScr scr,
43 :     backgrnd = EXB.whiteOfScr scr
44 :     }
45 :     (** The real basicwin gets the list of icon sizes for the display here **)
46 :     val iconTile = EXB.createTileFromImage scr IconBitmap.iconBitmap
47 :     in
48 :     trace(fn () => ["set props\n"]);
49 :     EXeneWin.setWMProperties win {
50 :     argv = SMLofNJ.getArgs(),
51 :     win_name = SOME "Basic Window Program",
52 :     icon_name = SOME "basicwin",
53 :     size_hints = [
54 :     ICCC.HINT_PPosition,
55 :     ICCC.HINT_PSize,
56 :     ICCC.HINT_PMinSize minSz
57 :     ],
58 :     wm_hints = [ICCC.HINT_IconTile iconTile],
59 :     class_hints = SOME{res_name="basicwin", res_class="Basicwin"}
60 :     };
61 :     EXeneWin.mapWin win;
62 :     (dpy, scr, inEnv, win)
63 :     end
64 :    
65 :     fun mkPen scr = Drawing.newPen [
66 :     Drawing.PV_Foreground(EXB.blackOfScr scr),
67 :     Drawing.PV_LineWidth 6,
68 :     Drawing.PV_LineStyle_OnOffDash,
69 :     Drawing.PV_CapStyle_Round,
70 :     Drawing.PV_JoinStyle_Round,
71 :     Drawing.PV_DashOffset 0,
72 :     Drawing.PV_Dash_List [12, 24]
73 :     ]
74 :    
75 :     fun loadFont dpy = Font.openFont dpy "9x15"
76 :    
77 :     fun placeText (win, pen, font, G.SIZE{wid, ht}) = let
78 :     val _ = trace(fn () => ["placeText:\n"])
79 :     val drawString = Drawing.drawString (Drawing.drawableOfWin win) pen font
80 :     val textWidth = Font.textWidth font
81 :     val (fontHt, fontDescent) = let val {ascent, descent} = Font.fontHt font
82 :     in
83 :     (ascent + descent, descent)
84 :     end
85 :     fun draw (yPos, s) = let
86 :     val w = textWidth s
87 :     in
88 :     drawString(G.PT{x = ((wid - w) div 2), y = yPos}, s)
89 :     end
90 :     val yOffset = (ht div 2) - fontHt - fontDescent
91 :     val G.SIZE{wid=scrWid, ht=scrHt} = EXB.sizeOfScr(EXeneWin.screenOfWin win)
92 :     val depth = EXB.depthOfScr(EXeneWin.screenOfWin win)
93 :     in
94 :     trace(fn () => ["placeText: draw text\n"]);
95 :     app draw [
96 :     (fontHt, "Hi! I'm a window, who are you?"),
97 :     (ht - (2*fontHt), "To terminate program: press any key"),
98 :     (yOffset, "Screen Dimensions:"),
99 :     (yOffset + fontHt, " Height - "^(Int.toString scrHt)^" pixels"),
100 :     (yOffset + (2*fontHt), " Width - "^(Int.toString scrWid)^" pixels"),
101 :     (yOffset + (3*fontHt), " Depth - "^(Int.toString depth)^" plane(s)"),
102 :     (ht - fontHt, "or button while in this window")
103 :     ]
104 :     end
105 :    
106 :     fun placeGraphics (win, pen, G.SIZE{wid=winWid, ht=winHt}) = let
107 :     val _ = trace(fn () => ["placeGraphics:\n"])
108 :     val wid = (3 * winWid) div 4
109 :     val ht = winHt div 2
110 :     in
111 :     Drawing.drawRect (Drawing.drawableOfWin win) pen
112 :     (G.RECT{
113 :     x = (winWid div 2) - (wid div 2),
114 :     y = (winHt div 2) - (ht div 2),
115 :     wid = wid, ht = ht
116 :     })
117 :     end
118 :    
119 :     fun tooSmall (win, pen, font) = let
120 :     val {ascent, ...} = Font.fontHt font
121 :     in
122 :     Drawing.drawString (Drawing.drawableOfWin win) pen font
123 :     (G.PT{x=2, y=ascent+2}, "Too Small")
124 :     end
125 :    
126 :     fun basicwin dpy = let
127 :     open Interact
128 :     val _ = trace(fn () => ["init\n"]);
129 :     val (dpy, scr, InEnv{m, k, ci, ...}, win) = init dpy
130 :     val m = CML.wrap(m, msgBodyOf)
131 :     val k = CML.wrap(k, msgBodyOf)
132 :     val ci = CML.wrap(ci, msgBodyOf)
133 :     val _ = trace(fn () => ["mkPen\n"]);
134 :     val pen = mkPen scr
135 :     val _ = trace(fn () => ["load\n"]);
136 :     val font = loadFont dpy
137 :     fun quit _ = (
138 :     trace(fn () => ["QUIT\n"]);
139 :     EXB.closeDisplay dpy;
140 :     RunCML.shutdown OS.Process.success)
141 :     fun sizeTooSmall (G.SIZE{wid, ht}) = (wid < minWid) orelse (ht < minHt)
142 :     fun loop (sz) = let
143 :     fun handleM (MOUSE_FirstDown _) = quit()
144 :     | handleM (MOUSE_LastUp _) = quit()
145 :     | handleM _ = loop (sz)
146 :     fun handleCI (CI_Resize(G.RECT{wid, ht, ...})) =
147 :     loop (G.SIZE{wid=wid, ht=ht})
148 :     | handleCI (CI_Redraw _) = (
149 :     if (sizeTooSmall sz)
150 :     then tooSmall(win, pen, font)
151 :     else (
152 :     placeText(win, pen, font, sz);
153 :     placeGraphics (win, pen, sz));
154 :     loop sz)
155 :     | handleCI (CI_Die) = quit()
156 :     in
157 :     CML.select [
158 :     CML.wrap(m, handleM),
159 :     CML.wrap(k, quit),
160 :     CML.wrap(ci, handleCI)
161 :     ]
162 :     end
163 :     in
164 :     trace(fn () => ["go\n"]);
165 :     loop(minSz)
166 :     end
167 :    
168 :     fun doit' (flgs, dpy, tq) = (
169 :     XDebug.init flgs;
170 :     RunCML.doit (
171 :     fn () => (XDebug.xspawn("basicwin", fn () => basicwin dpy); ()),
172 :     SOME(Time.fromMilliseconds tq)))
173 :    
174 :     fun doit s = doit' ([], s, 20)
175 :    
176 :     fun main (prog, "-display" :: server :: _) = basicwin server
177 :     | main _ = basicwin ""
178 :    
179 :     end

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