diff options
Diffstat (limited to 'ipl/gprogs/imgpaper.icn')
| -rw-r--r-- | ipl/gprogs/imgpaper.icn | 163 |
1 files changed, 163 insertions, 0 deletions
diff --git a/ipl/gprogs/imgpaper.icn b/ipl/gprogs/imgpaper.icn new file mode 100644 index 0000000..eaf39c1 --- /dev/null +++ b/ipl/gprogs/imgpaper.icn @@ -0,0 +1,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 |