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
184
185
186
187
188
189
190
191
|
############################################################################
#
# File: cells.icn
#
# Subject: Procedures for creating and coloring panels of cells
#
# Author: Ralph E. Griswold
#
# Date: December 16, 2002
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# These procedures create an manipulate panels of cells.
#
# makepanel(n, m, size, fg, bg, pg)
# makes a panel in a hidden window with nxm cells of the
# given size, default 10. fg, bg, and pg are the
# colors for the window and panel backgrounds. fg
# and bg default to black and white, respectively.
# If pg is not given a patterned background is used.
#
# matrixpanel(matrix, size, fg, bg, pg)
# same as makepanel(), except matrix determines the
# dimensions.
#
# clearpanel(panel)
# restores the panel to its original state as made by
# makepanel.
#
# colorcell(panel, n, m, color)
# colors the cell (n,m) in panel with color.
#
# colorcells(panel, tier)
# is like colorcell(), except it operates on a tie-up
# record.
#
# cell(panel, x, y)
# returns Cell() record for the cell in which x,y
# lies. If fails if the point is out of bounds.
#
# tiercells(panel, matrix)
# is like colorcell(), except all cells are colored
# using a matrix of colors.
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
#
# Links: wopen
#
############################################################################
link wopen
record Cell(n, m, color)
record Panel(window, n, m, size, fg, bg, pg)
procedure makepanel(n, m, cellsize, fg, bg, pg) #: make panel of cells
local window, x, y, width, height, panel
/fg := "black"
/bg := "white"
/cellsize := 10
width := (n * cellsize) + 1
height := (m * cellsize) + 1
window := WOpen("width=" || width, "height=" || height,
"fg=" || fg, "bg=" || bg, "canvas=hidden") | fail
panel := Panel(window, n, m, cellsize, fg, bg, pg)
clearpanel(panel)
return panel
end
procedure clearpanel(panel)
local width, height, x, y
if \panel.pg then { # default is textured
WAttrib(panel.window, "fillstyle=textured")
Pattern(panel.window, "checkers")
Bg(panel.window, "very dark gray")
}
else Fg(panel.window, panel.fg)
width := WAttrib(panel.window, "width")
height := WAttrib(panel.window, "height")
every x := 0 to width by panel.size do
DrawLine(panel.window, x, 0, x, height)
every y := 0 to height by panel.size do
DrawLine(panel.window, 0, y, width, y)
WAttrib(panel.window, "fillstyle=solid")
return panel
end
procedure matrixpanel(matrix, cellsize, fg, bg, pg)
return makepanel(*matrix[1], *matrix, cellsize, fg, bg)
end
procedure colorcell(panel, n, m, color) #: color cell in panel
local cellsize
if not(integer(n) & integer(m)) then
stop("Non-integer value to colorcell(). n=", image(n), " m=", image(m))
cellsize := panel.size
Fg(panel.window, color)
FillRectangle(panel.window, (n - 1) * cellsize + 1, (m - 1) * cellsize + 1,
cellsize - 1, cellsize - 1)
return panel
end
procedure colorcells(panel, matrix) #: color all cells in panel
local i, j, n, m, cellsize
cellsize := panel.size
m := *matrix
n := *matrix[1]
every i := 1 to m do {
every j := 1 to n do {
# fudge 0/1 matrix
if matrix[i, j] === "1" then matrix[i, j] := "white"
else if matrix[i, j] === "0" then matrix[i, j] := "black"
Fg(panel.window, matrix[i, j])
stop("Fg() failed in colorcells() with matrix[" ||
i || "," || j || "]=" || matrix[i, j] || ".")
FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
cellsize - 1, cellsize - 1)
}
}
return panel
end
procedure tiercells(panel, tier) #: color all cells in panel
local i, j, n, m, cellsize, matrix
cellsize := panel.size
m := tier.shafts
n := tier.treadles
matrix := tier.matrix
every i := 1 to m do {
every j := 1 to n do {
if matrix[i, j] === "1" then Fg(panel.window, "white")
else Fg(panel.window, "black")
FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
cellsize - 1, cellsize - 1)
}
}
return panel
end
procedure cell(panel, x, y)
local n, m
n := x / panel.size + 1
m := y / panel.size + 1
if (n > panel.n) | (m > panel.m) then fail
return Cell(n, m, Pixel(panel.window, x, y))
end
|
