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
180
181
182
183
|
############################################################################
#
# File: button.icn
#
# Subject: Procedures for pushbutton sensors
#
# Author: Gregg M. Townsend
#
# Date: August 14, 1996
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# These procedures implement pushbuttons using the "evmux" event
# multiplexor instead of the usual vidget library.
#
# button(win, label, proc, arg, x, y, w, h)
# establishes a pushbutton.
#
# buttonrow(win,x,y,w,h,dx,dy, label,proc,arg, label,proc,arg, ...)
# establishes a row of buttons.
#
# buttonlabel(handle, label) changes a button label.
#
############################################################################
#
# It is assumed that buttons do not overlap, and that fg, bg, and font
# do not change beyond the initial call. These restrictions can be
# accommodated if necessary by using a window clone.
#
# button(win, label, proc, arg, x, y, w, h)
#
# establishes a button of size (w,h) at (x,y) and returns a handle.
# "label" is displayed as the text of the button.
# When the button is pushed, proc(win, arg) is called.
#
# If proc is null, the label is drawn with no surrounding box, and
# the button is not sensitive to mouse events. This can be used to
# insert a label in a row of buttons.
#
# buttonlabel(handle, label)
#
# changes the label on a button.
#
# buttonrow(win,x,y,w,h,dx,dy, label,proc,arg, label,proc,arg, ...)
#
# establishes a row (or column) of buttons and returns a list of handles.
# Every button has size (w,h) and is offset from its predecessor by
# (dx,dy).
#
# (x,y) give the "anchor point" for the button row, which is a corner
# of the first button. x specifies the left edge of that button unless
# dx is negative, in which case it specifies the right edge. Similarly,
# y is the top edge, or the bottom if dy is negative.
#
# One button is created for each argument triple of label,proc,arg.
# An extra null argument is accepted to allow regularity in coding as
# shown in the example below.
#
# If all three items of the triple are null, a half-button-sized
# gap is inserted instead of a button.
#
# Example:
#
# Draw a pushbutton at (x,y) of size (w,h);
# then change its label from "Slow" to "Reluctant"
# When the button is pushed, call setspeed (win, -3).
#
# b := button (win, "Slow", setspeed, -3, x, y, w, h)
# buttonlabel (b, "Reluctant")
#
# Make a set of buttons extending to the left from (490,10)
#
# blist := buttonrow(win, 490, 10, 50, 20, -60, 0,
# "fast", setspeed, +3,
# "med", setspeed, 0,
# "slow", setspeed, -3,
# )
#
############################################################################
#
# Links: evmux, graphics
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
#
# See also: evmux.icn
#
############################################################################
link evmux
link graphics
$define BORDER 2 # border width
record Button_Rec(win, label, proc, arg, x, y, w, h)
procedure button(win, label, proc, arg, x, y, w, h)
local r
r := Button_Rec(win, label, proc, arg, x, y, w, h)
buttonlabel(r, label)
if \proc then {
BevelRectangle(win, x, y, w, h, BORDER)
sensor(win, &lpress, Exec_Button, r, x, y, w, h)
}
return r
end
procedure buttonrow(win, x, y, w, h, dx, dy, args[])
local hlist, label, proc, arg
if dx < 0 then x -:= w
if dy < 0 then y -:= h
hlist := []
repeat {
label := get(args) | break
proc := get(args) | break
arg := get(args) | break
if label === proc === arg === &null then {
x +:= dx / 2
y +:= dy / 2
}
else {
put(hlist, button(win, label, proc, arg, x, y, w, h))
x +:= dx
y +:= dy
}
}
return hlist
end
procedure buttonlabel(r, s)
r.label := s
if /r.proc then
EraseArea(r.win, r.x, r.y, r.w, r.h) # borderless button
else
EraseArea(r.win, r.x+BORDER, r.y+BORDER, r.w-2*BORDER, r.h-2*BORDER)
CenterString(r.win, r.x + r.w/2, r.y + r.h/2, r.label)
return
end
procedure Exec_Button(win, r, x, y)
local e, b, t
WAttrib(win, "drawop=reverse")
FillRectangle(win, r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h -2*BORDER)
BevelRectangle(win, r.x, r.y, r.w, r.h, b := -BORDER)
while e := Event(win) do {
x := &x
y := &y
case e of {
&ldrag: { # drag
t := (if ontarget(r, x, y) then -BORDER else BORDER)
if b ~===:= t then {
BevelRectangle(win, r.x, r.y, r.w, r.h, b)
FillRectangle(win,
r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h - 2*BORDER)
}
}
&lrelease: { # release leftbutton
if b < 0 then {
BevelRectangle(win, r.x, r.y, r.w, r.h, BORDER)
FillRectangle(win,
r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h - 2*BORDER)
WAttrib(win, "drawop=copy")
r.proc(win, r.arg)
}
else
WAttrib(win, "drawop=copy")
return
}
}
}
end
|
