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
|
############################################################################
#
# File: imgpaper.icn
#
# Subject: Program to tile images to form wallpaper
#
# Author: Ralph E. Griswold
#
# Date: July 14, 2002
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This program tiles images to fill a window.
#
# The supported options are:
#
# -s read image strings from standard input; default, use
# image file names given on command line
# -p read BLPs from standard input; default as for -s
# -w i window width, default 640
# -h i window height, default 480
# -g r gamma; default to Icon default
# -m manual mode; wait for event before going to next image
# -a i automatic mode (default); hold pane for i seconds, default 2
# -l list names of files on standard output
# -i save GIF file of each image
# -n s prefix for image names, default "paper"
# -b fill window with black at end and hold for event
# -v size for video recording, 342x240; overrides other settings
# -M mirror image before tiling
#
# In the case of the -m option for images, if the event is a letter, the
# letter, a colon, and current image name is printed to standard output.
# In case of the -m option for image strings, if the event is a letter,
# the image string is written.
#
############################################################################
#
# Requires: Version 9 graphics
#
############################################################################
#
# Links: imsutils, mirror, options, tiler, xio
#
############################################################################
link imsutils
link mirror
link options
link tiler
link xio
procedure main(args)
local opts, w, h, hold, names, name, prefix, images, count, number
local lines, ims, bad, Hold, mir, background, e, gamma, tmp1, tmp2
local rows, blp
Hold := Event
opts := options(args, "w+h+g.ma+lispn:bvM")
w := \opts["w"] | 640
h := \opts["h"] | 480
mir := \opts["M"]
if \opts["v"] then { # size for video recording
w := 320
h := 240
}
background := opts["b"]
if /opts["m"] then Event := 1
hold := (\opts["a"] * 1000.0) | 2000
names := opts["l"]
images := opts["i"]
prefix := \opts["n"] | "paper"
if (gamma := \opts["g"]) & (gamma <= 0.0) then
stop("gamma value must be greater than 0.0")
number := 0
count := -1
WOpen("size=" || w || "," || h, "fillstyle=textured") |
stop("*** cannot open window")
WAttrib("gamma="|| \opts["g"])
if \background then Hold()
if \opts["s"] then { # image strings
while ims := readims() do {
tileims(&window, ims) | {
write(&errout, "*** cannot draw image")
/bad := open("bad.ims", "a") | stop("*** cannot open bad.ims")
write(bad, ims)
}
WFlush()
if \lines then write(number +:= 1)
if Event === 1 then delay(hold) else {
if Event() === !&letters then write(ims)
}
EraseArea()
}
}
else if \opts["p"] then { # BLPs
while blp := read() do {
rows := pat2rows(blp)
ims := *rows[1] || ",g2,"
every ims ||:= !rows
tileims(&window, ims) | {
write(&errout, "*** cannot draw image")
/bad := open("bad.ims", "a") | stop("*** cannot open bad.ims")
write(bad, ims)
}
WFlush()
if \lines then write(number +:= 1)
if Event === 1 then delay(hold) else {
e := Event()
write(!&letters === e, ":", blp)
}
EraseArea()
}
}
else {
every name := !args do {
WAttrib("label=" || name)
if \mir then {
tmp1 := WOpen("image=" || name, "canvas=hidden")
tmp2 := mirror(tmp1)
tile(tmp2, &window)
WClose(tmp1)
WClose(tmp2)
}
else tileimg(&window, name)
if \names then write(name)
if \images then WriteImage(prefix || right(count +:= 1, 3, "0") ||
".gif")
if Event === 1 then delay(hold) else {
e := Event()
write(!&letters === e, ":", name)
}
EraseArea()
}
}
if \background then { # fill with black and hold?
FillRectangle()
Hold()
}
end
#
# Produce a list of the rows of a pattern
procedure pat2rows(pattern)
local rlist
rlist := []
every put(rlist, rowbits(pattern))
return rlist
end
|
