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