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
|
############################################################################
#
# File: puzz.icn
#
# Subject: Program to create word search puzzle
#
# Author: Chris Tenaglia
#
# Date: February 18, 1996
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This program creates word search puzzles.
#
############################################################################
global matrix, # the actual puzzle board
width, # width of the puzzle
height, # height of the puzzle
completed # number of completed word placements
procedure main(param)
local i, j, line, pass, tokens, word, words
#
# initial set up : x=20, y=20 by default
#
width := param[1] | 20
height := param[2] | 20
words := []
#
# load words to place in a space delimited
# file. more than one word per line is ok.
#
while line := map(read()) do
{
tokens := parse(line,' \t')
while put(words,pop(tokens))
}
#
# get ready for main processing
#
matrix := table(" ")
pass := 0
completed := 0
&random:= map(&clock,":","0")
#
# here's the actual word placement rouinte
#
every word := !words do place(word)
#
# fill in the unchosen areas with random alphas
#
every i := 1 to height do
every j := 1 to width do
if matrix[i||","||j] == " " then
matrix[i||","||j] := ?(&ucase)
#
# output results (for the test giver, words are lcase, noise is ucase)
#
write(completed," words inserted out of ",*words," words.\n")
write("\nNow for the puzzle you've been waiting for! (ANSWER)\n")
every i := 1 to height do
{
every j := 1 to width do writes(matrix[i||","||j]," ")
write()
}
#
# output results (for the test taker, everything is upper case
#
write("\fNow for the puzzle you've been waiting for! (PUZZLE)\n")
every i := 1 to height do
{
every j := 1 to width do writes(map(matrix[i||","||j],&lcase,&ucase)," ")
write()
}
end
#
# this procedure tries to place the word in a copy of the matrix
# if successful the updated copy is moved into the original
# if not, the problem word is skipped after 20 tries
#
procedure place(str)
local byte, construct, direction, item, pass, x, xinc, y, yinc
static xstep,ystep
initial {
xstep := [0,1,1,1,0,-1,-1,-1]
ystep := [-1,-1,0,1,1,1,0,-1]
}
pass := 0
repeat {
if (pass +:= 1) > 20 then
{
write("skipping ",str)
fail
}
direction := ?8
xinc := integer(xstep[direction])
yinc := integer(ystep[direction])
if xinc < 0 then x := *str + ?(width - *str)
if xinc = 0 then x := ?height
if xinc > 0 then x := ?(width - *str)
if yinc < 0 then y := *str + ?(height - *str)
if yinc = 0 then y := ?width
if yinc > 0 then y := ?(height - *str)
if (x < 1) | (y < 1) then stop(str," too long.")
construct := copy(matrix)
item := str
write("placing ",item)
every byte := !item do
{
if (construct[x||","||y] ~== " ") &
(construct[x||","||y] ~== byte) then break next
construct[x||","||y] := byte
x +:= xinc
y +:= yinc
}
matrix := copy(construct)
completed +:= 1
return "ok"
} # end repeat
return "ok"
end
#
# parse a string into a list with respect to a delimiter (cset)
#
procedure parse(line,delims)
local tokens
static chars
chars := &cset -- delims
tokens := []
line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
return tokens
end
|
