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
|
############################################################################
#
# File: enqueue.icn
#
# Subject: Procedures for queued events
#
# Author: Gregg M. Townsend
#
# Date: May 2, 2001
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# These procedures manipulate Icon window events.
#
# Enqueue(W, eventcode, x, y, modkeys, interval) posts an event.
#
# pack_modkeys(s) encodes the modifier keys for an event.
# unpack_modkeys(n) decodes a modifier key value.
#
# pack_intrvl(n) encodes an event interval.
# unpack_intrvl(n) decodes an event interval.
#
############################################################################
#
# Icon's event queue is a list accessed via Pending(); the list
# can be inspected or altered by the Icon program. An event is stored
# as three consecutive entries on the list. The first is the event code:
# a string for a keypress, or an integer for any other event. The next
# two list entries are integers, interpreted as a packed structure:
# 0000 0000 0000 0SMC XXXX XXXX XXXX XXXX (second entry)
# 0EEE MMMM MMMM MMMM YYYY YYYY YYYY YYYY (third entry)
#
# The fields have these meanings:
# X...X &x: 16-bit signed x-coordinate value
# Y...Y &y: 16-bit signed y-coordinate value
# SMC &shift, &meta, and &control (modifier keys)
# E...M &interval, interpreted as M * 16 ^ E
# 0 currently unused; should be zero
#
#
# pack_modkeys(s) encodes a set of modifier keys, returning an
# integer with the corresponding bits set. The string s contains
# any combination of the letters c, m, and s to specify the bits
# desired.
#
# pack_intrvl(n) encodes an interval of n milliseconds and returns
# a left-shifted integer suitable for combining with a y-coordinate.
#
# unpack_modkeys(n) returns a string containing 0 to 3 of the
# letters c, m, and s, depending on which modifier key bits are
# set in the argument n.
#
# unpack_intrvl(n) discards the rightmost 16 bits of the integer
# n (the y-coordinate) and decodes the remainder to return an
# integer millisecond count.
#
# Enqueue([window,] eventcode, x, y, modkeys, interval) synthesizes
# and enqueues an event for a window, packing the interval and modifier
# keys (specified as above) into the correct places. Default values
# are:
# eventcode = &null
# x = 0
# y = 0
# interval = 0
# modkeys = ""
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
# pack_intrvl(n) -- encode event interval
procedure pack_intrvl(n) #: encode event interval
local e
n := integer(n) | runerr(101, n) # ensure integer
n <:= 0 # ensure nonnegative
e := 0 # assume exponent of 0
while n >= 16r1000 do { # if too big
n := ishift(n, -4) # reduce significance
e +:= 16r1000 # increase exponent
}
return ishift(e + n, 16) # return shifted result
end
# unpack_intrvl(n) -- decode event interval
procedure unpack_intrvl(n) #: decode event interval
local e
n := integer(n) | runerr(101, n) # ensure integer
e := iand(ishift(n, -28), 7) # exponent
n := iand(ishift(n, -16), 16rFFF) # mantissa
return ishift(n, 4 * e)
end
# pack_modkeys(s) -- encode modifier keys
procedure pack_modkeys(s) #: encode modifier keys
local b, c
b := 0
s := string(s) | runerr(103, s) # ensure string value
every c := !s do case c of { # set bit for each flag
"c": b := ior(b, 16r10000)
"m": b := ior(b, 16r20000)
"s": b := ior(b, 16r40000)
default: runerr(205, s) # diagnose bad flag
}
return b # return result
end
# unpack_modkeys(n) -- decode modifier keys
procedure unpack_modkeys(n) #: decode modifier keys
local s
n := integer(n) | runerr(101, n) # ensure integer
s := ""
if iand(n, 16r10000) ~= 0 then s ||:= "c" # check each bit
if iand(n, 16r20000) ~= 0 then s ||:= "m"
if iand(n, 16r40000) ~= 0 then s ||:= "s"
return s # return result string
end
# Enqueue(window, eventcode, x, y, modkeys, interval) -- enqueue event
procedure Enqueue(win, eventcode, x, y, modkeys, interval) #: enqueue event
static type
initial type := proc("type", 0) # protect attractive name
if type(win) ~== "window" then {
win :=: eventcode :=: x :=: y :=: modkeys :=: interval
win := &window
}
/x := 0
/y := 0
x +:= WAttrib(win, "dx")
y +:= WAttrib(win, "dy")
return put(Pending(win),
eventcode,
ior(pack_modkeys(\modkeys | ""), iand(x, 16rFFFF)),
ior(pack_intrvl(\interval | 0), iand(y, 16rFFFF)))
end
|
