Initial upstream version 9.4.3upstream/9.4.3

173 files changed, 30874 insertions, 0 deletions

diff --git a/ipl/gprogs/autotile.icn b/ipl/gprogs/autotile.icn
new file mode 100644
index 0000000..631e9b6
--- /dev/null
+++ b/ipl/gprogs/autotile.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     autotile.icn
+#
+#	Subject:  Program to produce tile from XBM image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates a tile of a specified size by processing an
+#  XBM image file.  The tile grid is "laid over" the image to form squares.
+#
+#  The non-white pixels in each square of the image are counted. If the
+#  percentage of non-white pixels exceeds a specified threshold, the
+#  corresponding bit in the tile is set.
+#
+#  The supported options are:
+#
+#	-h i	tile height, default 32
+#	-w i	tile width, default 32
+#	-t r	threshold, default 0.50
+#
+############################################################################
+#
+#  Links:  options, patutils
+#
+############################################################################
+
+link options
+link patutils
+
+global pixmap
+
+procedure main(args)
+   local x, y, pixels, i, j, size, rows, wcell, hcell
+   local opts, input, w, h, t, xoff, yoff
+
+   opts := options(args, "t.h+w+")
+
+   input := open(args[1]) | stop("*** cannot open input file")
+
+   pixmap := []					# image array
+
+   every put(pixmap, xbm2rows(input))
+
+   w := \opts["w"] | 32
+   h := \opts["h"] | 32
+   t := \opts["t"] | 0.50
+
+   wcell := *pixmap[1] / w
+   hcell := *pixmap / h
+   
+   size := real(wcell * hcell)
+
+   rows := list(h, repl("0", w))		# tile
+
+   x :=  0
+
+   every i := 1 to w do {
+      y := 0
+      every j := 1 to h do {
+         pixels := 0
+         xoff := x + 1
+         every 1 to wcell do {
+            yoff := y + 1
+            every 1 to hcell do {
+               every pixels +:=  pixmap[yoff, xoff]
+               yoff +:= 1
+               }
+            xoff +:= 1
+            }
+         if pixels / size > t then rows[j, i] := "1"
+         y +:= hcell
+         }
+      x +:= wcell
+      }
+
+   write(rows2pat(rows))
+   
+end
diff --git a/ipl/gprogs/binpack.icn b/ipl/gprogs/binpack.icn
new file mode 100644
index 0000000..0bc066d
--- /dev/null
+++ b/ipl/gprogs/binpack.icn
@@ -0,0 +1,627 @@
+############################################################################
+#
+#	File:     binpack.icn
+#
+#	Subject:  Program to demonstrate some bin packing algorithms
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  binpack [window options]
+#
+#  Binpack illustrates several approximation algorithms for solving the
+#  one-dimensional bin packing problem.
+#
+#  For references, see the "info" screen.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: numbers, graphics, random, vsetup
+#
+############################################################################
+
+link numbers
+link graphics
+link random
+link vsetup
+
+$define Version "Binpack, Version 1.0  (September, 1993)"
+
+$define MAXK 250	# max value of `k' allowed
+
+$define FULL 61261200	# value representing a full bin
+			# (least common multiple of {1 to 18, 20, and 25})
+
+$define X0 120		# left edge of bin display
+$define DY 165		# vertical spacing
+$define YSCALE 155	# scaling for one display
+
+$define BX1 10		# x-coord for first button column
+$define BX2 60		# x-coord for second button column
+$define BWIDTH 40	# button width
+$define BHEIGHT 16	# button height
+$define BSPACE 16	# button spacing
+
+
+# parameter values
+global maxsize		# maximum piece size
+global nreload		# number of pieces on a reload
+global kvalue		# constant `k' used in some algorithms
+
+# current source set
+global pieces		# list of piece sizes
+global dx		# distance between bins
+global bwidth		# bin width
+global cdiv		# divisor for converting size to color index
+
+# current output parameters
+global bin		# list of current bin sizes
+global nfilled		# number of bins (partially) filled
+global xll, yll		# lower left corner of display area
+
+
+# miscellany
+global width		# window width
+global color		# array of GCs of different colors
+global glossary		# list of explanations
+
+
+
+#   Future possibilities:
+#
+#   better layout -- critical controls are too crowded
+#   add artificial delays for better visualization
+#   implement O(n log n) algs as such instead of O(n^2)
+#	n.b. this may not help because can't use Icon's native data structs
+
+
+
+#########################  main program  #########################
+
+procedure main(args)
+   local v, r, c, gc
+
+   randomize()				# set irreproducible mode
+
+   v := ui(args)			# open window, set up vib-built vidgets
+   r := v["root"]
+   glossary := []
+   addbutton(r, "BF", bestfit, "Best Fit", "picks the fullest possible bin")
+   addbutton(r, "WF", worstfit, "Worst Fit", "picks the emptiest bin")
+   addbutton(r, "AWF",nearworst,"Almost Worst Fit", "picks second-emptiest bin")
+   addbutton(r, "FF", firstfit, "First Fit", "picks the oldest possible bin")
+   addbutton(r, "LF", lastfit, "Last Fit", "picks the newest possible bin")
+   addbutton(r, "NF", nextfit, "Next Fit", "tries only the current bin")
+   addbutton(r, "N(k)", nextk, "Next-k Fit", "tries the k newest bins")
+   addbutton(r, "H(k)", harmonic, "Harmonic Algorithm",
+      "classifies into {1/1,1/2,...,1/k}")
+   addbutton(r, "G(k)", gxfit, "Group-X Fit", "groups into k equal classes")
+   VResize(r)
+
+   # workaround freeing of gray highlight color seen with "binpack -Bwhite"
+   BevelReset()				# work around color freeing bug
+
+   color := []
+   if WAttrib("depth") = 1 then
+      put(color, &window)
+   else {
+      # make a set of colors for different bin heights
+      # note that exactly half are reds/yellows and half are blues & darker
+      every c := Blend(
+            "black", 1, "deep purple-magenta", 10, "cyan-blue",
+            1, "reddish-yellow", 11, "orange-red") do {
+         gc := Clone(&window)
+         Shade(gc, c)
+         put(color, gc)
+         }
+      color := copy(color)		# ensure contiguous
+      }
+
+   # keep the following initializations in sync with initial slider positionm
+   setmax(v["max"], 20)			# set maximum bin value
+   setbins(v["bins"], -100)		# set number of bins
+   setk(v["kval"], -10)			# set constant `k' value
+
+   reload()				# initialize random bins
+   status("")				# display bin count
+
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   r.V.event := 1			# disable screen erase on resize
+   GetEvents(r, leftover)		# enter event loop
+end
+
+
+#  addbutton -- add a button (and a D variant) on every shelf
+
+procedure addbutton(r, label, proc, name, defn)
+   local v, n, y
+   static yoff
+   initial yoff := 0
+
+   y := yoff +:= BSPACE
+   while (y +:= DY) < WAttrib("height") do {
+      Vbutton(r, BX1, y, r.win, label, pack, proc, V_RECT, BWIDTH, BHEIGHT)
+      Vbutton(r, BX2, y, r.win, label||"D", pack, proc, V_RECT, BWIDTH, BHEIGHT)
+      }
+   put(glossary, left(label, 6) || left(name, 20) || defn)
+   return
+end
+
+
+
+#########################  parameter setting  #########################
+
+#  These routines are called during initialization and in response to
+#  slider movement.
+
+
+#  setk(v, n) -- set value of constant `k', based on 1 - 100 slider scale
+
+procedure setk(v, n)
+   if n >= 0 then				# if slider call
+      n := integer(MAXK ^ ((n / 100.0) ^ 0.70))	# convert nonlinearly
+   else
+      n := -n					# initial call
+   kvalue := roundoff(n)
+   GotoXY(v.ax, v.ay + v.ah + 14)
+   WWrites(left("k=" || kvalue, 8))
+   return
+end
+
+
+#  setmax(v, n) -- set maxsize, based on 1 - 20 slider scale.
+
+procedure setmax(v, n)
+   local fract
+
+   fract := n / 20.0
+   maxsize := integer(fract * FULL)
+   GotoXY(v.ax, v.ay + v.ah + 14)
+   WWrites(" max size ", ((fract || "00") ? move(4)))
+   return
+end
+
+
+#  setbins(v, n) -- set number of bins, based on 1 - 100 slider scale
+
+procedure setbins(v, n)
+   local s, max
+
+   max := WAttrib("width") - 40 - X0		# max that will fit on screen
+   if &shift then				# allow more if shifted
+      max /:= 1.1 * (maxsize / (2.0 * FULL))
+
+   if n >= 0 then				# if slider call
+      n := integer(max ^ ((n / 100.0) ^ 0.40))	# convert nonlinearly
+   else
+      n := -n					# initial call
+   n <:= 5
+   n := roundoff(n, 5)				# convert to round number
+
+   nreload := n
+   s := center(nreload, 5)
+   GotoXY(v.ax + (v.aw - TextWidth(s)) / 2, v.ay + v.ah + 17)
+   WWrites(s)
+   return
+end
+
+
+#  roundoff(n) -- truncate n to a nice number divisible by m (at least)
+
+procedure roundoff(n, m)
+   local d
+
+   if n > 1000 then {
+      if n > 10000 then
+         d := 1000
+      else if n > 5000 then
+         d := 500
+      else
+         d := 100
+      }
+   else if n > 500 then
+      d := 50
+   else if n > 100 then
+      d := 10
+   else if n > 50 then
+      d := 5
+   n -:= n % \d
+   n -:= n % \m
+   return n
+end
+
+
+#########################  bin packing primitives  #########################
+
+
+#  empty(n) -- empty shelf n
+
+procedure empty(n)
+   bin := list(*pieces, 0)
+   nfilled := 0
+   xll := X0
+   yll := n * DY
+   EraseArea(xll, yll - DY + 1, , DY)
+   width := WAttrib("width")
+   return
+end
+
+
+#  place(p, b) -- add a piece of size p to bin b
+
+procedure place(p, b)
+   local o, t, x, y0, y1
+   static invfull
+   initial invfull := 1.0 / FULL
+
+   o := bin[b] | fail
+   if (t := o + p) > FULL then
+      fail
+   bin[b] := t
+   nfilled <:= b
+   if (x := xll + (b - 1) * dx) < width then {
+      y0 := integer(yll - YSCALE * o * invfull)
+      y1 := integer(yll - YSCALE * t * invfull) + 1
+      FillRectangle(color[p / cdiv + 1], x, y1, bwidth, 0 < (y0 - y1))
+      }
+   return
+end
+
+
+#  status(s) -- write string s and shelf population at end of output shelf
+
+procedure status(s)
+   local x
+
+   x := xll + nfilled * dx + 4
+   x >:= width - 40
+   GotoXY(x, yll - 15)
+   WWrites(s)
+   GotoXY(x, yll)
+   WWrites(nfilled)
+   return
+end
+
+
+
+#########################  source set manipulation  #########################
+
+
+#  reload() -- reload first shelf with random-sized pieces.
+
+procedure reload()
+   local i, j, z, p
+
+   pieces := list(nreload)
+   empty(1)
+   dx := (width - 40 - X0) / nreload
+   dx <:= 1
+   dx >:= 20
+   bwidth := 4 * dx / 5
+   bwidth <:= 1
+   cdiv := (maxsize + *color - 1) / *color
+   every place(pieces[i := 1 to *pieces] := ?maxsize, i)
+   status("new")
+   return
+end
+
+
+#  mix() -- randomly reorder the first shelf.
+#
+#  if shifted, place equally-spaced using golden ratio
+
+procedure mix()
+   local i, n, p
+
+   if &shift then {
+      n := integer(*pieces / &phi + 1)
+      while gcd(*pieces, n) > 1 do
+         n -:= 1
+      i := 0
+      every p := !sort(pieces) do {
+         i := (i + n) % *pieces
+         pieces[i + 1] := p
+         }
+      }
+   else
+      every i := *pieces to 2 by -1 do
+         pieces[?i] :=: pieces[i]
+
+   empty(1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("mix")
+   return
+end
+
+
+
+#  order() -- sort the first shelf in descending order
+#
+#  if shifted, sort ascending
+
+procedure order()
+   local i
+
+   pieces := sort(pieces)
+   if not &shift then
+      every i := 1 to *pieces / 2 do	# change from ascending to descending
+         pieces[i] :=: pieces[-i]
+
+   empty(1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("sort")
+   return
+end
+
+
+
+#########################  packing algorithms  #########################
+
+
+
+#  pack(x, v) -- execute packing algorithm connected with button x
+
+procedure pack(x, v)
+   local l, n, s, i
+
+   if x.ax = BX2 then {
+      l := sort(pieces)			# if second-column button, sort first
+      every i := 1 to *l/2 do		# change from ascending to descending
+         l[i] :=: l[-i]
+      }
+   else
+      l := copy(pieces)
+
+   n := x.ay / DY + 1			# compute shelf number
+   empty(n)				# clear the shelf
+
+   s := x.id(l)				# call packing algorithm
+   status(\s | x.s)			# display status
+   return
+end
+
+
+#  nextfit(l) -- pack using next-fit algorithm
+
+procedure nextfit(l)
+   local p
+
+   every p := !l do
+      place(p, nfilled | nfilled + 1)
+   return
+end
+
+
+#  nextk(l) -- pack using next-k-fit algorithm
+
+procedure nextk(l)
+   local p
+
+   every p := !l do
+      if nfilled <= kvalue then
+         place(p, 1 to nfilled + 1)
+      else
+         place(p, nfilled - kvalue + 1 to nfilled + 1)
+   return "N" || kvalue
+end
+
+
+#  firstfit(l) -- pack using first-fit algorithm
+
+procedure firstfit(l)
+   local p
+
+   every p := !l do
+      place(p, 1 to nfilled + 1)
+   return
+end
+
+
+#  lastfit(l) -- pack using last-fit algorithm
+
+procedure lastfit(l)
+   local p
+
+   every p := !l do
+      place(p, (nfilled to 1 by -1) | (nfilled + 1))
+   return
+end
+
+
+#  bestfit(l) -- pack using best-fit algorithm
+
+procedure bestfit(l)
+   local p, b, i, max, found
+
+   every p := !l do {
+      max := FULL - p			# fullest acceptable bin size
+      found := 0			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found <:= (max >= bin[i]) then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  worstfit(l, n) -- pack using worst-fit algorithm
+
+procedure worstfit(l, n)
+   local p, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found >:= bin[i] then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  nearworst(l, n) -- pack using almost-worst-fit algorithm
+
+procedure nearworst(l, n)
+   local p, a, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      a := b := &null
+      every i := 1 to nfilled do
+         if found >:= bin[i] then {
+            a := b
+            b := i
+            }
+      place(p, \a | \b | (nfilled + 1))	# place in second-best bin found
+      }
+   return
+end
+
+
+#  harmonic(l, n) -- pack using (unmodified) harmonic algorithm
+
+procedure harmonic(l, n)
+   local curr, maxv, i, p, b
+
+   curr := list(kvalue)			# current bin for each class
+   maxv := list(kvalue)			# maximum for each class
+   every i := 1 to kvalue do
+      maxv[i] := FULL / (kvalue - i + 1)
+
+   every p := !l do {
+      p <= maxv[i := 1 to kvalue]	# find class index i
+      b := curr[i]
+      if /b | (bin[b] + p > FULL) then
+         place(p, curr[i] := nfilled + 1)
+      else
+         place(p, b)
+      }
+   return "H" || kvalue
+end
+
+
+#  gxfit(l, n) -- pack using group-x(k)-fit algorithm
+
+procedure gxfit(l, n)
+   local stk, maxv, i, s, p, b, d
+
+   stk := []				# stacks of bins, one for each group
+   maxv := []				# maximum for each group
+
+   # make k equally sized groups
+   d := FULL / kvalue
+   every i := 1 to kvalue do {
+      put(stk, [])
+      put(maxv, i * d - 1)
+      }
+
+   every p := !l do {
+      # find group index i for piece
+      (p <= maxv[i := (1 to kvalue) | 0]) & (*stk[i] > 0)
+      b := pop(stk[i]) | (nfilled + 1)
+      place(p, b)
+      # now put bin back on a stack, if not too full
+      if (FULL - bin[b]) >= maxv[i := (kvalue - 1 to 1 by -1)] then
+         push(stk[i], b)
+      }
+   return "G" || kvalue
+end
+
+
+
+#########################  event miscellany  #########################
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:lucidasanstypewriter-bold-12::0,0,860,675:Bin Packing",],
+   ["bins:Slider:h::10,48,100,15:0,100,40",setbins],
+   ["infob:Button:regular::10,111,40,17:info",info],
+   ["kval:Slider:h::10,135,100,15:0,100,30",setk],
+   ["max:Slider:h::10,10,100,15:1,20,20",setmax],
+   ["mix:Button:regular::10,68,30,17:mix",mix],
+   ["new:Button:regular::80,68,30,17:new",reload],
+   ["quit:Button:regular::70,110,40,17:quit",quit],
+   ["sort:Button:regular::10,87,35,17:sort",order],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
+
+
+
+#  leftover() -- handle events that fall outside the vidgets
+#
+#  Exits when certain keys are pressed and ignores other events.
+
+procedure leftover(e)
+   case e of {
+      QuitEvents():	exit()
+      &meta & !"nN":	reload()
+      &meta & !"mM":	mix()
+      &meta & !"sS":	order()
+      &meta & !"iI":	info()
+      }
+   return
+end
+
+
+#  quit() -- handle "quit" button press
+
+procedure quit(x, v)
+   exit()
+end
+
+
+#  info() -- handle "info" button press
+
+procedure info(x, v)
+   static text
+   initial {
+      text := ["",
+         Version,
+         "by Gregg Townsend, The University of Arizona",
+         "",
+         "",
+         "Glossary:",
+         ""]
+      every put(text, "   " || !glossary)
+      put(text,
+         "",
+         "A `D' suffix indicates a variation where the input is sorted",
+         "in descending order before applying the algorithm.",
+         "",
+         "",
+         "For more information about bin packing algorithms, see:",
+         "",
+         "   `Approximation Algorithms for Bin-Packing -- An Updated Survey'",
+         "   by E.G. Coffman, Jr., M.R. Garey, and D.S. Johnson, in",
+         "   Algorithm Design for Computer System Design, ed. by",
+         "   Ausiello, Lucertini, and Serafini, Springer-Verlag, 1984",
+         "",
+         "   `Fast Algorithms for Bin Packing' by David S. Johnson,",
+         "   Journal of Computer and System Sciences 8, 272-314 (1974)",
+         "")
+      }
+   Notice ! text
+   return
+end
diff --git a/ipl/gprogs/bitdemo.icn b/ipl/gprogs/bitdemo.icn
new file mode 100644
index 0000000..d66802b
--- /dev/null
+++ b/ipl/gprogs/bitdemo.icn
@@ -0,0 +1,210 @@
+############################################################################
+#
+#	File:     bitdemo.icn
+#
+#	Subject:  Program to demonstrate bitplanes
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     bitdemo illustrates some of the techniques made available by the
+#  bitplane package in the program library.
+#
+#     The upper rectangle is drawn using three bitplanes, reserving
+#  one plane for each of the primary colors.  After clicking one of
+#  the "draw" or "erase" buttons, you can draw or erase any one of
+#  the bitplanes independently of the others.  Notice what happens
+#  when the colors overlap.
+#
+#     Drawing is not constrained to the rectangle so that you can see
+#  some of the possible consequences of using the bitplane routines
+#  improperly.
+#
+#     The lower rectangle is drawn using four other bitplanes, one each
+#  for the four types of objects.  Click once on a button to bring the
+#  objects of that type to the front.  Click a second time to make them
+#  invisible.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, bitplane, graphics
+#
+############################################################################
+
+link button
+link evmux
+link bitplane
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+
+global bitwin, rgbbase, panebase, panecolor
+
+
+procedure main(args)
+   local win, m, b, w, h, i
+   local px, py, pw, ph, x, y, d, a
+   local bw, bh
+   local colors
+
+   # get options and open window
+   win := Window("size=800,600", "font=Helvetica,bold,14", args)
+
+   # ensure that we can get the color map entries we will need
+   bitwin := Clone(win)
+   panebase := AlcPlane(bitwin, 4) | stop("can't get 4 planes")
+   rgbbase := AlcPlane(bitwin, 3) | stop("can't get 3 planes")
+
+   # get window geometry
+   m := WindowMargin			# margins
+   b := BevelWidth
+   w := WAttrib("width") - 2 * m	# usable width
+   h := WAttrib("height") - 2 * m	# usable height
+   bw := 80				# button width
+   bh := 24				# button height
+
+   # establish global sensors; override later with buttons etc. in some areas
+   sensor(win, &lpress, drag)
+   sensor(win, &ldrag, drag)
+   quitsensor(win)
+   button(win, "quit", argless, exit, m, m + h - bh, bw, bh)
+
+   # build drawing window and initialize with overlapping circles
+   BevelRectangle(win, m + 100, m, w - 100, 250, -b)
+   colors := [
+      Bg(win), "red", "yellow", "red-yellow",
+      "blue", "purple-magenta", "dark green", "dark brown"]
+   every i := 0 to 7 do
+      Color(bitwin, rgbbase + i, colors[i + 1])
+   PlaneOp(bitwin, rgbbase, "copy")
+   FillRectangle(bitwin, m + 100 + b, m + b, w - 100 - 2 * b, 250 - 2 * b)
+   PlaneOp(bitwin, rgbbase+4, "set"); FillArc(bitwin, w/2-25, 100, 100, 100)
+   PlaneOp(bitwin, rgbbase+2, "set"); FillArc(bitwin, w/2,     50, 100, 100)
+   PlaneOp(bitwin, rgbbase+1, "set"); FillArc(bitwin, w/2+25, 100, 100, 100)
+   Deplane(bitwin)
+
+   # set up related buttons
+   buttonrow(win, m, m, bw, bh, 0, bh + m,
+      "draw red", draw, 1,
+      "draw yel", draw, 2,
+      "draw blu", draw, 4,
+      &null, &null, &null,
+      "erase red", erase, 1,
+      "erase yel", erase, 2,
+      "erase blu", erase, 4,
+      )
+
+   # set up structure for pane demo
+   panecolor := table()
+   panecolor[0] := Bg(win)
+   px := m + 100
+   py := m + 250 + 2 * m
+   pw := m + w - px
+   ph := m + h - py
+   Fg(bitwin, panebase)
+   FillRectangle(bitwin, px, py, pw, ph)
+   BevelRectangle(win, px, py, pw, ph, -b)
+   Clip(bitwin, px + b, py + b, pw - 2 * b, ph - 2 * b)
+   buttonrow(win, m, py, bw, bh, 0, bh + m,
+      "visible:", &null, &null,
+      "grid", mvplane, 1,
+      "curves", mvplane, 8,
+      "squares", mvplane, 2,
+      "circles", mvplane, 4,
+      )
+
+   # draw grid on plane 1
+   FrontPlane(bitwin, panebase + 1, panecolor[1] := "light gray")
+   PlaneOp(bitwin, panebase + 1, "set")
+   every x := 20 to pw - 1 by 40 do
+      FillRectangle(bitwin, px + x, py + b, 3, ph - 2 * b)
+   every y := 20 to ph - 1 by 40 do
+      FillRectangle(bitwin, px + b, py + y, pw - 2 * b, 3)
+
+   # draw curves on plane 8
+   FrontPlane(bitwin, panebase + 8, panecolor[8] := "dark blue")
+   PlaneOp(bitwin, panebase + 8, "set")
+   every y := 20 to ph-40 by 30 do {
+      a := [bitwin]
+      every put(a, px + (0 to pw+24 by 25)) do
+         put(a, py + y + ?20)
+      every 1 to 3 do {
+         DrawCurve ! a
+         every a[3 to *a by 2] +:= 1
+         }
+      }
+
+   # draw squares on plane 2
+   FrontPlane(bitwin, panebase + 2, panecolor[2] := "dark brown")
+   PlaneOp(bitwin, panebase + 2, "set")
+   d := 20
+   every 1 to 50 do
+      FillRectangle(bitwin, px + ?(pw - d), py + ?(ph - d), d, d)
+
+   # draw circles on plane 4
+   FrontPlane(bitwin, panebase + 4, panecolor[4] := "dark moderate green")
+   PlaneOp(bitwin, panebase + 4, "set")
+   every 1 to 50 do {
+      d := 20 + ?10
+      FillArc(bitwin, px + ?(pw - d), py + ?(ph - d), d, d)
+      }
+
+   # enter event loop
+   Clip(bitwin)
+   evmux(win)
+end
+
+
+## draw(w, v) -- set plane and drawing op in response to "draw" button
+
+procedure draw(w, v)
+   PlaneOp(bitwin, rgbbase + v, "set")
+end
+
+
+## erase(w, v) -- set plane and drawing op in response to "erase" button
+
+procedure erase(w, v)
+   PlaneOp(bitwin, rgbbase + v, "clear")
+end
+
+
+## drag(w, dummy, x, y) -- handle mouse drag by drawing (or erasing) on window
+
+procedure drag(w, dummy, x, y)
+   FillRectangle(bitwin, x - 5, y - 5, 10, 10)
+end
+
+
+## mvplane(w, v, x, y) -- handle click on visibility buttons
+#
+#  first click moves to front
+#  second click makes invisible
+
+procedure mvplane(w, v, x, y)
+   static prev, rep
+   initial prev := rep := 0
+
+   if prev ~=:= v then
+      rep := 0				# this is a new button
+   else
+      rep := (rep + 1) % 2		# repeat count for old button
+
+   case rep of {
+      0:  FrontPlane(bitwin, panebase + v, panecolor[v])
+      1:  BackPlane(bitwin, panebase + v, panecolor[0])
+      }
+end
diff --git a/ipl/gprogs/blp2grid.icn b/ipl/gprogs/blp2grid.icn
new file mode 100644
index 0000000..7114168
--- /dev/null
+++ b/ipl/gprogs/blp2grid.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     blp2grid.icn
+#
+#	Subject:  Program to convert BLP drawdown to grid image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 26, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following options are supported:
+#
+#	-s i	size of cells; default 5
+#	-c s	color for filling cells; default black
+#
+#  Also handles row files.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, cells, convert, options, patutils, wopen
+#
+############################################################################
+
+link basename
+link cells
+link convert
+link options
+link patutils
+link wopen
+
+procedure main(args)
+   local rows, panel, input, line, name, opts, size, file, color
+
+   opts := options(args, "s+c:")
+
+   size := \opts["s"] | 5
+   color := \opts["c"] | "black"
+
+   while file := get(args) do {
+      input := open(file) | stop("*** cannot open pattern file")
+      rows := []
+      line := read(input) | stop("empty file")
+      if upto("#", line) then rows := pat2rows(line)
+      else {
+         rows := [line]
+         while put(rows, read(input))	# read in row pattern
+         }
+      panel := matrixpanel(rows, size)
+      fill_cells(panel, rows, color)
+      name := basename(file, ".blp")
+      name := basename(name, ".rows")
+      WriteImage(panel.window, name || "_grid.gif")
+      WClose(panel.window)
+      close(input)
+      }
+
+end
+
+procedure fill_cells(panel, rows, cellcolor)
+   local i, j, color
+
+   every i := 1 to *rows do {
+      every j := 1 to *rows[1] do {
+         color := if rows[i, j] == "1" then cellcolor else "white"
+         colorcell(panel, j, i, color)
+         } 
+      }
+
+   return
+
+end
diff --git a/ipl/gprogs/blp2rows.icn b/ipl/gprogs/blp2rows.icn
new file mode 100644
index 0000000..37a8825
--- /dev/null
+++ b/ipl/gprogs/blp2rows.icn
@@ -0,0 +1,38 @@
+############################################################################
+#
+#	File:     blp2rows.icn
+#
+#	Subject:  Program to convert bi-level pattern to row file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure main()
+   local rows
+
+   rows := pat2rows(read())
+
+   every write(!rows)
+
+end
diff --git a/ipl/gprogs/bme.icn b/ipl/gprogs/bme.icn
new file mode 100644
index 0000000..2131a00
--- /dev/null
+++ b/ipl/gprogs/bme.icn
@@ -0,0 +1,176 @@
+############################################################################
+# 
+#	File:     bme.icn
+# 
+#	Subject:  Program to edit bitmap
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  2.0
+#
+############################################################################
+#
+#     A bitmap editor.  This is really the PixMap editor
+# pme.icn with colors set to black and white, and color changes disabled.
+#
+#     Left and right mouse buttons draw black and white.
+# Press q or ESC to quit; press s to save.  Capital "S" prompts for
+# and saves under a new filename.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+global w, WIDTH, HEIGHT, XBM, LMARGIN
+global colors, colorbinds
+
+procedure main(argv)
+   local i, f, s, xpos, ypos, i8, j, j8, j8Plus, e, x, y
+   colors := [ "black", "white", "white" ]
+   i := 1
+   XBM := ".xbm"
+   WIDTH  := 32
+   HEIGHT := 32
+   if *argv>0 & argv[1][1:5]=="-geo" then {
+      i +:= 1
+      if *argv>1 then argv[2] ? {
+	 WIDTH := integer(tab(many(&digits))) | stop("geo syntax")
+	 ="x" | stop("geo syntax")
+	 HEIGHT := integer(tab(0)) | stop("geo syntax")
+	 i +:= 1
+	 }
+      }
+   LMARGIN := WIDTH
+   if LMARGIN < 65 then LMARGIN := 65
+   if (*argv >= i) & (f := open(s := (argv[i] | (argv[i]||XBM)))) then {
+      close(f)
+      w:= WOpen("label=BitMap", "image="||s, "cursor=off") |
+        stop("cannot open window")
+      WIDTH  <:= WAttrib(w, "width")
+      HEIGHT <:= WAttrib(w, "height")
+      pos := WAttrib(w, "pos")
+      pos ? {
+	 xpos := tab(many(&digits)) | stop(image(pos))
+	 =","
+	 ypos := tab(0)
+	 }
+      WAttrib(w, "posx="||xpos, "posy="||ypos,
+	      "width="||(WIDTH*8+LMARGIN+5), "height="||(HEIGHT*8))
+      Event(w)
+      every i := 0 to HEIGHT-1 do {
+	 i8 := i*8
+	 every j := 0 to WIDTH-1 do {
+	    j8 := j*8
+	    j8Plus := j8 + LMARGIN + 5
+	    CopyArea(w, w, j, i, 1, 1, j8Plus,   i8)
+	    CopyArea(w, w, j, i, 1, 1, j8Plus+1, i8)
+	    CopyArea(w, w, j8Plus, i8, 2, 1, j8Plus+2,i8)
+	    CopyArea(w, w, j8Plus, i8, 4, 1, j8Plus+4, i8)
+	    CopyArea(w, w, j8Plus, i8, 8, 1, j8Plus, i8+1)
+	    CopyArea(w, w, j8Plus, i8, 8, 2, j8Plus, i8+2)
+	    CopyArea(w, w, j8Plus, i8, 8, 4, j8Plus, i8+4)
+	    }
+	 }
+      }
+   else {
+      w:= WOpen("label=BitMap", "cursor=off", "width="||(LMARGIN+WIDTH*8+5),
+	 "height="||(HEIGHT*8+5)) |
+         stop("cannot open window")
+      }
+
+   colorbinds := [ XBind(w,"fg="||colors[1]),
+		   XBind(w,"fg="||colors[2]),
+		   XBind(w,"fg="||colors[3]) ]
+   every i := 1 to 3 do {
+      XDrawArc(w, 4+i*10, HEIGHT+68, 7, 22)
+      XFillArc(colorbinds[i], 5+i*10, HEIGHT+70, 5, 20)
+      }
+   DrawRectangle(w, 5, HEIGHT+55, 45, 60)
+   DrawRectangle(w, 25, HEIGHT+50, 5, 5)
+   DrawCurve(w, 27, HEIGHT+50,
+		 27, HEIGHT+47,
+		 15, HEIGHT+39,
+		 40, HEIGHT+20,
+		 25, HEIGHT+5)
+
+   Fg(w, "black")
+   every i := 0 to HEIGHT-1 do
+      every j := 0 to WIDTH-1 do
+         DrawRectangle(w, j*8+LMARGIN+5, i*8, 8, 8)
+
+   DrawLine(w, 0, HEIGHT, WIDTH, HEIGHT, WIDTH, 0)
+
+   repeat {
+      case e := Event(w) of {
+	 "q"|"\e": return
+	 "s"|"S": {
+	    if /s | (e=="S") then s := getfilename()
+	    write("saving image ", s, " with width ", image(WIDTH),
+		  " height ", image(HEIGHT))
+	    WriteImage(w, s, 0, 0, WIDTH, HEIGHT)
+	    }
+	 &lpress | &ldrag | &mpress | &mdrag | &rpress | &rdrag : {
+
+	    x := (&x - LMARGIN - 5) / 8
+	    y := &y / 8
+
+	    if (y < 0) | (y > HEIGHT-1) | (x > WIDTH) then next
+	    if (x < 0) then {
+#		 if &x < 21 then getacolor(1, "left")
+#		 else if &x < 31 then getacolor(2, "middle")
+#		 else getacolor(3, "right")
+#		 until Event(w) === (&mrelease | &lrelease | &rrelease)
+	       }
+	    else dot(x, y, (-e-1)%3)
+	    }
+	 }
+      }
+end
+
+#procedure getacolor(n, s)
+#  wtmp := WOpen("label=" || labelimage(s||" button: "), "lines=1") |
+#     stop("can't open temp window")
+#  writes(wtmp,"[",colors[n],"] ")
+#  theColor := read(wtmp) | stop("read fails")
+#  close(wtmp)
+#  wtmp := colorbinds[n] | stop("colorbinds[n] fails")
+#  Fg(wtmp, theColor) | write("XFG(", theColor, ") fails")
+#  XFillArc(wtmp, 5+n*10, HEIGHT+70, 5, 20)
+#  colors[n] := theColor
+#end
+
+procedure dot(x, y, color)
+   if (x|y) < 0 then fail
+   FillRectangle(colorbinds[color+1], x*8+LMARGIN+5, y*8, 8, 8)
+   DrawPoint(colorbinds[color+1], x, y)
+   DrawRectangle(w, x*8+LMARGIN+5, y*8, 8, 8)
+end
+
+procedure getfilename()
+   local s, pos, wprompt, rv
+   pos := "pos="
+   every s := QueryPointer() do pos||:= (s-10)||","
+   wprompt := WOpen("lable=Enter a filename to save the pixmap",
+		   "font=12x24", "lines=1", pos[1:-1]) | stop("can't xprompt")
+   rv := read(wprompt)
+   close(wprompt)
+   if not find(XBM, rv) then rv ||:= XBM
+   return rv
+end
diff --git a/ipl/gprogs/bpack.icn b/ipl/gprogs/bpack.icn
new file mode 100644
index 0000000..1a01764
--- /dev/null
+++ b/ipl/gprogs/bpack.icn
@@ -0,0 +1,435 @@
+############################################################################
+#
+#	File:     bpack.icn
+#
+#	Subject:  Program to demonstrate some bin packing algorithms
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 7, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  bpack [window options]
+#
+#  Bpack illustrates several approximation algorithms for solving the
+#  one-dimensional bin packing problem.
+#
+#  For a discussion of this program, see
+#	http://www.cs.arizona.edu/icon/oddsends/bpack/bpack.htm
+#
+#  For references, see the "about" screen.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: numbers, graphics, random, vsetup
+#
+############################################################################
+
+
+
+link numbers
+link graphics
+link random
+link vsetup
+
+$define Version "Binpack Lite (November, 1997)"
+
+$define FULL 61261200	# value representing a full bin
+			# (least common multiple of {1 to 18, 20, and 25})
+
+$define PieceWidth 6	# width of one piece
+$define BinWidth 7	# width of one bin
+
+
+
+# pieces
+global pieces		# list of piece sizes
+
+# current output parameters
+global xll, yll		# display origin
+global bin		# list of current bin sizes
+global nfilled		# number of bins (partially) filled
+
+# colors
+global color		# array of GCs of different colors
+global cscale		# conversion from piece size to color index
+
+# display regions
+global shelf1		# input segments
+global shelf2		# packed bins
+
+
+
+#########################  main program  #########################
+
+procedure main(args)
+   local v, r, c, gc
+
+   randomize()				# set irreproducible mode
+
+   v := ui(args)			# open window, set up vib-built vidgets
+   r := v["root"]
+   shelf1 := v["shelf1"]
+   shelf2 := v["shelf2"]
+   if shelf1.uw ~= shelf2.uw | shelf1.uw ~= shelf2.uw then
+      runerr(500, "inconsistent layout")
+
+   # make a set of colors for different bin heights
+   # note that exactly half are reds/yellows and half are blues & darker
+   color := []
+   every c := Blend(
+         "black", 1, "deep purple-magenta", 10, "cyan-blue",
+         1, "reddish-yellow", 11, "orange-red") do {
+      gc := Clone(&window)
+      Fg(gc, c)
+      put(color, gc)
+      }
+   color := copy(color)			# ensure contiguous array
+   cscale := *color / real(FULL + 1)
+
+   reload()				# initialize random bins
+   GetEvents(r)				# enter event loop
+end
+
+
+
+#########################  bin packing primitives  #########################
+
+
+#  prepare(v) -- prepare shelf v for placing pieces
+
+procedure prepare(v)
+   xll := v.ux
+   yll := v.uy + v.uh
+   bin := list(*pieces, 0)
+   nfilled := 0
+   EraseArea(v.ux, v.uy, v.uw, v.uh)
+   return
+end
+
+
+#  place(p, b) -- add a piece of size p to bin b
+
+procedure place(p, b)
+   local o, t, x, y0, y1
+   static m
+   initial m := shelf1.uh / real(FULL)
+
+   o := bin[b] | fail
+   if (t := o + p) > FULL then
+      fail
+   bin[b] := t
+   nfilled <:= b
+
+   x := xll + (b - 1) * (PieceWidth + 1)
+   y0 := integer(yll - m * o)
+   y1 := integer(yll - m * t) + 1
+   FillRectangle(color[cscale * p + 1], x, y1, PieceWidth, 0 < (y0 - y1))
+   return
+end
+
+
+#  status(s) -- write string s and shelf population at end of output shelf
+
+procedure status(s)
+   local x
+
+   x := xll + nfilled * BinWidth + 4
+   x >:= xll + shelf1.uw - TextWidth("000 ")
+   GotoXY(x, yll - WAttrib("leading") - WAttrib("descent"))
+   WWrites(s)
+   GotoXY(x, yll - WAttrib("descent"))
+   WWrites(nfilled)
+   return
+end
+
+
+
+#########################  source set manipulation  #########################
+
+
+#  reload() -- reload first shelf with random-sized pieces.
+
+procedure reload()
+   local i, j, z, p
+
+   pieces := list(shelf1.uw / BinWidth)
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces] := ?FULL, i)
+   status("")
+   return
+end
+
+
+
+#  mix() -- randomly reorder the first shelf.
+
+procedure mix()
+   local i
+
+   every i := *pieces to 2 by -1 do
+      pieces[?i] :=: pieces[i]
+
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#  regular() -- place equally-spaced using golden ratio
+
+procedure regular()
+   local i, n, p
+
+   n := integer(*pieces / &phi + 1)
+   while gcd(*pieces, n) > 1 do
+      n -:= 1
+   i := 0
+   every p := !sort(pieces) do {
+      i := (i + n) % *pieces
+      pieces[i + 1] := p
+      }
+
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#  ascending() -- sort the first shelf in ascending order
+
+procedure ascending()
+   local i
+
+   pieces := sort(pieces)
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#  descending() -- sort the first shelf in descending order
+
+procedure descending()
+   local i
+
+   pieces := sort(pieces)
+   every i := 1 to *pieces / 2 do	# change from ascending to descending
+      pieces[i] :=: pieces[-i]
+
+   prepare(shelf1)
+   every place(pieces[i := 1 to *pieces], i)
+   status("")
+   return
+end
+
+
+
+#########################  packing algorithms  #########################
+
+
+#  nextfit(l) -- pack using next-fit algorithm
+
+procedure nextfit(l)
+   local p
+
+   every p := !l do
+      place(p, nfilled | nfilled + 1)
+   return
+end
+
+
+
+#  firstfit(l) -- pack using first-fit algorithm
+
+procedure firstfit(l)
+   local p
+
+   every p := !l do
+      place(p, 1 to nfilled + 1)
+   return
+end
+
+
+#  lastfit(l) -- pack using last-fit algorithm
+
+procedure lastfit(l)
+   local p
+
+   every p := !l do
+      place(p, (nfilled to 1 by -1) | (nfilled + 1))
+   return
+end
+
+
+#  bestfit(l) -- pack using best-fit algorithm
+
+procedure bestfit(l)
+   local p, b, i, max, found
+
+   every p := !l do {
+      max := FULL - p			# fullest acceptable bin size
+      found := 0			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found <:= (max >= bin[i]) then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  worstfit(l, n) -- pack using worst-fit algorithm
+
+procedure worstfit(l, n)
+   local p, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      b := nfilled + 1			# index of where found
+      every i := 1 to nfilled do
+         if found >:= bin[i] then
+            b := i
+      place(p, b)			# place in best bin found
+      }
+   return
+end
+
+
+#  nearworst(l, n) -- pack using almost-worst-fit algorithm
+
+procedure nearworst(l, n)
+   local p, a, b, i, found
+
+   every p := !l do {
+      found := FULL - p			# size of best bin found so far
+      a := b := &null
+      every i := 1 to nfilled do
+         if found >:= bin[i] then {
+            a := b
+            b := i
+            }
+      place(p, \a | \b | (nfilled + 1))	# place in second-best bin found
+      }
+   return
+end
+
+
+
+#########################  event handling  #########################
+
+
+
+#  menu_cb(v, a) -- File and Reorder menu callback
+
+procedure menu_cb(v, a)
+   case a[1] of {
+      "About":		about()
+      "New":		reload()
+      "Quit":		exit()
+      "Random":		mix()
+      "Regular":	regular()
+      "Ascending":	ascending()
+      "Descending":	descending()
+      }
+end
+
+
+
+#  pack_cb(v, a) -- Pack menu callback
+
+procedure pack_cb(v, a)
+   local s, p
+
+   a[1] ? {
+      s := tab(upto(' '))		# get 2- or 3-letter name
+      }
+
+   prepare(shelf2)			# clear the shelf
+   p := copy(pieces)
+   case s of {
+      "FF":	firstfit(p)
+      "LF":	lastfit(p)
+      "NF":	nextfit(p)
+      "BF":	bestfit(p)
+      "WF":	worstfit(p)
+      "AWF":	nearworst(p)
+   }
+
+   status(s)
+   return
+end
+
+
+
+#  about() -- handle "about" menu entry
+
+procedure about(x, v)
+   static text
+   initial text := ["",
+         Version,
+         "by Gregg Townsend, The University of Arizona",
+         "",
+         "",
+         "BF   Best Fit           picks the fullest possible bin",
+         "WF   Worst Fit          picks the emptiest bin",
+         "AWF  Almost Worst Fit   picks second-emptiest bin",
+         "FF   First Fit          picks the oldest possible bin",
+         "LF   Last Fit           picks the newest possible bin",
+         "NF   Next Fit           tries only the current bin",
+         "",
+         "",
+         "For more information about bin packing algorithms, see:",
+         "",
+         "   `Approximation Algorithms for Bin-Packing -- An Updated Survey'",
+         "   by E.G. Coffman, Jr., M.R. Garey, and D.S. Johnson, in",
+         "   Algorithm Design for Computer System Design, ed. by",
+         "   Ausiello, Lucertini, and Serafini, Springer-Verlag, 1984",
+         "",
+         "   `Fast Algorithms for Bin Packing' by David S. Johnson,",
+         "   Journal of Computer and System Sciences 8, 272-314 (1974)",
+         ""]
+
+   Notice ! text
+   return
+end
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,400", "bg=pale gray", "label=Bin Packer"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,400:Bin Packer",],
+   ["file:Menu:pull::0,0,36,21:File",menu_cb,
+      ["About","New","Quit"]],
+   ["line:Line:::0,22,599,22:",],
+   ["pack:Menu:pull::93,0,36,21:Pack",pack_cb,
+      ["FF   first fit","LF   last fit","NF   next fit","BF   best fit","WF   worst fit",
+      "AWF  almost worst"]],
+   ["reorder:Menu:pull::36,0,57,21:Reorder",menu_cb,
+      ["Random","Regular","Ascending","Descending"]],
+   ["shelf1:Rect:sunken::12,34,576,170:",],
+   ["shelf2:Rect:sunken::12,217,576,170:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/breakout.icn b/ipl/gprogs/breakout.icn
new file mode 100644
index 0000000..28559f1
--- /dev/null
+++ b/ipl/gprogs/breakout.icn
@@ -0,0 +1,720 @@
+############################################################################
+#
+#	File:     breakout.icn
+#
+#	Subject:  Program for Breakout game
+#
+#	Author:   Nathan J. Ranks
+#
+#	Date:     September 3, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Breakout game
+#
+#  Infinite balls, Left or Right click to start or restart after losing ball
+#  9 levels - can select any level when not active using 1-9
+#  1 hit, 2 hit, 3 hit, and invincible blocks can be used for levels
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+
+link graphics 
+global sphere, blank     #sphere and blank sphere
+global X, Y              #coordinates of sphere
+global block_positions   #string of whether or not position has block
+global path, angle       #direction of sphere travel
+global wait              #pause interval used with delay()
+global level             #current level
+global hit               #sphere and block contact flag
+global blockclr1, blockclr2, blockclr3, invincclr
+
+procedure main()
+  local e
+  blockclr1 := "dark blue"     #default 1 hit block color
+  blockclr2 := "dark red"      #default 2 hit block color
+  blockclr3 := "dark green"    #default 3 hit block color
+  invincclr := "black"         #default invincible block color
+
+  WOpen("size=293,320") | stop("can't open window") 
+
+  sphere := "3,g16,~0~_
+                   000_
+                   ~0~"        #black sphere
+
+  blank  := "3,g16,~F~_
+                   FFF_
+                   ~F~"        #white sphere to erase
+
+  level := 1                   #default start level
+  create_blocks()              #as the name suggests
+
+  Fg("black")                  #default pad color
+  DrawLine(124,310,158,310)    #default pad position
+  DrawImage(140, 304, sphere)  #default sphere position
+  X := 140                     #default x position
+  Y := 304                     #default y position
+  path := "up_left"            #default sphere direction
+  angle := 60                  #default sphere angle
+  hit := 0
+
+repeat {
+  if e := Event() then {   
+    if ( e === &lpress ) then {
+      Fg("black")
+      DrawLine(124,310,158,310)    #reset default
+      DrawImage(140, 304, sphere)  #reset default
+      Y := 304                     #reset default
+      path := "up_left"            #reset default
+      angle := 60                  #reset default
+      hit := 0
+
+      X := &x
+      DrawImage(140, 304, blank)
+      move_pad()
+      move_sphere()
+    }
+    if ( e === &rpress ) then {
+      Fg("black")
+      DrawLine(124,310,158,310)    #reset default
+      DrawImage(140, 304, sphere)  #reset default
+      Y := 304                     #reset default
+      path := "up_right"           #reset default
+      angle := 60                  #reset default
+      hit := 0
+
+      X := &x
+      DrawImage(140, 304, blank)
+      move_pad()
+      move_sphere()
+    }
+    if ( e === "1" ) then {        #change to level 1
+      level := 1
+      create_blocks()
+    }
+    if ( e === "2" ) then {        #change to level 2
+      level := 2
+      create_blocks()
+    }
+    if ( e === "3" ) then {        #change to level 3
+      level := 3
+      create_blocks()
+    }
+    if ( e === "4" ) then {        #change to level 4
+      level := 4
+      create_blocks()
+    }
+    if ( e === "5" ) then {        #change to level 5
+      level := 5
+      create_blocks()
+    }
+    if ( e === "6" ) then {        #change to level 6
+      level := 6
+      create_blocks()
+    }
+    if ( e === "7" ) then {        #change to level 7
+      level := 7
+      create_blocks()
+    }
+    if ( e === "8" ) then {        #change to level 8
+      level := 8
+      create_blocks()
+    }
+    if ( e === "9" ) then {        #change to level 9
+      level := 9
+      create_blocks()
+    }
+  }
+}
+end
+
+
+
+#this keeps track of where the pad should be according
+#to where the mouse pointer is
+
+procedure move_pad()
+  &x := image(WAttrib("pointerx"))  #get pointer position
+  &y := image(WAttrib("pointery"))  #get pointer position
+  EraseArea(0,310,293,310)          #erease old pad
+  Fg("black")                       #make sure color is correct
+  DrawLine(&x-12,310,&x+12,310)     #draw new pad
+return
+end
+
+
+
+#this keeps track of sphere location and movement within the window.
+#hits on walls will change direction
+#hit on pad will change direction and possibly angle
+
+procedure move_sphere()
+wait := 9
+while ( Y < 312 ) do {
+  if ( path == "up_right" ) then {
+    delay(wait)
+    move_pad()
+    GO_UP_RIGHT()
+    hit := 0
+    if ( X > 285 ) then {
+      path := "up_left"
+    }
+    if ( Y < 0 ) then {
+      path := "down_right"
+    }
+  }
+  if ( path == "up_left" ) then {
+    delay(wait)
+    move_pad()
+    GO_UP_LEFT()
+    hit := 0
+    if ( X < 0 ) then {
+      path := "up_right"
+    }
+    if ( Y < 0 ) then {
+      path := "down_left"
+    }
+  }
+  if ( path == "down_right" ) then {
+    delay(wait)
+    move_pad()
+    GO_DOWN_RIGHT()
+    hit := 0
+    if ( X > 285 ) then {
+      path := "down_left"
+    }
+    if ( (Y = 303) | (Y = 304) | (Y = 305) ) then {
+      if ( ((X+1) < &x+13) & ((X+1) > &x-13) ) then {
+        path := "up_right"
+        if ( (X+1) > &x-13 ) then {
+          angle := 30
+        }
+        if ( (X+1) > &x-6 ) then {
+          angle := 60
+        }
+        if ( (X+1) > &x+6 ) then {
+          angle := 30
+        }
+      }
+    }
+  }
+  if ( path == "down_left" ) then {
+    delay(wait)
+    move_pad()
+    GO_DOWN_LEFT()
+    hit := 0
+    if ( X < 0 ) then {
+      path := "down_right"
+    }
+    if ( (Y = 303) | (Y = 304) | (Y = 305) ) then {
+      if ( ((X+1) < &x+13) & ((X+1) > &x-13) ) then {
+        path := "up_left"
+        if ( (X+1) > &x-13 ) then {
+          angle := 30
+        }
+        if ( (X+1) > &x-6 ) then {
+          angle := 60
+        }
+        if ( (X+1) > &x+6 ) then {
+          angle := 30
+        }
+      }
+    }
+  }
+}
+return
+end
+
+
+#these next 4 procedures move the sphere
+#and then check for block contact
+
+procedure GO_UP_RIGHT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+procedure GO_UP_LEFT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y - 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+procedure GO_DOWN_RIGHT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X + 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+procedure GO_DOWN_LEFT()
+  if ( angle = 30 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+  if ( angle = 60 ) then {
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+    DrawImage(X, Y, blank)
+    Y := Y + 1
+    DrawImage(X, Y, sphere)
+    DrawImage(X, Y, blank)
+    X := X - 1
+    DrawImage(X, Y, sphere)
+    block_check()
+    if ( hit = 1 ) then {
+      fix_blocks()
+      return
+    }
+  }
+return
+end
+
+
+
+#this draws the play fields according to what the levels
+#are defined as
+
+procedure create_blocks()
+  local x, y, z
+
+  if ( level > 9 ) then {
+    level := 1
+  }
+
+  #different play fields go here
+  if ( level = 1 ) then { #icon-squared
+    block_positions := "000000000000000000000000000000000000000100000000110100110111000001010010101110101101110101000000000000000111000001110010100000101001110000011100000000000000010101110110101110101001010000011101100101100000000100000000000000000000000000"
+  }
+  if ( level = 2 ) then { #alternate rows
+    block_positions := "111111111111100000000000001111111111111000000000000011111111111110000000000000111111111111100000000000001111111111111000000000000011111111111110000000000000111111111111100000000000001111111111111000000000000011111111111110000000000000"
+  }
+  if ( level = 3 ) then { #alternating columns
+    block_positions := "101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101101010101010110101010101011010101010101"
+  }
+  if ( level = 4 ) then { #heart
+    block_positions := "000100000100000101000101000100010100010010001010001001000101000100100001000010010000100001000100000001000010000000100001000000010000010000010000001000001000000010001000000000101000000000001000000000000100000000000010000000000000000000"
+  }
+  if ( level = 5 ) then { #checker board
+    block_positions := "101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010"
+  }
+  if ( level = 6 ) then { #filled up
+    block_positions := "111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111"
+  }
+  if ( level = 7 ) then { #diamond and a half
+    block_positions := "000001110000000001111100000001111111000001111111110001111111111101111111111111011111111111000111111111000001111111000000011111000000000111000000000001000000000001110000000001111100000001111111000001111111110001111111111101111111111111"
+  }
+  if ( level = 8 ) then { #misc multiple hits
+    block_positions := "11111111111111111111111111313131313131311111111111112121212121212X3X2X3X2X3X2X111111111111111111111111113131313131313111111111111112121212121213X2X3X2X3X2X31111111111111111111111111131313131313132121212121212X3X2X3X2X3X2X1111111111111"
+  }
+  if ( level = 9 ) then { #throw-rug
+    block_positions := "21111111111121211111111121112111111121111121111121111111211121111211112121111212111121111211121123211211111223X322111111223X32211111211232112111211112111121211112121111211112111211111112111112111112111111121112111111111212111111111112"
+  }
+
+
+  z := 1
+  y := 10
+  x := 10
+  while not ( y = 208 ) do {
+    while not ( x = 283 ) do {
+      if ( block_positions[z] == "0" ) then {
+        Fg("white")
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "1" ) then {
+        Fg(blockclr1)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "2" ) then {
+        Fg(blockclr2)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "3" ) then {
+        Fg(blockclr3)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "X" ) then {
+        Fg(invincclr)
+        FillRectangle(x,y,20,10)
+      }
+      z := z + 1
+      x := x + 21
+    }
+    x := 10
+    y := y + 11
+  }
+return
+end
+
+
+#this checks to see if the sphere contacts an edge
+#of a block, if so, it erases the block and changes
+#the sphere's direction accordingly
+#it also checks if level is finished
+
+procedure block_check()
+  local x, y, z, temp, temp2
+  z := 1
+  y := 10
+  x := 10
+  while not ( y = 208 ) do {
+    while not ( x = 283 ) do {
+      if ( (((X+1)>(x-1))&((X+1)<(x+21)))&(((Y+1)>(y-1))&((Y+1)<(y+11))) ) then {
+        if ( block_positions[z] == "X" ) then {
+          hit := 1
+          Fg(invincclr)
+          FillRectangle(x,y,20,10)
+          if ( path == "up_right" ) then {
+            if ( ((X+1)=x) ) then { #side hit
+              path := "up_left"
+            }
+            if ( ((Y+1)=(y+10)) ) then { #bottom hit
+              path := "down_right"
+            }
+            if ( ((X+1)=x)&((Y+1)=(y+10)) ) then { #diagonal hit
+              path := "down_left"
+            }
+          }
+          else {
+            if ( path == "up_left" ) then {
+              if ( ((X+1)=(x+20)) ) then { #side hit
+                path := "up_right"
+              }
+              if ( ((Y+1)=(y+10)) ) then { #bottom hit
+                path := "down_left"
+              }
+              if ( ((X+1)=(x+20))&((Y+1)=(y+10)) ) then { #diagonal hit
+                path := "down_right"
+              }
+            }
+            else {
+              if ( path == "down_left" ) then {
+                if ( ((X+1)=(x+20)) ) then { #side hit
+                  path := "down_right"
+                }
+                if ( ((Y+1)=y) ) then { #top hit
+                  path := "up_left"
+                }
+                if ( ((X+1)=(x+20))&((Y+1)=y) ) then { #diagonal hit
+                  path := "up_right"
+                }
+              }
+              else {
+                if ( path == "down_right" ) then {
+                  if ( ((X+1)=x) ) then { #side hit
+                    path := "down_left"
+                  }
+                  if ( ((Y+1)=y) ) then { #top hit
+                    path := "up_right"
+                  }
+                  if ( ((X+1)=x)&((Y+1)=y) ) then { #diagonal hit
+                    path := "up_left"
+                  }
+                }
+              }
+            }
+          }
+        }
+        if ( (block_positions[z] == "1") |
+             (block_positions[z] == "2") |
+             (block_positions[z] == "3") ) then {
+          hit := 1
+          if ( block_positions[z] == "1" ) then {
+            Fg("white")
+            FillRectangle(x,y,20,10)
+            block_positions[z] := "0"
+          }
+          if ( block_positions[z] == "2" ) then {
+            Fg(blockclr1)
+            FillRectangle(x,y,20,10)
+            block_positions[z] := "1"
+          }
+          if ( block_positions[z] == "3" ) then {
+            Fg(blockclr2)
+            FillRectangle(x,y,20,10)
+            block_positions[z] := "2"
+          }
+          if ( path == "up_right" ) then {
+            if ( ((X+1)=x) ) then { #side hit
+              path := "up_left"
+            }
+            if ( ((Y+1)=(y+10)) ) then { #bottom hit
+              path := "down_right"
+            }
+            if ( ((X+1)=x)&((Y+1)=(y+10)) ) then { #diagonal hit
+              path := "down_left"
+            }
+          }
+          else {
+            if ( path == "up_left" ) then {
+              if ( ((X+1)=(x+20)) ) then { #side hit
+                path := "up_right"
+              }
+              if ( ((Y+1)=(y+10)) ) then { #bottom hit
+                path := "down_left"
+              }
+              if ( ((X+1)=(x+20))&((Y+1)=(y+10)) ) then { #diagonal hit
+                path := "down_right"
+              }
+            }
+            else {
+              if ( path == "down_left" ) then {
+                if ( ((X+1)=(x+20)) ) then { #side hit
+                  path := "down_right"
+                }
+                if ( ((Y+1)=y) ) then { #top hit
+                  path := "up_left"
+                }
+                if ( ((X+1)=(x+20))&((Y+1)=y) ) then { #diagonal hit
+                  path := "up_right"
+                }
+              }
+              else {
+                if ( path == "down_right" ) then {
+                  if ( ((X+1)=x) ) then { #side hit
+                    path := "down_left"
+                  }
+                  if ( ((Y+1)=y) ) then { #top hit
+                    path := "up_right"
+                  }
+                  if ( ((X+1)=x)&((Y+1)=y) ) then { #diagonal hit
+                    path := "up_left"
+                  }
+                }
+              }
+            }
+          }
+          #check to see if field is clear for next level
+          #reset sphere back to below block height
+          temp := 1
+          temp2 := 0
+          while ( temp < 244 ) do {
+            if ( (block_positions[temp] == "1") |
+                 (block_positions[temp] == "2") |
+                 (block_positions[temp] == "3") ) then {
+              temp2 := 1
+              temp := 243
+            }
+            temp := temp + 1
+          }
+          if ( temp2 = 0 ) then {
+            level := level + 1
+            create_blocks()
+            DrawImage(X,Y,blank)
+            DrawImage(140, 304, sphere)
+            X := 140
+            Y := 304
+            path := "up_right"
+          }
+        }
+      }
+      z := z + 1
+      x := x + 21
+    }
+    x := 10
+    y := y + 11
+  }
+return
+end
+
+
+#this is an extra check to make sure the blocks stay completely filled
+#when the sphere moves out of a block, the DrawImage(X, Y, blank)
+#will draw a white sphere over the old sphere, this fixes blocks
+#periodically by being called every block hit in the 4 move sphere procedures
+
+procedure fix_blocks()
+  local x, y, z
+
+  z := 1
+  y := 10
+  x := 10
+  while not ( y = 208 ) do {
+    while not ( x = 283 ) do {
+      if ( block_positions[z] == "1" ) then {
+        Fg(blockclr1)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "2" ) then {
+        Fg(blockclr2)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "3" ) then {
+        Fg(blockclr3)
+        FillRectangle(x,y,20,10)
+      }
+      if ( block_positions[z] == "X" ) then {
+        Fg(invincclr)
+        FillRectangle(x,y,20,10)
+      }
+      z := z + 1
+      x := x + 21
+    }
+    x := 10
+    y := y + 11
+  }
+return
+end
diff --git a/ipl/gprogs/browser.icn b/ipl/gprogs/browser.icn
new file mode 100644
index 0000000..691f418
--- /dev/null
+++ b/ipl/gprogs/browser.icn
@@ -0,0 +1,137 @@
+############################################################################
+#
+#	File:     browser.icn
+#
+#	Subject:  Program to demonstrate file-navigation "dialog"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 10, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  navitrix, vsetup
+#
+############################################################################
+
+link navitrix
+link vsetup
+
+global pat_window
+global vidgets
+
+$define LineLength  75
+$define FileLength 500
+
+procedure main()
+   local root, root_cur
+
+   nav_init()
+   vidgets := ui()
+   pat_window := &window
+
+   root := vidgets["root"]
+
+   repeat {
+      root_cur := case Active() of {
+         pat_window   :  root
+         nav_window   :  nav_root
+         }
+      ProcessEvent(root_cur, , shortcuts)
+      case nav_state of {
+         &null   :  next
+         "Okay"  :  process_file()
+         }
+      nav_state := &null
+      }
+
+end
+
+procedure process_file()
+   local input, file_list
+   static list_vidget
+
+   initial list_vidget := vidgets["list"]
+
+   if nav_file[-1] == "/" then {	# directory
+      chdir(nav_file)
+      nav_refresh()
+      }
+
+   else {				# "plain" file
+      input := open(nav_file) | {
+         Notice("Cannot open " || image(nav_file) || ".")
+         fail
+         }
+      file_list := []
+      every put(file_list, left(entab(!input), LineLength)) \ FileLength
+      VSetItems(list_vidget, file_list)
+      close(input)
+      WAttrib(nav_window, "canvas=hidden")
+      }
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "find  @F"  :  find_file()
+      "quit  @Q"  :  exit()
+      }
+
+   return
+
+end
+
+procedure list_cb(vidget, value)
+
+   if /value then return		# deselection; no action
+
+   return
+
+end
+
+procedure find_file()
+
+   WAttrib(nav_window, "canvas=normal")
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "f"  :  find_file()
+      "q"  :  exit()
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=587,402", "bg=pale gray", "label=Browser"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,587,402:Browser",],
+   ["file:Menu:pull::0,3,36,21:File",file_cb,
+      ["find  @F","quit  @Q"]],
+   ["list:List:r::17,44,557,343:",list_cb],
+   ["menubar:Line:::0,26,585,26:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/ca21.icn b/ipl/gprogs/ca21.icn
new file mode 100644
index 0000000..7aded56
--- /dev/null
+++ b/ipl/gprogs/ca21.icn
@@ -0,0 +1,122 @@
+############################################################################
+#
+#	File:     ca21.icn
+#
+#	Subject:  Program to investigate cellular automata
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays the time-sequence development on one-dimensional
+#  cellular automata in which the state of a cell depends only on the
+#  two cells adjacent to it -- 2,1 automata.
+#
+#  See "Theory and Applications of Cellular Automata", Stephan Wolfram,
+#  World Scientific, 1986 for an explanation for the method and rule
+#  encoding.
+#
+#  The options supported are:
+#
+#	-r i	rule i, default 110
+#	-w i	width (number of cells), default 200
+#	-h i	height (number of time steps), default width
+#	-s	seed first row at random with <= width / 2 cells
+#	-R	randomize the run
+#	-e s	initialize first row with seeds at positions generated
+#		   by Icon expression e.
+#	-i s	save final image in file named s; default no image
+#	-H	use hidden window; if no image file specified, ca21.gif
+#		   is used
+#
+#  The -e option is powerful but somewhat strange.  For example, to
+#  seed every other cell in the first row, use
+#
+#	-e 'seq(1,2')
+#
+#  which generates 1, 3, 5, 7, ... and seeds those cells (cells are
+#  numbered starting at 1).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics; system(), pipes, /tmp for -e option
+#
+############################################################################
+#
+#  Links:  evallist, genrfncs, options, convert, random, wopen
+#
+############################################################################
+
+link evallist
+link genrfncs
+link options
+link convert
+link random
+link wopen
+
+procedure main(args)
+   local opts, rule, bits, binary, i, j, phi, width, height, v, old, new
+   local ilist, name, canvas
+
+   opts := options(args, "w+h+r+sRe:i:H")
+
+   width := \opts["w"] | 200
+   height := \opts["h"] | width
+   rule := \opts["r"] | 110
+   if \opts["R"] then randomize()
+   name := \opts["i"]
+   if \opts["H"] then {
+      canvas := "canvas=hidden"
+      /name := "ca21.gif"
+      }
+   else canvas := "canvas=normal"
+
+   WOpen(canvas, "width=" || width, "height=" || height) |
+      stop("*** cannot open window")
+
+   bits := create !right(exbase10(rule, 2), 8, "0")
+   binary := create ("1" | "0") || ("1" | "0") || ("1" | "0")
+
+   phi := table()
+
+   while phi[@binary] := @bits
+
+   new := repl("0", width)
+
+   if \opts["e"] then {
+      ilist := evallist(opts["e"], width, "seqfncs") |
+         stop("invalid initialization expression")
+      every i := !ilist do {
+         new[i] := "1"
+         DrawPoint(i- 1, 0)
+         }
+      }
+   else if \opts["s"] then {			# random, scattered seeds
+      every 1 to width / 2 do {
+         new[i := ?width] := "1"
+         DrawPoint(i - 1, 0)
+         } 
+      }
+   else {
+      new[width / 2] := "1"		# single, centered seed
+      DrawPoint(width / 2 - 1, 0)
+      }
+
+   every j := 2 to height do {
+      old := new
+      new := repl("0", width)
+      every i := 2 to width - 1 do {
+         new[i] := v := phi[old[i - 1 : i + 2]]
+         if v == "1" then DrawPoint(i - 1, j - 1)
+         }
+      }
+
+   WriteImage(\name)
+
+end
diff --git a/ipl/gprogs/calib.icn b/ipl/gprogs/calib.icn
new file mode 100644
index 0000000..6c97694
--- /dev/null
+++ b/ipl/gprogs/calib.icn
@@ -0,0 +1,95 @@
+############################################################################
+#
+#	File:     calib.icn
+#
+#	Subject:  Program to calibrate color monitor
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     The nonlinearity of a color display is often characterized by a
+#  "gamma correction" value; calib provides a crude method for determining
+#  this value for a particular monitor.  It displays two rectangles: one
+#  formed of alternating black and white scanlines and one formed of a
+#  single, solid color.  Move the slider until they match; the number
+#  displayed above the slider is the gamma-correction factor.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, graphics, options, optwindw, slider
+#
+############################################################################
+
+link button
+link evmux
+link graphics
+link options
+link optwindw
+link slider
+
+record boxdata(win, color, button)
+
+procedure main(args)
+   local opts, w, h, m, boxwidth, sliderwidth, textheight
+   local win, box, boxwin, boxcolor, y
+   local mingamma, defaultgamma, maxgamma
+
+   opts := options(args, winoptions())
+   /opts["W"] := 500
+   /opts["H"] := 400
+   /opts["M"] := -1
+   win := optwindow(opts, "cursor=off", "echo=off")
+   w := opts["W"]
+   h := opts["H"]
+   m := opts["M"]
+   textheight := 20
+   sliderwidth := 20
+   boxwidth := (w - 3 * m) / 2
+   if (h + 1) % 2 = 1 then
+      h -:= 1
+
+   mingamma := 1.0
+   defaultgamma := WAttrib(win, "gamma")
+   maxgamma := 5.0
+
+   boxwin := Clone(win)
+   Fg(boxwin, "black")
+   Bg(boxwin, "white")
+   EraseArea(boxwin, m, m, boxwidth, h)
+   every y := m to h + m by 2 do
+      DrawLine(boxwin, m, y, m + boxwidth, y)
+   boxcolor := NewColor(boxwin) | stop("can't allocate a mutable color")
+
+   # we use a do-nothing button for displaying the gamma value (!)
+   box := boxdata(boxwin, boxcolor,
+      button(win, "", &null, 0, m+w-sliderwidth, m, sliderwidth, textheight))
+   setgamma(win, box, defaultgamma)
+
+   Fg(boxwin, boxcolor)
+   FillRectangle(boxwin, m + boxwidth, m, boxwidth, h)
+   quitsensor(win)
+   slider(win, setgamma, box,
+      m + w - sliderwidth, 2 * m + textheight, sliderwidth, h - textheight - m,
+      mingamma, defaultgamma, maxgamma)
+   evmux(win)
+end
+
+procedure setgamma(win, box, gamma)
+   local v
+
+   buttonlabel(box.button, left(gamma + .05, 3))
+   WAttrib(box.win, "gamma=" || gamma)
+   Color(box.win, box.color, "gray")
+   return
+end
diff --git a/ipl/gprogs/cameleon.icn b/ipl/gprogs/cameleon.icn
new file mode 100644
index 0000000..e616d20
--- /dev/null
+++ b/ipl/gprogs/cameleon.icn
@@ -0,0 +1,300 @@
+############################################################################
+#
+#	File:     cameleon.icn
+#
+#	Subject:  Program to allow user to change colors in an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 19, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This application allows the user to change selected color in an image.
+#  The colors are displayed in a palette on the application window.
+#  Clicking on one brings up a color dialog in which the color can be
+#  adjusted.
+#
+#  The keyboard shortcuts are:
+#
+#	@O	open image			File menu
+#	@Q	quit the application		File menu
+#	@R	revert to original colors	Colors menu  
+#	@S	save image			File menu
+#
+#  Note:  "cameleon" is a variant spelling of "chameleon".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and mutable colors.
+#
+############################################################################
+#
+#  Links:  graphics, interact, numbers, tables
+#
+############################################################################
+
+link graphics
+link interact
+link numbers
+link tables
+
+global cellsize		# size of palette cell
+global colors		# mutable color list
+global count		# table of pixel counts
+global image_window	# window for user image
+global mutant		# image with mutable colors
+global orig_colors	# list of original colors
+global palette		# color selection palette
+global panel		# palette window
+global pixels		# number of pixels in image window
+global x_pos		# target location for mutant window
+global y_pos
+
+
+$define ColorRows	 8	# number of palette rows
+$define ColorCols	16	# number of palette columns
+
+procedure main()
+   local atts, vidgets
+
+   atts := ui_atts()
+   put(atts, "posx=0", "posy=0")
+
+   (WOpen ! atts) | stop("*** cannot open application window")
+
+   vidgets := ui()
+
+   x_pos := WAttrib("width") + 3 * WAttrib("posx")
+   y_pos := WAttrib("posy")
+
+   palette := vidgets["palette"]
+
+   cellsize := palette.uw / ColorCols
+
+   panel := Clone("bg=black", "dx=" || palette.ux, "dy=" || palette.uy)
+   Clip(panel, 0, 0,  palette.uw, palette.uh)
+
+   clear_palette()
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+#  Set up empty palette grid
+
+procedure clear_palette()
+   local x, y
+
+   Fg(panel, "black")
+   EraseArea(panel)
+   WAttrib(panel, "fillstyle=textured")
+   Pattern(panel, "checkers")
+   Bg(panel, "very dark gray")
+
+   every x := 1 + (0 to ColorCols) * cellsize do
+      every y := 1 + (0 to ColorRows) * cellsize do
+         FillRectangle(panel, x, y, cellsize - 1, cellsize - 1)
+
+   WAttrib(panel, "fillstyle=solid")
+   Bg(panel, "black")
+
+   return
+ 
+end
+
+# Handle File menu
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open   @O"  :  image_open()
+      "quit   @Q"  :  quit()
+      "revert @R"  :  image_revert()
+      "save   @S"  :  snapshot(mutant)
+      }
+
+   return
+
+end
+
+# Open new image
+
+procedure image_open()
+   local i, x, y
+
+   WClose(\image_window)
+
+   repeat {
+      if OpenDialog("Open image:") == "Cancel" then fail
+      image_window := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open image.")
+         next
+         }
+      break
+      }
+
+   mutate(image_window) | fail
+
+   Raise()			# bring application window to front
+
+   colors := vallist(copy(orig_colors))
+
+   clear_palette()
+
+   i := 0
+
+   every y := 1 + (0 to ColorRows - 1) * cellsize do
+      every x := 1 + (0 to ColorCols - 1) * cellsize do {
+         Fg(panel, colors[i +:= 1]) | break break
+         FillRectangle(panel, x, y, cellsize - 1, cellsize - 1)
+         }
+
+   return
+
+end 
+
+#  Save current image
+
+procedure image_save()
+
+   snapshot(\mutant)
+
+   return
+
+end
+
+#  Restore original image colors
+
+procedure image_revert()
+   local old, color
+
+   every old := key(orig_colors) do {
+      color := orig_colors[old]
+      Color(panel, color, old)
+      }
+
+   return
+
+end
+
+# Get mutable colors and window from image
+
+procedure mutate()
+   local c, width, height, n, x, y
+
+   WClose(\mutant)
+
+   orig_colors := table()
+   count := table(0)
+
+   width := WAttrib(image_window, "width")
+   height := WAttrib(image_window, "height")
+
+   pixels := width * height
+
+   mutant := WOpen("width=" || width, "height=" || height,
+      "posx=" || x_pos, "posy=" || y_pos) | {
+         Notice("Cannot open image_window for mutant colors.")
+         fail
+         }
+
+   every y := 0 to height - 1 do {
+      x := 0
+      every c := Pixel(image_window, 0, y, width, 1) do {
+         if not(n := \orig_colors[c]) then {
+            orig_colors[c] := n := NewColor(c) | {
+               Notice("Cannot get mutable color.")
+               WClose(mutant)
+               fail
+               }
+            }
+         count[n] +:= 1
+         Fg(mutant, n)
+         DrawPoint(mutant, x, y)
+         x +:= 1
+         }
+      }
+
+   return
+
+end
+
+# Handle callbacks on palette
+
+procedure palette_cb(vidget, e, x, y)
+   local color, new
+
+   if e === (&lpress | &mpress | &rpress) then {
+      color := Pixel(x, y, 1, 1)		# get pixel color
+      if not integer(color) then fail		# not a mutable color
+      new := Color(panel, color)		# get color specification
+      if ColorDialog(
+         "Adjust color (" || count[color] || " pixels, " ||
+            frn((100.0 * count[color]) / pixels, , 2) || "%):",
+          Color(panel, color),
+          track,
+          color
+          ) == "Okay" then new := dialog_value
+      Color(panel, color, new)
+      Color(mutant, color, new)
+      }
+
+   return
+
+end
+
+#  Quit the application
+
+procedure quit()
+
+   snapshot(\mutant)
+
+   exit()
+
+end
+
+#  Handle keyboard shortcuts
+
+procedure shortcuts(e)
+
+   if &meta then case(map(e)) of {
+      "o"  :  image_open()
+      "q"  :  quit()
+      "r"  :  image_revert()
+      "s"  :  image_save()
+      }
+
+   return
+
+end
+
+#  Track the color in the color dialog
+
+procedure track(color, s)
+
+   Color(panel, color, s)
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=355,225", "bg=pale gray", "label=chameleon"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,355,225:chameleon",],
+   ["file:Menu:pull::1,0,36,21:File",file_cb,
+      ["open   @O","save   @S","revert @R","quit   @Q"]],
+   ["menubar:Line:::0,21,357,21:",],
+   ["palette:Rect:invisible::19,41,320,160:",palette_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/chernoff.icn b/ipl/gprogs/chernoff.icn
new file mode 100644
index 0000000..27810ef
--- /dev/null
+++ b/ipl/gprogs/chernoff.icn
@@ -0,0 +1,169 @@
+############################################################################
+#
+#	File:     chernoff.icn
+#
+#	Subject:  Program to imitate a Chernoff face
+#
+#	Author:   Jon Lipp
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays a Chernoff face.
+#
+############################################################################
+#
+#  Links:  options, vidgets, vscroll, vbuttons, wopen, xcompat
+#
+############################################################################
+
+link options
+link vidgets, vscroll, vbuttons
+link wopen
+link xcompat
+
+global FH
+
+procedure main(args)
+local opts, font, wid, h
+local root, win, s1, s2, s3, s4, s5
+
+   opts := options(args, "f:wh")
+   font := \opts["f"]
+   wid := \opts["w"]
+   h := \opts["h"]
+
+   win := WOpen("label=popup dialogs demo",
+      "size="  ||  (\wid | 425)  ||  "," || (\h | 325)) |
+      stop("*** can't open window")
+
+   root := Vroot_frame(win)
+
+   FH := WAttrib(win, "fheight")
+
+   s1 := Vhoriz_scrollbar(root, 0, 50, win, eyes, 1, 90, , 10, 99, 1)
+   s2 := Vhoriz_scrollbar(root, 0, 100, win, pupils, 2, 90, , 10, 99, 1)
+   s3 := Vhoriz_scrollbar(root, 0, 150, win, nose, 2, 90, , 0, 25, 1)
+   s4 := Vhoriz_scrollbar(root, 0, 200, win, smile, 2, 90, , 47, 32, 1)
+   s5 := Vhoriz_scrollbar(root, 0, 250, win, face, 2, 90, , 250, 300, 1)
+
+#   Vpane(root, 100, 10, win, , , 200, 200)
+
+   VResize(root)
+   put_label(root, s1, "eyes")
+   put_label(root, s2, "pupils")
+   put_label(root, s3, "nose")
+   put_label(root, s4, "smile")
+   put_label(root, s5, "face")
+   eyes(s1.thumb, s1.callback.value)
+   pupils(s2.thumb, s2.callback.value)
+   nose(s3.thumb, s3.callback.value)
+   smile(s4.thumb, s4.callback.value)
+   face(s5.thumb, s5.callback.value)
+
+   GetEvents(root, quit)
+end
+
+
+procedure quit(e)
+   if e === "q" then stop()
+end
+
+procedure write_val(vid, val)
+   GotoXY(vid.win, vid.ax-10, vid.ay-5)
+   writes(vid.win, val||"  ")
+end
+
+procedure put_label(root, sc, str)
+   local x, l
+
+   l := TextWidth(root.win, str)
+   x := sc.ax+sc.aw-l
+   VDraw(Vmessage(root, x, sc.ay-5-FH, root.win, str))
+end
+
+procedure face(vid, val)
+   local x1, y, x
+   static faceval, ox1, oy
+
+   write_val(vid, val)
+   x1 := 250 - val/2
+   y := 150 - val/2
+   rev_on(vid.win)
+   XDrawArc(vid.win, \ox1, \oy, \faceval, \faceval)
+   rev_off(vid.win)
+   XDrawArc(vid.win, x1, y, val, val)
+   faceval := val
+   ox1 := x1; oy := y
+end
+
+procedure eyes(vid, val)
+   local x1, x2, y
+   static eyeval, ox1, ox2, oy
+
+   write_val(vid, val)
+   x1 := 200 - val/2
+   x2 := 300 - val/2
+   y := 100 - val/2
+   rev_on(vid.win)
+   XDrawArc(vid.win, \ox1, \oy, \eyeval, \eyeval)
+   XDrawArc(vid.win, \ox2, \oy, \eyeval, \eyeval)
+   rev_off(vid.win)
+   XDrawArc(vid.win, x1, y, val, val)
+   XDrawArc(vid.win, x2, y, val, val)
+   eyeval := val
+   ox1 := x1; ox2 := x2; oy := y
+end
+
+procedure pupils(vid, val)
+   local x1, x2, y
+   static pupilval, ox1, ox2, oy
+
+   write_val(vid, val)
+   x1 := 200 - val/2
+   x2 := 300 - val/2
+   y := 100 - val/2
+   rev_on(vid.win)
+   XFillArc(vid.win, \ox1, \oy, \pupilval, \pupilval)
+   XFillArc(vid.win, \ox2, \oy, \pupilval, \pupilval)
+   rev_off(vid.win)
+   XFillArc(vid.win, x1, y, val, val)
+   XFillArc(vid.win, x2, y, val, val)
+   pupilval := val
+   ox1 := x1; ox2 := x2; oy := y
+end
+
+procedure smile(vid, val)
+   static oldsmile
+
+   write_val(vid, val)
+   rev_on(vid.win)
+   XDrawArc(vid.win, 185, 190, 130, 40, \oldsmile*360, (48-\oldsmile)*2*360)
+   rev_off(vid.win)
+   XDrawArc(vid.win, 185, 190, 130, 40, val*360, (48-val)*2*360)
+   oldsmile := val
+end
+
+procedure nose(vid, val)
+   static oldnose
+
+   write_val(vid, val)
+   rev_on(vid.win)
+   DrawLine(vid.win, 250, 140, 275, 180+\oldnose, 250, 190)
+   rev_off(vid.win)
+   DrawLine(vid.win, 250, 140, 275, 180+val, 250, 190)
+   oldnose := val
+
+end
+
+procedure rev_on(win)
+   WAttrib(win, "reverse=on", "linewidth=3")
+end
+procedure rev_off(win)
+   WAttrib(win, "reverse=off", "linewidth=1")
+end
diff --git a/ipl/gprogs/clrs2pdb.icn b/ipl/gprogs/clrs2pdb.icn
new file mode 100644
index 0000000..e798f17
--- /dev/null
+++ b/ipl/gprogs/clrs2pdb.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     clrs2pdb.icn
+#
+#	Subject:  Program to create custom palettes from color lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 29, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program builds a palette database from color lists.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links: basename, palettes, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, input, clist, line, name
+
+    every file := !args do {
+       input := open(file) | {
+          write(&errout, "*** cannot open ", image(file))
+          next
+          }
+       name := basename(file, ".clr")
+       clist := []
+       while line := read(input) do {
+          line ?:= tab(upto('\t'))
+          put(clist, line)
+          }
+       close(input)
+       makepalette(name, clist) |
+          write(&errout, "*** could not make palette from ", image(file))
+       }
+
+    xencode(PDB_, &output)
+       
+end
diff --git a/ipl/gprogs/coloralc.icn b/ipl/gprogs/coloralc.icn
new file mode 100644
index 0000000..0f76a86
--- /dev/null
+++ b/ipl/gprogs/coloralc.icn
@@ -0,0 +1,193 @@
+############################################################################
+#
+#	File:     coloralc.icn
+#
+#	Subject:  Program to test color allocation
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     coloralc tests how many fixed and/or mutable colors can be allocated.
+#  The two sets of pushbuttons allocate 1, 8, or 32 randomly chosen colors
+#  of the selected type.  New colors are arrayed on the display using
+#  squares for fixed colors and discs for mutable colors.  When no more
+#  colors can be created, no more squares or discs will appear.
+#
+#     Clicking on a color with the left mouse button selects it as the
+#  current color; the current color can be drawn on the screen by moving
+#  the mouse with the left button down.
+#
+#     Clicking on a mutable color (a disc) with the right mouse mutton
+#  changes it to a new random color.  There is also a pushbutton that
+#  changes all mutable colors simultaneously.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, button, evmux, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link button
+link evmux
+link random
+link graphics
+
+record square(x, y, w, p, n)		# a color square (or disc)
+
+global win, opts, m, w, h, s, bw, bh	# main window and dimensions
+global sq, nw, nh			# square list and layout counts
+
+global brushwin, brushproc		# current drawing window and procedure
+
+
+
+#  main program
+
+procedure main(args)
+
+   nw := 16	# number of squares wide
+   nh := 16	# number of squares high
+   s := 32	# square size
+   m := 4	# margin (gap)
+   bw := 68	# button width
+   bh := 20	# button height
+
+   opts := options(args, winoptions())
+   /opts["W"] := nw * (m + s) + bw
+   /opts["H"] := nh * (m + s) - m
+   /opts["M"] := m
+   win := optwindow(opts, "cursor=off", "echo=off")
+   m := opts["M"]			# get obtained window dimensions
+   h := opts["H"]
+   w := opts["W"]
+   s := (w - bw - nw * m) / nw		# calc size of each square
+   s <:= (h - (nh - 1) * m) / nh
+
+   quitsensor(win)			# set up sensors
+   sensor(win, &lpress, dobrush)
+   sensor(win, &ldrag, dobrush)
+   sensor(win, 'f', fixc, 1)
+   sensor(win, 'F', fixc, 8)
+   sensor(win, 'm', mutc, 1)
+   sensor(win, 'M', mutc, 8)
+   sensor(win, 'Aa', mutall)
+   buttonrow(win, m, m, bw, bh, 0, m + bh,
+      "1 fixed", fixc, 1,
+      "8 fixed", fixc, 8,
+      "32 fixed", fixc, 32,
+      )
+   buttonrow(win, m, m + 4 * (bh + m), bw, bh, 0, m + bh,
+      "1 mutable", mutc, 1,
+      "8 mutable", mutc, 8,
+      "32 mutable", mutc, 32,
+      )
+   buttonrow(win, m, m + 8 * (bh + m), bw, bh, 0, m + bh,
+      "mutate all", mutall, 0,
+      "quit", argless, exit,
+      )
+
+   sq := []				# init square list and procs
+   brushwin := win
+   brushproc := DrawRectangle
+
+   randomize()
+   evmux(win)				# loop processing events
+end
+
+
+
+#  fixc(w, n) -- allocate n new fixed colors
+
+procedure fixc(w, n)
+   local q
+   every 1 to n do {
+      q := newsquare(w, FillRectangle) | fail
+      Fg(q.w, ?65535 || "," || ?65535 || "," || ?65535) | {pull(sq); fail}
+      FillRectangle(q.w, q.x, q.y, s, s)	# interior (random new color)
+      DrawRectangle(win, q.x, q.y, s, s)	# outline (standard)
+      sensor(win, &lpress, setbrush, q, q.x, q.y, s, s)
+      }
+   return
+end
+
+
+
+#  mutc(w, n) -- allocate n new mutable colors
+
+procedure mutc(w, n)
+   local q
+   every 1 to n do {
+      q := newsquare(w, FillArc) | fail
+      q.n := NewColor(q.w, ?65535 || "," || ?65535 || "," || ?65535) |
+         {pull(sq); fail}
+      Fg(q.w, q.n)
+      FillArc(q.w, q.x, q.y, s, s)
+      DrawArc(win, q.x, q.y, s, s)
+      sensor(win, &lpress, setbrush, q, q.x, q.y, s, s)
+      sensor(win, &rpress, randmut, q, q.x, q.y, s, s)
+      }
+   return
+end
+
+
+#  newsquare(w, p) -- alc next square, init for proc p, return record
+
+procedure newsquare(w, p)
+   local x, y, q
+   *sq < nw * nh | fail
+   x := m + bw + m + (m + s) * (*sq % nw)
+   y := m + (m + s) * (*sq / nw)
+   q := square(x, y, Clone(w), p) | fail
+   put(sq, q)
+   return q
+end
+
+
+#  randmut(w, q) -- randomly mutate square q to a new color
+
+procedure randmut(w, q)
+   Color(q.w, \q.n, ?65535 || "," || ?65535 || "," || ?65535)
+   return
+end
+
+
+#  mutall(w) -- randomly mutate *all* the squares
+
+procedure mutall(w)
+   local args
+   args := [w]
+   every put(args, \(!sq).n) do
+      put(args, ?65535 || "," || ?65535 || "," || ?65535)
+   if *args > 1 then
+      Color ! args
+end
+
+
+#  setbrush(w, q) -- set the paintbrush to the values for square q
+
+procedure setbrush(w, q)
+   brushwin := q.w
+   brushproc := q.p
+   return
+end
+
+
+#  dobrush(w, dummy, x, y) -- call the brush procedure at location (x, y)
+
+procedure dobrush(w, dummy, x, y)
+   brushproc(brushwin, x - s / 4, y - s / 4, s / 2, s / 2)
+   return
+end
diff --git a/ipl/gprogs/colormap.icn b/ipl/gprogs/colormap.icn
new file mode 100644
index 0000000..076abbd
--- /dev/null
+++ b/ipl/gprogs/colormap.icn
@@ -0,0 +1,119 @@
+############################################################################
+#
+#	File:     colormap.icn
+#
+#	Subject:  Program to display palette from color list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program shows the colors given color list files given on the
+#  command line.
+#
+#  colormap will display color lists with more than 256 entries but,
+#  of course, it cannot display more than 256 different colors (if that
+#  many).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colrlist, drawcolr, interact, io, vsetup
+#
+############################################################################
+
+$define CellWidth 20
+$define Cells 16
+
+link colrlist
+link drawcolr
+link interact
+link io
+link vsetup
+
+global colors
+
+procedure main()
+   local vidgets
+
+   vidgets := ui()
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+procedure file_cb(vidgets, value)
+
+   case value[1] of {
+      "load     @L":  load_colors()
+      "snapshot @S":  snapshot(colors)
+      "quit     @Q":  exit()
+      }
+
+   return
+
+end
+
+procedure reload_cb()
+
+   return
+
+end
+
+procedure load_colors()
+   local clist
+   static file
+
+   initial file := ""
+
+   repeat {
+      if OpenDialog("Specify color list file:", file) == "Cancel" then fail
+      clist := colrlist(dialog_value) | {
+         Notice("Cannot process color list " || image(dialog_value) || ".")
+         next
+         }
+      WClose(\colors)
+      colors := draw_colors(clist)
+      Raise()
+      return
+      }
+
+end
+
+procedure shortcuts(e)
+
+  if &meta then case map(e) of {
+     "l":  load_colors()
+     "q":  exit()
+     "r":  reload_cb()
+     "s":  snapshot()
+     }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=197,288", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,197,288:",],
+   ["file:Menu:pull::1,0,36,21:File",file_cb,
+      ["load     @L","snapshot @S","quit     @Q"]],
+   ["line1:Line:::0,24,197,24:",],
+   ["reload:Button:regular::26,56,49,20:reload",reload_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/colorup.icn b/ipl/gprogs/colorup.icn
new file mode 100644
index 0000000..a58ce4a
--- /dev/null
+++ b/ipl/gprogs/colorup.icn
@@ -0,0 +1,133 @@
+############################################################################
+#
+#	File:     colorup.icn
+#
+#	Subject:  Program to produce a weave structure from unravel data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 18, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+#############################################################################
+#
+#  Input is expected to be the output of unravel -r.
+#
+#############################################################################
+#
+#  This program takes information from a image solved by unravel.icn to
+#  produce a draft.
+#
+#  The option -o i determines how optional choices at intersections are
+#  handled:
+#
+#	0	random (default)
+#	1	warp
+#	2	weft
+#	3	alternating
+#
+############################################################################
+#
+#  Links:  numbers, options, weavutil, patxform, patutils, xcode
+#
+############################################################################
+
+link numbers
+link options
+link patutils
+link patxform
+link weavutil
+link xcode
+link ximage
+
+procedure main(args)
+   local warp, weft, pattern, rows, i, j, count, opts
+   local threading, treadling, color_list, colors, choice
+   local symbols, symbol, drawdown, draft, warp_colors, weft_colors, pixels
+
+   opts := options(args, "o+")
+
+   choice := opts["o"] | 0
+
+   (warp := read()  & weft := read() & pattern := read()) |
+      stop("*** short file")
+
+   pixels := real(*pattern)
+
+   colors := warp ++ weft
+
+   color_list := []
+
+   every put(color_list, PaletteColor("c1", !colors))
+
+   warp_colors := []
+
+   every put(warp_colors, upto(!warp, colors))
+
+   weft_colors := []
+
+   every put(weft_colors, upto(!weft, colors))
+
+   drawdown := []
+
+   pattern ? {
+      while put(drawdown, move(*warp))
+      }
+
+   count := 0
+
+   every i := 1 to *weft do {		# row
+      every j := 1 to *warp do {		# column
+         if weft[i] == warp[j] then {		# option point
+            count +:= 1
+            drawdown[i, j] := case choice of {
+               0  :  ?2 - 1				# random
+               1  :  "1"				# warp
+               2  :  "0"				# weft
+               3  :  if count % 2 = 0 then "1" else "2"	# alternative
+               }
+            }
+         else if drawdown[i, j] == weft[i] then drawdown[i, j] := "0"
+         else drawdown[i, j] := "1"
+         }
+      }
+
+   treadling := analyze(drawdown)
+   drawdown := protate(drawdown, "cw")
+   threading := analyze(drawdown)
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   rows := []
+
+   while get(symbols) do
+      put(rows, get(symbols))
+
+   draft := isd()
+
+   draft.name := "colorup"
+   draft.threading := threading.sequence
+   draft.treadling := treadling.sequence
+   draft.warp_colors := warp_colors
+   draft.weft_colors := weft_colors
+   draft.color_list := color_list
+   draft.shafts := *threading.rows
+   draft.treadles := *treadling.rows
+   draft.tieup := rows
+
+   xencode(draft, &output)
+
+end
diff --git a/ipl/gprogs/colorwif.icn b/ipl/gprogs/colorwif.icn
new file mode 100644
index 0000000..24d1f35
--- /dev/null
+++ b/ipl/gprogs/colorwif.icn
@@ -0,0 +1,232 @@
+############################################################################
+#
+#	File:     colorwif.icn
+#
+#	Subject:  Program to produce a WIF from unravel data
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 24, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+#############################################################################
+#
+#  Input is expected to be the output of unravel -r.
+#
+#############################################################################
+#
+#  This program takes information from a image solved by unravel.icn to
+#  produce a draft.
+#
+#  The option -o i determines how optional choices at intersections are
+#  handled:
+#
+#	0	random (default)
+#	1	warp
+#	2	weft
+#	3	alternating
+#
+############################################################################
+#
+#  Links:  numbers, options, weavutil, patxform, patutils
+#
+############################################################################
+
+link numbers
+link options
+link patutils
+link patxform
+
+record analysis(rows, sequence, patterns)
+
+procedure main(args)
+   local warp, weft, pattern, rows, i, j, count, opts
+   local threading, treadling, color_list, colors, choice
+   local symbols, symbol, drawdown, draft, warp_colors, weft_colors, pixels
+
+   opts := options(args, "o+")
+
+   choice := opts["o"] | 0
+
+   (warp := read()  & weft := read() & pattern := read()) |
+      stop("*** short file")
+
+   pixels := real(*pattern)
+
+   colors := warp ++ weft
+
+   color_list := []
+
+   every put(color_list, PaletteColor("c1", !colors))
+
+   warp_colors := []
+
+   every put(warp_colors, upto(!warp, colors))
+
+   weft_colors := []
+
+   every put(weft_colors, upto(!weft, colors))
+
+   drawdown := []
+
+   pattern ? {
+      while put(drawdown, move(*warp))
+      }
+
+   count := 0
+
+   every i := 1 to *weft do {		# row
+      every j := 1 to *warp do {		# column
+         if weft[i] == warp[j] then {		# option point
+            count +:= 1
+            drawdown[i, j] := case choice of {
+               0  :  ?2 - 1				# random
+               1  :  "1"				# warp
+               2  :  "0"				# weft
+               3  :  if count % 2 = 0 then "1" else "2"	# alternative
+               }
+            }
+         else if drawdown[i, j] == weft[i] then drawdown[i, j] := "0"
+         else drawdown[i, j] := "1"
+         }
+      }
+
+   treadling := analyze(drawdown)
+   drawdown := protate(drawdown, "cw")
+   threading := analyze(drawdown)
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   rows := []
+
+   while get(symbols) do
+      put(rows, get(symbols))
+
+   #  Now output the WIF.
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=colorwif.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=", *color_list)
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=example")
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711-2304")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[WEAVING]")
+   write("Shafts=", *threading.rows)
+   write("Treadles=", *treadling.rows)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *threading.sequence)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   write("[WEFT]")
+   write("Threads=", *treadling.sequence)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   #  These are provided to produce better initial configurations when
+   #  WIFs are imported to some weaving programs.
+
+   write("[WARP THICKNESS]")
+   write("[WEFT THICKNESS]")
+
+   write("[COLOR TABLE]")
+   every i := 1 to *color_list do
+      write(i, "=", ColorValue(color_list[i]))
+
+   write("[WARP COLORS]")
+   every i := 1 to *warp_colors do
+      write(i, "=", warp_colors[i])
+
+   write("[WEFT COLORS]")
+   every i := 1 to *weft_colors do
+      write(i, "=", weft_colors[i])
+
+   write("[THREADING]")
+   every i := 1 to *threading.sequence do
+      write(i, "=", threading.sequence[i])
+
+   write("[TREADLING]")
+   every i := 1 to *treadling.sequence do
+      write(i, "=", treadling.sequence[i])
+
+   write("[TIEUP]")
+   every i := 1 to *rows do
+      write(i, "=", tromp(rows[i]))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure analyze(drawdown)
+   local sequence, rows, row, count, patterns
+
+   sequence := []
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   every row := !drawdown do {
+      if /rows[row] then {
+         rows[row] := count +:= 1
+         put(patterns, row)
+         }
+      put(sequence, rows[row])
+      }
+
+   return analysis(rows, sequence, patterns)
+
+end
diff --git a/ipl/gprogs/colrbook.icn b/ipl/gprogs/colrbook.icn
new file mode 100644
index 0000000..01313ca
--- /dev/null
+++ b/ipl/gprogs/colrbook.icn
@@ -0,0 +1,179 @@
+############################################################################
+#
+#	File:     colrbook.icn
+#
+#	Subject:  Program to show the named colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     colrbook is a mouse-driven program for choosing named colors.
+#  Along the left are 24 equally spaced hues plus black, gray, white,
+#  brown, violet, and pink.  Click on any of these to see the twenty
+#  colors that are possible by adding lightness and saturation
+#  modifiers to the particular hue.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, graphics
+#
+############################################################################
+
+link button
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+$define HEADER 20	# height of header area (not incl. margin)
+$define FOOTER 20	# height of footer area (not incl. margin)
+
+$define TSIZ 12		# hue triangle size
+$define HUEW 20		# hue width
+$define HGAP 1		# hue gap
+
+$define LEFT (m+TSIZ+HUEW+labw)	# total space to left of grid and its margin
+
+
+global cwin, huelist, sats, lgts, colrs, fillargs
+global labw, leftx, w, h, m
+
+procedure main(args)
+   local x, y, dx, dy, cw, ch
+   local i, j, ij, hue, r
+
+   lgts := ["pale", "light", "medium", "dark", "deep"]
+   sats := ["weak", "moderate", "strong", "vivid"]
+   colrs := table()
+   fillargs := table()
+
+   Window("size=500,350", "font=Helvetica,bold,12", args)
+   cwin := Clone()
+   m := WindowMargin
+   w := WAttrib("width") - 2 * m
+   h := WAttrib("height") - 2 * m
+   labw := TextWidth("medium") + 3 * m	# label area width
+   leftx := m + TSIZ + HUEW + labw	# space to left of grid and its margin
+
+   dx := (w - leftx + m) / *sats
+   dy := (h - HEADER - FOOTER + m) / *lgts
+   cw := dx - m
+   ch := dy - m
+
+   inithues()
+
+   every i := 1 to *sats do
+      every j := 1 to *lgts do {
+         ij := i || j
+         x := leftx + dx * i - cw
+         y := HEADER + dy * j - ch
+         BevelRectangle(x, y, cw, ch, -BevelWidth)
+         fillargs[ij] := [cwin, x + BevelWidth, y + BevelWidth,
+            cw - 2 * BevelWidth, ch - 2 * BevelWidth]
+         if Fg(cwin, colrs[ij] := NewColor("gray")) then	# may fail
+            FillRectangle ! fillargs[ij]
+         }
+   every i := 1 to *sats do {
+      GrooveRectangle(leftx + m + dx * (i - 1), m / 2, dx - m, HEADER)
+      CenterString(leftx + dx * i - cw / 2, m / 2 + HEADER / 2, sats[i])
+      }
+   every j := 1 to *lgts do {
+      GrooveRectangle(leftx, HEADER + dy*j - ch/2 - HEADER/2, -labw + m, HEADER)
+      RightString(leftx - m, HEADER + dy*j - ch/2, lgts[j])
+      }
+
+   # define sensors
+   button(&window, "QUIT", argless, exit, m+TSIZ+HUEW+m, m, labw-2*m, HEADER)
+   sensor(&window, &lpress, hueclick, r, m, m, TSIZ + HUEW, h)
+   quitsensor(&window)
+
+   # initialize to "gray" hues using an artificial event
+   Enqueue(&lrelease)
+   hueclick(&window, 0, m, m + integer((*huelist - 4.5) / *huelist * h))
+
+   # enter event loop
+   evmux(&window)
+end
+
+procedure hueclick(win, arg, x, y)
+   local hue, e, n, i, j
+
+   e := &ldrag
+   while e ~=== &lrelease do {
+      if e === &ldrag then {
+         n := (*huelist * (y - m + HGAP / 2)) / h + 1
+         if 0 < n <= *huelist then {
+            hue := huelist[n]
+            EraseArea(m, m - TSIZ / 2, TSIZ + 1, h + TSIZ)
+            y := m - HGAP + integer((n - 0.5) * (h + HGAP) / *huelist)
+            BevelTriangle(m + TSIZ / 2, y, TSIZ / 2, "e")
+            setcolor(hue)
+            EraseArea(LEFT, m + h - FOOTER, w, FOOTER + m)
+            CenterString(LEFT + (w - LEFT + m)/2, m + h + m/2 - FOOTER/2, hue)
+            }
+         }
+      e := Event(win)
+      y := &y
+      }
+   return
+end
+
+procedure setcolor(hue)
+   local i, j, ij, prefix
+   static prev
+
+   every i := 1 to *sats do
+      every j := 1 to *lgts do {
+         ij := i || j
+         prefix := lgts[j] || " " || sats[i] || " "
+         if not Color(cwin, \colrs[ij], prefix || hue) then {
+            # no mutable color was allocated;
+            # free old static color, preserving grays (used for decoration)
+            # also preserving labeling colors ("medium vivid")
+            if \prev ~== "black" & \prev ~== "gray" & \prev ~== "white" then
+               FreeColor(cwin, ("medium vivid " ~== prefix) || \prev)
+            Fg(cwin, prefix || hue)
+            FillRectangle ! fillargs[ij]
+            }
+         }
+
+   prev := hue
+   return
+end
+
+procedure inithues()
+   local i, y1, y2, dy, win
+
+   huelist := [
+      "red", "orange", "red-yellow", "reddish yellow",
+      "yellow", "greenish yellow", "yellow-green", "yellowish green",
+      "green", "cyanish green", "cyan-green", "greenish cyan",
+      "cyan", "bluish cyan", "blue-cyan", "cyanish blue",
+      "blue", "blue-purple", "purple", "purple-magenta",
+      "magenta", "reddish magenta", "magenta-red", "magentaish red",
+      "black", "gray", "white",
+      "brown", "violet", "pink"
+      ]
+   dy := real(h + HGAP) / *huelist
+   win := Clone(&window)
+   every i := 1 to *huelist do {
+      y1 := integer(dy * (i - 1))
+      y2 := integer(dy * i)
+      Fg(win, huelist[i])
+      FillRectangle(win, m + TSIZ + 1, m + y1, HUEW - 1, y2 - y1 - HGAP)
+      }
+   Uncouple(win)
+   return
+end
diff --git a/ipl/gprogs/colrname.icn b/ipl/gprogs/colrname.icn
new file mode 100644
index 0000000..2ff4259
--- /dev/null
+++ b/ipl/gprogs/colrname.icn
@@ -0,0 +1,125 @@
+############################################################################
+# 
+#	File:     colrname.icn
+# 
+#	Subject:  Program to browse color names
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     August 3, 2000
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.1
+#
+#	Extension to output color specification added by Ralph E. Griswold
+#
+############################################################################
+#
+#     An X color name browser.
+#
+#     Click on a colorname to change the window's background color.
+# Not very interesting on a monochrome server.
+#
+############################################################################
+#
+# Requires:  Version 9 graphics with mutable colors and X.
+#
+############################################################################
+#
+#  Links: sort, wopen
+#
+############################################################################
+
+link sort
+link wopen
+
+global w, L, startcols, rows, theBackGround
+
+procedure drawit()
+   local curcol, i, maxcol
+   curcol := 1
+   i := 0
+   startcols := [1]
+   maxcol := 0
+   every name := !L do {
+      maxcol <:= *name
+      GotoRC(i % rows + 1,curcol)
+      writes(&window,name)
+      i +:= 1
+      if (i>0) & (i % rows = 0) then {
+	 curcol +:= maxcol + 2
+	 maxcol := 0
+	 put(startcols,curcol)
+	 }
+      }
+end
+
+
+procedure doevents()
+   local e, varcol, lastvarcol, lastrow
+   repeat {
+      Active()
+      while Pending()[1] do {
+	 e := Event()
+	 case e of {
+            "o":      write(ColorValue(\name))
+	    "q"|"\e": exit(0)
+	    &lpress|&mpress|&rpress|&ldrag|&mdrag|&rdrag: {
+	       varcol := 0
+	       every &col >= !startcols do varcol +:= 1
+	       if varcol === lastvarcol & &row===lastrow then next
+	       lastvarcol := varcol
+	       lastrow := &row
+	       name := L[(varcol-1)*rows+&row]
+	       Color(theBackGround,name)
+	       WAttrib("label=Color Names: " || name)
+	    }
+	 }
+      }
+   }
+end
+
+procedure main(av)
+   local filename, f, i, t, max, line, t2, r, g, b, rgb
+
+   filename := av[1] | "/usr/lib/X11/rgb.txt"
+   WOpen("label=Color Names","x","cursor=on","lines=50","columns=175") |
+      stop("no window")
+   rows := WAttrib("lines")
+   f := open(filename) | stop("no rgb.txt")
+
+   theBackGround := NewColor("white")
+   Bg(theBackGround)
+   EraseArea()
+
+   i := 1
+   t := set()
+   t2 := table() # skip redundant colors by storing their rgb
+   max := 0
+   every line := !f do {
+      line ? {
+	 tab(upto(&digits))
+	 r := tab(many(&digits))
+	 tab(upto(&digits))
+	 g := tab(many(&digits))
+	 tab(upto(&digits))
+	 b := tab(many(&digits))
+	 rgb := ishift(r,16)+ishift(g,8)+b
+	 name := (tab(upto(&letters)) & tab(0))
+	 if /t2[rgb] := name then {
+	    insert(t,name)
+	    max <:= *name
+	    i +:= 1
+	    }
+	 }
+      }
+   L := isort(t)
+
+   drawit()
+   doevents()
+end
diff --git a/ipl/gprogs/colrpick.icn b/ipl/gprogs/colrpick.icn
new file mode 100644
index 0000000..a8c90f2
--- /dev/null
+++ b/ipl/gprogs/colrpick.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     colrpick.icn
+#
+#	Subject:  Program to pick RGB or HLS colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 27, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      colrpick provides a command-level interface to the ColorDialog
+#   procedure.  The ColorValue() of the selected color is written to
+#   standard output when the Okay button is pressed.  If the Cancel
+#   button is pressed, colorpick exits with an error by calling stop().
+#
+#      A default color can be specified by one or more command arguments,
+#   for example "colrpick deep green".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, vsetup
+#
+############################################################################
+
+link graphics
+link vsetup
+
+procedure main(args)
+   local dflt
+
+   Window ! put(ui_atts(), "canvas=hidden", args)
+   ui()				# just to get standard VIB font
+
+   if *args > 0 then {
+      dflt := ""
+      every dflt ||:= " " || !args
+      if not ColorValue(dflt) then {
+         write(&errout, "  illegal default color: ", dflt)
+         dflt := &null
+         }
+      }
+
+   case ColorDialog(, dflt) of {
+      "Okay":	write(dialog_value)
+      "Cancel":	stop()
+      }
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=340,320", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,340,320:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/concen.icn b/ipl/gprogs/concen.icn
new file mode 100644
index 0000000..b00f9f4
--- /dev/null
+++ b/ipl/gprogs/concen.icn
@@ -0,0 +1,243 @@
+############################################################################
+#
+#	File:     concen.icn
+#
+#	Subject:  Program to play solitaire card game Concentration
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 4, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage: concen [winoptions] [ncards]
+#
+#     Concentration, as presented here, is a simple solitaire game.
+#  When the program starts, there are 52 playing cards, face down.
+#  They may be turned over by clicking on them with the mouse.  Only
+#  two cards may be face up at a time; if they are the same rank
+#  (e.g. two sevens), they are removed.  The object is to clear the
+#  table.
+#
+#     (For an interesting discussion of two-person Concentration, see
+#  Ian Stewart's "Mathematical Recreations" column in the October,
+#  1991, edition of Scientific American, entitled "Concentration:
+#  A Winning Strategy".)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: drawcard, options, optwindw, random, graphics
+#
+############################################################################
+
+link drawcard
+link options
+link optwindw
+link random
+link graphics
+
+global deck				# full deck of cards
+global nleft				# number of cards left
+global nup				# number of cards face up
+global uprank				# rank of upturned cards, if all same
+
+global ncols, nrows			# number of columns and rows
+global cardw, cardh			# card width and height
+global margin, gap			# outside margin, gap between cards
+global mono				# GC for pattern, iff mono screen
+
+global cd				# card record, indexed by position
+record cdrec(
+   label,				# member of &letters as per Icon book
+   status)				# status flag
+global VACANT, DOWN, UP			# status flag values
+
+#  main program.
+
+procedure main(args)
+   local i, j, e
+
+   initialize(args)
+   newgame()
+   while e := Event() do {
+      if e === QuitEvents() then
+         break
+      if e === (&lrelease | &mrelease | &rrelease) then {
+         i := (&y - margin + gap/2) / (cardh + gap)
+         j := (&x - margin + gap/2) / (cardw + gap)
+         click(i, j)
+         }
+      }
+end
+
+#  initialize(args) -- process options, initialize globals, open window
+
+procedure initialize(args)
+   local opts, ncards
+
+   cardw := 80
+   cardh := 124
+   VACANT := 0
+   DOWN := 1
+   UP := 2
+
+   opts := options(args, winoptions())		# get command options
+
+   ncards := integer(args[1]) | 52		# get size of deck
+   ncards -:= ncards % 2			# ensure even
+   ncards <:= 2					# ensure at least 2 cards
+   ncards >:= 52				# ensure at most 52 cards
+   deck :=
+      ("aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ" ? move(ncards))
+
+   if ncards <= 10 then
+      nrows := 2
+   else if ncards <= 21 then
+      nrows := 3
+   else if ncards <= 36 then
+      nrows := 4
+   else
+      nrows := 5
+   ncols := (ncards + nrows - 1) / nrows
+
+   /opts["M"] := 20
+   margin := opts["M"]
+   gap := margin / 2
+   /opts["W"] := ncols * cardw + (ncols - 1) * gap
+   /opts["H"] := nrows * cardh + (nrows - 1) * gap
+   /opts["B"] := "deep moderate green"
+   &window := optwindow(opts)
+   if WAttrib("depth") = 1 then {
+      mono := Clone(&window, "fg=white", "bg=black", "fillstyle=textured")
+      Pattern(mono, "4,2,8,2,8")
+      FillRectangle(mono, 0, 0, 2 * margin + opts["W"], 2 * margin + opts["H"])
+      }
+   randomize()
+   return
+end
+
+#  newgame() -- lay out cards, face down, for a new game
+
+procedure newgame()
+   local i, j, s
+
+   nleft := *deck
+   nup := 0
+   cd := []
+   every put(cd, cdrec(!deck, DOWN))
+   every i := *cd to 2 by -1 do
+      cd[?i] :=: cd[i]
+
+   every i := 0 to nrows-1 do
+      every j := 0 to ncols-1 do
+         if cardno(i, j) then
+            setcard(i, j, "-")
+
+   return
+end
+
+#  click(i, j) -- process a click on the card in row i, column j
+
+procedure click(i, j)
+   local c
+
+   case nup of {	# action depends on the number of cards already face up
+
+      0: {
+         #  no cards are face up.  turn this one up.
+         c := cd[cardno(i, j)] | fail
+         if c.status = DOWN then {
+            setcard(i, j, c.label)
+            c.status := UP
+            nup := 1
+            uprank := crank(c.label)
+            }
+         }
+
+      1: {
+         #  one is face up.  it might be the one clicked.
+         c := cd[cardno(i, j)] | fail
+         if c.status = UP then {
+            setcard(i, j, "-")
+            c.status := DOWN
+            nup := 0
+            }
+         else if c.status = DOWN then {
+            setcard(i, j, c.label)
+            c.status := UP
+            nup := 2
+            if uprank ~= crank(c.label) then
+               uprank := &null
+            }
+         }
+
+      2: {
+         #  two are face up.  it doesn't matter what card was clicked.
+         #  remove the two up-cards if they match, or turn back over if not.
+         every i := 0 to nrows-1 do
+            every j := 0 to ncols-1 do
+               if c := cd[cardno(i, j)] then
+                  if c.status = UP then {
+                     if \uprank then {
+                        setcard(i, j, &null)
+                        c.status := VACANT
+                        nleft -:= 1
+                        }
+                     else {
+                        setcard(i, j, "-")
+                        c.status := DOWN
+                        }
+                     nup -:= 1
+                     }
+         #  if no cards are left, the game is won.
+         #  show all cards face up as a reward.
+         if nleft = 0 then
+            every i := 0 to nrows-1 do
+               every j := 0 to ncols-1 do
+                  if c := cd[cardno(i, j)] then {
+                     setcard(i, j, c.label)
+                     c.status := UP
+                     nup +:= 1
+                     }
+         }
+      default:
+         #  presumably there are 52 cards face up after a win.
+         #  start a new game with this new click.
+         newgame()
+      }
+   return
+end
+
+#  setcard(i, j, c) -- redraw card c at location (i,j), or background if /c
+
+procedure setcard(i, j, c)
+   local x, y
+   x := margin + j * (cardw + gap)
+   y := margin + i * (cardh + gap)
+   drawcard(x, y, \c) |
+      FillRectangle(\mono, x, y, cardw, cardh) |
+      EraseArea(x, y, cardw, cardh)
+   return
+end
+
+#  cardno(i, j) -- return index (1 to 52) if location is valid
+
+procedure cardno(i, j)
+   return (0 <= i) & (0 <= j < ncols) & *deck >= (ncols * i + j + 1)
+end
+
+#  crank(label) -- return rank (1 to 13) of card with given label
+
+procedure crank(label)
+   static fulldeck
+   initial fulldeck := string(&letters)
+   return fulldeck ? find(label) % 13
+end
diff --git a/ipl/gprogs/cquilts.icn b/ipl/gprogs/cquilts.icn
new file mode 100644
index 0000000..633315f
--- /dev/null
+++ b/ipl/gprogs/cquilts.icn
@@ -0,0 +1,239 @@
+############################################################################
+#
+#	File:     cquilts.icn
+#
+#	Subject:  Program to create "chaotic square quilts"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates square quilting patterns as described in
+#  "Symmetry in Chaos", Michael Field and Martin Golubitsky, Oxford
+#  University Press, 1992.
+#
+#  Instead of plotting an image, the values are computed and saved
+#  in "numerical carpets" for off-line plotting.
+#
+#  The following options are supported:
+#
+#	-i i	Save carpet files every i iterations; default 100000
+#
+#	-p s	Prefix for carpet file names, default q_
+#
+#	-t i	Terminate execution after i iterations; default no limit
+#
+#  Warning:  This program takes a long time to go through enough iterations
+#  to produce nice results.
+#
+#  Note:  This is an unfinished work, supplied for interest only.
+#
+#  There are several sections of parameter values below.  All but one
+#  is commented out.  Change this to get other patterns.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  matrix, options, writecpt
+#
+############################################################################
+
+link matrix
+link options
+link writecpt
+
+global pi_2
+global pi_4
+global pi_6
+
+$define Size 200
+
+procedure main(args)
+   local x, y, xnew, ynew, lambda, alpha, beta, gamma, omega, ma, shift
+   local mcount, sx, sy, xp, yp, max, min, i
+   local count, prefix, iter, opts, interval, limit
+
+   pi_2 := 2 * &pi
+   pi_4 := 4 * &pi
+   pi_6 := 6 * &pi
+
+   iter := 0
+   count := -1
+
+   opts := options(args, "i+p:t+")
+
+   interval := \opts["i"] | 100000
+   prefix := \opts["p"] | "q_"
+   limit := \opts["t"]
+
+   xnew := x := 0.1
+   ynew := y := 0.334
+
+# Sugar and Spice
+
+#  lambda := -0.59
+#  alpha := 0.2
+#  beta := 0.1
+#  gamma := -0.27
+#  omega := 0.0
+#  ma := 0.0
+#  shift := 0.5
+
+# Emerald Mosaic
+
+#  lambda := -0.59
+#  alpha := 0.2
+#  beta := 0.1
+#  gamma := -0.33
+#  omega := 0.0
+#  ma := 2.0
+#  shift := 0.0
+
+# Sicilian Tile
+
+#  lambda := -0.2
+#  alpha := -0.1
+#  beta := 0.1
+#  gamma := -0.25
+#  omega := 0.0
+#  ma := 0.0
+#  shift := 0.0
+
+# Roses
+
+#  lambda := 0.25
+#  alpha := -0.3
+#  beta := 0.2
+#  gamma := 0.3
+#  omega := 0.0
+#  ma := 1.0
+#  shift := 0.0
+
+# Wagon Wheels
+
+#  lambda := -0.28
+#  alpha := 0.25
+#  beta := 0.05
+#  gamma := -0.24
+#  omega := 0.0
+#  shift := 0.0
+#  ma := -1.0
+
+# Victorian Tiles
+
+#  lambda := -0.12
+#  alpha := -0.36
+#  beta := 0.18
+#  gamma := -0.14
+#  omega := 0.0
+#  shift := 0.5
+#  ma := 1.0
+
+# Mosque
+
+#  lambda := 0.1
+#  alpha := 0.2
+#  beta := 0.1
+#  gamma := 0.39
+#  omega := 0.0
+#  shift := 0.0
+#  ma := -1.0
+
+# Red Tiles
+
+#  lambda := -0.589
+#  alpha := 0.2
+#  beta := 0.04
+#  gamma := -0.2
+#  omega := 0.0
+#  shift := 0.5
+#  ma := 0.0
+
+# Cathedral Attractor
+
+#  lambda := -0.28
+#  alpha := 0.08
+#  beta := 0.45
+#  gamma := -0.05
+#  omega := 0.0
+#  shift := 0.5
+#  ma := 0.0
+
+# Gyroscopes
+
+#  lambda := -0.59
+#  alpha := 0.2
+#  beta := 0.2
+#  gamma := 0.3
+#  omega := 0.0
+#  shift := 0.0
+#  ma := 2.0
+
+# Cats Eyes
+
+#  lambda := -0.28
+#  alpha := 0.25
+#  beta := 0.05
+#  gamma := -0.24
+#  omega := 0.0
+#  shift := 0.5
+#  ma := -1.0
+
+# Flowers with Ribbons
+
+   lambda := -0.11
+   alpha := -0.26
+   beta := 0.19
+   gamma := -0.059
+   omega := 0.07
+   shift := 0.5
+   ma := 2.0
+
+   mcount := create_matrix(Size, Size, 0)
+
+   repeat {
+
+      # iterate
+      sx := sin(pi_2 * x)
+      sy := sin(pi_2 * y)
+      xnew := (lambda + alpha * cos(pi_2 * y)) * sx - omega * sy + beta *
+         sin(pi_4 * x) + gamma * sin(pi_6 * x) * cos(pi_4 * y) + ma *
+         x + shift
+      ynew := (lambda + alpha * cos(pi_2 * x)) * sy + omega * sx + beta *
+         sin(pi_4 * y) + gamma * sin(pi_6 * y) * cos(pi_4 * x) + ma *
+         y + shift
+      if xnew > 1.0 then xnew -:= integer(xnew)
+      else if xnew < 0.0 then xnew +:= integer(-xnew) + 1
+      if ynew > 1.0 then ynew -:= integer(ynew)
+      else if ynew < 0.0 then ynew +:= integer(-ynew) + 1
+      x := xnew
+      y := ynew
+
+      xp := integer(Size * x)
+      yp := integer(Size * y)
+      mcount[xp + 1, yp + 1] +:= 1
+      iter +:= 1
+      if iter % \interval = 0 then {
+         max := 0
+         min := 2 ^ 31
+         every i := mcount[1 to Size, 1 to Size] do {
+            max <:= i
+            min >:= i
+            }
+         if min < 0 then min := 0
+         write_cpt(prefix || right(count +:= 1, 3, "0") || ".cpt",
+            mcount, min, max)
+         }
+      if iter >= \limit then exit()
+      }
+
+end
diff --git a/ipl/gprogs/cw.icn b/ipl/gprogs/cw.icn
new file mode 100644
index 0000000..34cd851
--- /dev/null
+++ b/ipl/gprogs/cw.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     cw.icn
+#
+#	Subject:  Program to manipulate color ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 19, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  See colorway.icn for documentation
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colorway
+#
+############################################################################
+
+link colorway
+
+procedure main()
+
+   cw_init()
+
+   cw := colorway(table())	# initial color way
+   cw.table["white"] := "white"
+   cw.table["black"] := "black"
+   cw_file := ""
+   win_cw()
+   expose(cw_interface)
+
+   repeat {
+     if \cw_active then edit_cw()
+     else ProcessEvent(cw_root, , shortcuts)
+     }
+
+
+end
diff --git a/ipl/gprogs/dd2draft.icn b/ipl/gprogs/dd2draft.icn
new file mode 100644
index 0000000..f98c247
--- /dev/null
+++ b/ipl/gprogs/dd2draft.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     dd2draft.icn
+#
+#	Subject:  Program to create draft information from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 16, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a drawdown in terms of rows of zeros and ones from
+#  standard input and outputs draft information in textual form.
+#
+#  It also accepts BLPs as input.
+#
+############################################################################
+#
+#   Links:  patutils. patxform
+#
+############################################################################
+
+link patutils
+link patxform
+
+record analysis(rows, sequence, patterns)
+
+procedure main()
+   local threading, treadling, rows, columns,  pattern, i
+   local symbols, symbol, tieup, line
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   write("Drawdown:")
+   write()
+   every write(!rows)
+   write()
+
+   treadling := analyze(rows)
+   write("Treadling:")
+   write()
+   every writes(!treadling.sequence, ", ")
+   write()
+   write()
+
+   columns := protate(rows)	# rotate 90 degrees
+
+   threading := analyze(columns)
+   write("Threading:")
+   write()
+   every writes(!threading.sequence, ", ")
+   write()
+   write()
+
+   # Now do the tie-up.
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   tieup := []
+
+   while get(symbols) do
+      put(tieup, get(symbols))
+
+   write("Tie-up:")
+   write()
+   every write(!tieup)
+
+end
+
+procedure analyze(drawdown)
+   local sequence, rows, row, count, patterns
+
+   sequence := []
+   patterns := []
+
+   rows := table()
+
+   count := 0
+
+   every row := !drawdown do {
+      if /rows[row] then {
+         rows[row] := count +:= 1
+         put(patterns, row)
+         }
+      put(sequence, rows[row])
+      }
+
+   return analysis(rows, sequence, patterns)
+
+end
diff --git a/ipl/gprogs/dd2res.icn b/ipl/gprogs/dd2res.icn
new file mode 100644
index 0000000..785c8b6
--- /dev/null
+++ b/ipl/gprogs/dd2res.icn
@@ -0,0 +1,39 @@
+############################################################################
+#
+#	File:     dd2res.icn
+#
+#	Subject:  Program to compute loom resources needed from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 8, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a pattern in row or BLP format.
+#
+#  The number of shafts and treadles required is written to standard
+#  output.
+#
+############################################################################
+#
+#  Links:  pattread, patutils, patxform
+#
+############################################################################
+
+link pattread
+link patutils
+link patxform
+
+procedure main()
+   local rows, row
+
+   rows := pattread()
+
+   write(*set(protate(rows)), "x", *set(rows))
+
+end
diff --git a/ipl/gprogs/dd2unit.icn b/ipl/gprogs/dd2unit.icn
new file mode 100644
index 0000000..09c2d98
--- /dev/null
+++ b/ipl/gprogs/dd2unit.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     dd2unit.icn
+#
+#	Subject:  Program to get dimensions of unit motif of pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 12, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following command line option is supported:
+#
+#	-p	assume partial repeats may occur at edges of pattern;
+#		default complete repeats 
+#
+############################################################################
+#
+#  Links:  options, patutils, seqops
+#
+############################################################################
+
+link options
+link patutils
+link seqops
+
+global switch
+
+procedure main(args)
+   local rows, opts
+
+   opts := options(args, "p")
+   switch := opts["p"]
+
+   rows := unit(pat2rows(read()))
+   write(*rows[1], "x", *rows)
+
+end
+
+procedure rot90(rows)		# rotate pattern 90 degrees clockwise
+   local columns, i, j
+
+   columns := list(*rows[1], "")
+
+   every i := 1 to *rows do
+      every j := 1 to *columns do
+         columns[j] ||:= rows[i][j]
+
+   return columns
+
+end
+
+procedure unit(grid)
+
+   grid := grepeat(grid)
+
+   grid := grepeat(rot90(grid))
+
+   return rot90(grid)
+
+end
+
+procedure grepeat(grid)		#: reduce grid to smallest repeat
+   local periods, i, width
+
+   grid := copy(grid)
+
+   periods := []
+
+   width := *grid[1]
+
+   every i := 1 to *grid do
+      put(periods, speriod(str2lst(grid[i]), switch) | width)
+
+   width >:= lcml ! periods
+
+   every i := 1 to *grid do
+      grid[i] := left(grid[i], width)
+
+   return grid
+
+end
diff --git a/ipl/gprogs/dd2wif.icn b/ipl/gprogs/dd2wif.icn
new file mode 100644
index 0000000..51a7c5f
--- /dev/null
+++ b/ipl/gprogs/dd2wif.icn
@@ -0,0 +1,182 @@
+############################################################################
+#
+#	File:     dd2wif.icn
+#
+#	Subject:  Program to produce a WIF from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 4, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads BLPs that represent drawdowns.  The names of BLP
+#  files are given on the command line.  WIF files are output.
+#
+#  The following option is supported:
+#
+#	-w	make Web page; default don't
+#
+#  If Web pages are being produced, the extension "html" is used; otherwise
+#  "wif".
+#
+############################################################################
+#
+#  Links:  basename, options, pattread, patutils
+#
+############################################################################
+
+link basename
+link options
+link pattread
+link patutils
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, line, opts, lt, ext
+   local shafts, treadles, i, tie_line, row, treadle, draft, title, web
+   local name, input, output
+
+   opts := options(args, "w")
+
+   title := \opts["t"] | "example"
+   web := \opts["w"]
+
+   if \web then {			# make Web page
+      lt := "<BR>"
+      ext := ".html"
+      }
+   else ext := ".wif"
+
+   every name := !args do {
+      input := open(name) | stop("Cannot open ", name)
+      rows := pattread(input)
+      close(input)
+      output := open(basename(name, ".blp") || ext, "w") |
+         stop("Cannot open file for writing.")
+      write(output, "<HTML>")
+      write(output, "<BODY>")
+      cols := rot(rows)		# rotate to get columns
+      treadles := examine(rows)	# get treadles
+      shafts := examine(cols)	# get shafts
+      treadling := []		# construct treadling sequence
+      every put(treadling, treadles[!rows])
+      threading := []		# construct threading sequence
+      every put(threading, shafts[!cols])
+      tieup := table()
+      every row := key(treadles) do {		# get unique rows
+         treadle := treadles[row]			# assigned treadle number
+         tie_line := repl("0", *shafts)		# blank tie-up line
+         every i := 1 to *row do			# go through row
+            if row[i] == "1" then			#    if warp on top
+               tie_line[threading[i]] := "1"	#       mark shaft position
+         tieup[treadle] := tie_line		# add line to tie-up
+         }
+      write(output, "[WIF]", lt)
+      write(output, "Version=1.1", lt)
+      write(output, "Date=" || &dateline, lt)
+      write(output, "Developers=ralph@cs.arizona.edu", lt)
+      write(output, "Source Program=dd2wif.icn", lt)
+      write(output, "[CONTENTS]", lt)
+      write(output, "Color Palette=yes", lt)
+      write(output, "Text=yes", lt)
+      write(output, "Weaving=yes", lt)
+      write(output, "Tieup=yes", lt)
+      write(output, "Color Table=yes", lt)
+      write(output, "Threading=yes", lt)
+      write(output, "Treadling=yes", lt)
+      write(output, "Warp colors=yes", lt)
+      write(output, "Weft colors=yes", lt)
+      write(output, "Warp=yes", lt)
+      write(output, "Weft=yes", lt)
+      write(output, "[COLOR PALETTE]", lt)
+      write(output, "Entries=2", lt)
+      write(output, "Form=RGB", lt)
+      write(output, "Range=0," || 2 ^ 16 - 1, lt)
+      write(output, "[TEXT]", lt)
+      write(output, "Title=", basename(name, ".blp"), lt)
+      write(output, "Author=Ralph E. Griswold", lt)
+      write(output, "Address=5302 E. 4th St., Tucson, AZ 85711-2304", lt)
+      write(output, "EMail=ralph@cs.arizona.edu", lt)
+      write(output, "Telephone=520-881-1470", lt)
+      write(output, "FAX=520-325-3948", lt)
+      write(output, "[WEAVING]", lt)
+      write(output, "Shafts=", *shafts, lt)
+      write(output, "Treadles=", *treadles, lt)
+      write(output, "Rising shed=yes", lt)
+      write(output, "[WARP]", lt)
+      write(output, "Threads=", *threading, lt)
+      write(output, "Units=Decipoints", lt)
+      write(output, "Thickness=10", lt)
+      write(output, "Color=1", lt)
+      write(output, "[WEFT]", lt)
+      write(output, "Threads=", *treadling, lt)
+      write(output, "Units=Decipoints", lt)
+      write(output, "Thickness=10", lt)
+      write(output, "Color=2", lt)
+      write(output, "[WARP THICKNESS]", lt)
+      write(output, "[WEFT THICKNESS]", lt)
+      write(output, "[COLOR TABLE]", lt)
+      write(output, "1=0,0,0", lt)
+      write(output, "2=65535,65535,65535", lt)
+      write(output, "[THREADING]", lt)
+      every i := 1 to *threading do
+         write(output, i, "=", threading[i], lt)
+      write(output, "[TREADLING]", lt)
+      every i := 1 to *treadling do
+         write(output, i, "=", treadling[i], lt)
+      write(output, "[TIEUP]", lt)
+      every i := 1 to *tieup do
+         write(output, i, "=", tromp(tieup[i]), lt)
+      if \web then {
+         write(output, "</BODY>")
+         write(output, "</HTML>")
+         }
+      close(output)
+      }
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure examine(array) 
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/ddextend.icn b/ipl/gprogs/ddextend.icn
new file mode 100644
index 0000000..61f590e
--- /dev/null
+++ b/ipl/gprogs/ddextend.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     ddextend.icn
+#
+#	Subject:  Program to extend pattern to a minimum size
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 11, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a drawdown from standard input in the form of
+#  rows of zeros and ones, in which ones indicate places where the
+#  warp thread is on top and zeros where the weft thread is on top.
+#  It also accepts a BLP as input.
+#
+#  At present, the minimum size is 16, built in.  This should be changed
+#  to a value that could be specified as an option.
+#
+#  It outputs a BLP.
+#
+############################################################################
+#
+#  Links:  patutils, patxform
+#
+############################################################################
+
+link patutils
+link patxform
+
+$define Minimum 16
+
+procedure main()
+   local line, rows, q, r, new_rows
+
+   rows := []
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   while put(rows, read())
+
+   # extend width if necessary
+
+   if *rows[1] < Minimum then {
+      q := Minimum / *rows[1]
+      r := Minimum % *rows[1]
+      if r ~= 0 then q +:= 1		# extension factor
+      new_rows := copy(rows)
+      every 2 to q do
+         new_rows := pcaten(new_rows, rows, "h") 
+      rows := new_rows
+      }
+
+   # extend height if necessary
+
+   if *rows < Minimum then {
+      q := Minimum / *rows
+      r := Minimum % *rows
+      if r ~= 0 then q +:= 1		# extension factor
+      new_rows := copy(rows)
+      every 2 to q do
+         new_rows := pcaten(new_rows, rows, "v") 
+      rows := new_rows
+      }
+
+   write(rows2pat(rows))
+
+
+end
diff --git a/ipl/gprogs/design1.icn b/ipl/gprogs/design1.icn
new file mode 100644
index 0000000..825c5f8
--- /dev/null
+++ b/ipl/gprogs/design1.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     design1.icn
+#
+#	Subject:  Program to draw spokes design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is just an example of an interesting graphic design.  It can
+#  easily be modified to produce other designs.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(argl)
+   local i, j, k, angle, incr, xpoint, ypoint, size, radius, xc, yc
+
+   i := integer(argl[1]) | 20
+
+   size := 300
+   radius := size / 4
+   xc := yc := size / 2
+
+   WOpen("label=design", "width=" || size, "height=" || size) |
+      stop("*** cannot open window")
+
+   angle := 0.0
+   incr := 2 * &pi / i
+
+   every j := 1 to i do {
+      spokes(xc + radius * cos(angle), yc + radius * sin(angle),
+         radius, i, angle)
+      angle +:= incr
+      }
+
+   Event()
+
+end
+
+procedure spokes(x, y, r, i, angle)
+   local incr, j
+
+   incr := 2 * &pi / i 
+
+   every j := 1 to i do {
+      DrawLine(x, y, x + r * cos(angle), y + r * sin(angle))
+      angle +:= incr
+      }
+
+   return
+
+end
+
diff --git a/ipl/gprogs/design2.icn b/ipl/gprogs/design2.icn
new file mode 100644
index 0000000..8ee72ac
--- /dev/null
+++ b/ipl/gprogs/design2.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     design2.icn
+#
+#	Subject:  Program to draw circular design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws a design in which i points around a circle are
+#  all connected to each other.  The number of points is given as
+#  a command-line argument (default 20).  Values larger than 30 produce
+#  results that are too dense to be interesting.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, joinpair, wopen
+#
+############################################################################
+
+link gobject
+link joinpair
+link wopen
+
+procedure main(argl)
+   local i, j, k, angle, incr, size, radius, xc, yc, points
+
+   i := integer(argl[1]) | 20
+
+   size := 300
+   radius := size / 2
+   xc := yc := size / 2
+
+   WOpen("label=mandala", "width=" || size, "height=" || size) |
+      stop("*** cannot open window")
+
+   points := list(i)
+
+   angle := 0.0
+   incr := 2 * &pi / i
+
+   every j := 1 to i do {
+      points[j] := Point(xc + radius * cos(angle), yc + radius * sin(angle))
+      angle +:= incr
+      }
+
+   joinpair(points, points)
+
+   Event()
+
+end
diff --git a/ipl/gprogs/design3.icn b/ipl/gprogs/design3.icn
new file mode 100644
index 0000000..3e31dbc
--- /dev/null
+++ b/ipl/gprogs/design3.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     design3.icn
+#
+#	Subject:  Program to draw square design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws a design in which i points around a square are
+#  all connected to each other.  The number of points along a side
+#  (default 10) and the distance between them (default 40) are given as
+#  command-line arguments.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, joinpair, wopen
+#
+############################################################################
+
+link gobject
+link joinpair
+link wopen
+
+procedure main(argl)
+   local i, j, k, d, extent, points, x, y
+
+   i := integer(argl[1]) | 10
+   d := integer(argl[2]) | 40
+
+   extent := i * d
+
+   WOpen("label=mandala", "width=" || extent, "height=" || extent) |
+      stop("*** cannot open window")
+
+   points := []
+
+   every x := 0 to extent by d do {	# x direction, with corners
+      put(points, Point(x, 0))		# top
+      put(points, Point(x, extent))	# bottom
+      }
+
+   every y := d to extent - d by d do {	# y direction, without corners
+      put(points, Point(0, y))		# left side
+      put(points, Point(extent, y))	# right side
+      }
+
+   joinpair(points, points)
+
+   Event()
+
+end
diff --git a/ipl/gprogs/dlgvu.icn b/ipl/gprogs/dlgvu.icn
new file mode 100644
index 0000000..63a933d
--- /dev/null
+++ b/ipl/gprogs/dlgvu.icn
@@ -0,0 +1,1900 @@
+############################################################################
+#
+#	File:     dlgvu.icn
+#
+#	Subject:  Program to display USGS DLG map files
+#
+#	Authors:  Gregg M. Townsend and William S. Evans
+#
+#	Date:     October 2, 2005
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Contributor:  Frank Glandorf
+#
+############################################################################
+#
+#	Dlgvu displays and prints USGS digital map data.
+#
+#	usage:  dlgvu [options] file...
+#
+#	Each file argument is one of:
+#	    a directory containing DLG files in SDTS format
+#	    a ZIP format archive of such files  (requires "unzip" utility)
+#	    a text file containing coordinates of paths and features
+#
+#	All interaction is via mouse actions and keyboard shortcuts.
+#	The display window may be resized as desired.
+#
+############################################################################
+#
+#	Command options:
+#
+#	-c	    display coverage map only, without loading data
+#	-d	    print some debugging data
+#	-n	    no display; just report statistics, and then quit
+#		    (this still requires X-Windows, unfortunately)
+#	-p	    use slower, more precise coordinate conversion
+#	-q	    quiet mode: no commentary to stdout
+#	-t	    load only maps traversed by paths, ignoring others
+#	-o logfile  specify output log to use instead of standard output
+#
+#	-l abcd     display only layers a, b, c, d
+#	-x abcd     exclude layers a, b, c, d
+#
+#		For -l and -x, the following layer codes are used.
+#		(USGS equivalents are given in parentheses.)
+#
+#		b  boundaries		(BD: boundaries)
+#		c  contour lines	(HP: hypsography)
+#		d  sand, gravel, lava	(NV: nonvegetative features)
+#		f  feature labels	read from text files
+#		g  GPS paths		read from text files
+#		l  land sections	(PL: public lands)
+#		m  markers		(SM: survey markers)
+#		n  file names
+#		o  other		unknown layers from non-DLG data
+#		r  roads		(RD: roads)
+#		s  structures		(MS: manmade structures)
+#		t  train tracks		(RR: railroads)
+#		u  utilities		(MT: miscellaneous transportation)
+#		v  vegetation		(SC: surface cover)
+#		w  water		(HY: hydrology)
+#
+#	Additionally, the standard Window() options are accepted;
+#	in particular, "-F fgcolor" sets the color used for drawing
+#	unrecognized ("other") layers, as from USGS "National Atlas"
+#	digital files, and "-G 800x500" sets the initial window size.
+#
+#	Typical usage is simply
+#		dlgvu dir1 [dir2 ...]
+#	to display one or more adjacent maps.  The -x option can speed
+#	things up by excluding unwanted layers; the contour layer is
+#	especially slow.
+#
+#	A ZIP archive can replace a directory name if Icon can open
+#	the unzip program via a pipe.  For example:
+#		dlgvu woodside.zip palo_alto.zip
+#
+############################################################################
+#
+#	Mouse actions:
+#
+#	To zoom to a particular region, sweep out the region using the
+#	left mouse button.  To cancel a sweep, reduce its width or height
+#	to fewer than ten pixels.
+#
+#	If nothing appears to be happening after zooming in, the program
+#	is probably drawing offscreen.  It's not smart about that.  Be
+#	patient, and it will soon display the visible region.
+#
+#	To display the latitude / longitude of a location, and a scale bar,
+#	hold down the right mouse button.
+#
+#	To record a labeled feature, shift-click the left mouse button.
+#	Enter a name in the pop-up dialog box.  The location and name are
+#	written to the log file and added to the feature layer of the map.  
+#
+#	To record an anonymous location to the log file, shift-click with
+#	the right mouse button instead.  No dialog box appears.  A sequence
+#	of anonymous locations can be read as a path by a subsequent
+#	program run.
+#
+############################################################################
+#
+#	Keyboard actions:
+#
+#	+ or =		zoom in
+#	- or _		zoom out
+#	0 or Home	zoom to initial view
+#	arrow keys	pan the display  (hold Shift key for smaller pan)
+#
+#	b, c, d, etc.	toggle display of specified layer
+#	a		display all loaded layers including n (file names)
+#	x		display no layers (just an empty window)
+#
+#	Esc		stop drawing  (any unrecognized key does this)
+#	space or Enter	redraw screen  (e.g. after inadvertent interrupt)
+#	q		quit
+#
+#	p or PrntScrn	print visible portion to PostScript file
+#
+#	The file produced by PrntScrn is an Encapsulated PostScript file
+#	suitable either for direct printing ("lpr file.ps") or for import
+#	into another document.
+#
+############################################################################
+#
+#	Input files:
+#
+#	In directories and archives, only files with names ending in .ddf
+#	or .DDF are read; others are ignored.  These files must be in SDTS
+#	(Spatial Data Transfer Standard) format, which is used by the USGS
+#	for all new DLG files.
+#
+#	Text files supply coordinates for features or paths.  GPS receivers
+#	are one possible source for such data.  A text file can supply
+#	paths, features, or both.
+#
+#	Paths are specified by sequences of lines that end with two decimal
+#	values.  The values are interpreted as latitude and longitude, in
+#	that order.  An interruption in the sequence (such as a blank line)
+#	indicates a break between paths.
+#
+#	Features, or waypoints, are given by lines that *begin* with two
+#	decimal values.  The rest of the line is taken as a label, which
+#	must not be empty and must not end with two decimal values.
+#
+#	Any other line in a text file breaks a path sequence but is
+#	otherwise ignored.
+#
+############################################################################
+#
+#	About DLG files:
+#
+#	Dlgvu was written to display digitized topographic maps produced
+#	by the United States Geological Survey (USGS).  The current file
+#	format is based on the Spatial Data Transfer Standard (SDTS).
+#	Some older files are available in other formats (including
+#	"standard" and "optional") not supported by this program.
+#
+#	DLG files are available free from the USGS at this web page:
+#		http://edc.usgs.gov/doc/edchome/ndcdb/ndcdb.html
+#	Coverage is incomplete.  24K maps, the most detailed, are available
+#	for only some areas, and many maps lack some of the data layers.
+#
+#	Each map is represented by a collection of gzipped tar files
+#	(one for each map layer) that are unpacked for display.  Multiple
+#	files versions may be available, and not all layers are available
+#	for all maps.
+#
+#	IMPORTANT:  Do not blindly unpack all the tar files of a map into
+#	the same directory; due to the use of duplicate file names in the
+#	transportation layers, some files will be overwritten.  Instead,
+#	unpack the roads, railroads, and miscellaneous transportation
+#	layers separately, each time renaming the TR*.DDF files to RD*.DDF,
+#	RR*.DDF, and MT*.DDF respectively.
+#
+#	Dlgvu has mainly been tested and tuned using "large scale" DLG
+#	files (1:24000 scale, covering 7.5 minute quadrangles).  Other
+#	scales produce less attractive displays, partly due to different
+#	encodings:  For example, the same residential streets may be encoded
+#	as "Class 3 Roads" in 24K files but "Class 4 Roads" in 100K files.
+#
+#	Dlgvu does not presume to understand ISO 8211, DDF, STDS, and TVP
+#	in their full complexity and generality.  Undoubtedly it is making
+#	some unwarranted assumptions based on observed practice.  The file
+#	renaming recommended above is contrary to specification but allows
+#	a complete map to be stored in a single flat directory.
+#
+#	For more information, and some sample data files, visit:
+#		http://www.cs.arizona.edu/icon/oddsends/dlgvu/
+#
+############################################################################
+#
+#	Displayed features:
+#
+#	DLG files are rich in detail.  Dlgvu displays only some of this
+#	encoded data.
+#
+#	Put simply, dlgvu understands point and line features but not
+#	area features.  It draws a small square for a structure location,
+#	or draws the outline of a large building, but it does not color in
+#	an "urban area" in which individual structures are not plotted.
+#	It displays the shoreline of a river, and any islands, but does
+#	not understand enough to color the river area itself blue.
+#
+#	Dlgvu recognizes some line features for special display.  For
+#	example, major roads are drawn with wide lines, and trails are
+#	drawn with dashed red lines.  Lines with unrecognized attributes,
+#	or no attributes, are drawn in a default style.  Point features
+#	("school", "windmill", etc.) are not distinguished.
+#
+#	Area features are drawn only in outline.  The most obvious of
+#	these are vegetated areas and urban areas.  Land section and
+#	civil boundaries also delimit area features.
+#
+#	Colors are assigned as follows (with layer codes on the left):
+#
+#		b  boundaries		gold
+#		c  contour lines	tan
+#		f  feature labels	black
+#		g  GPS path		bold pink over "highlighter"
+#		l  land sections	pale red
+#		m  survey markers	blue
+#		n  file names		green
+#		o  other data		brown (can override with -F option)
+#		r  roads, class 1-3	black or dark gray
+#		r  roads, class 4-5	dashed dark gray
+#		r  trails		dashed red
+#		s  structures		brownish gray
+#		t  railroads		rust
+#		t  rapid transit rails	dark blue
+#		u  pipelines		dashed purple
+#		u  power lines		purple
+#		u  airport runways	gray
+#		v  vegetation		light green
+#		w  water		light blue
+#		x  sand, gravel, lava	greenish gray
+#
+#	Dlgvu uses a simple rectangular projection that is satisfactory
+#	for small areas like 24K quadrangles but less suitable for large
+#	areas such as whole states.
+#
+############################################################################
+#
+#	The loading process:
+#
+#	Data is loaded in two phases.  A quick preloading phase determines
+#	the available layers and the geographic areas covered.  A status
+#	line is output for each file.  For example:
+#
+#		bcl-r-tu-w N27 15 C66 42a 93a  ia/ames-w
+#
+#	The first field shows which layers were found.  N27 declares that
+#	coordinates use the NAD 1927 geodetic datum; N83 for NAD 1983 is
+#	the other likely value.  15 is the UTM zone number; state maps with
+#	latitude/longitude data show "LL" here.  C66 means that the data
+#	appears to have been projected using the Clarke 1866 ellipsoid; the
+#	other likely value is "G80" for the GRS 1980 ellipsoid.  Dlgvu uses
+#	this to infer the datum, because the declared datum value is a less
+#	reliable indicator.
+#
+#	"42a 93a" gives the coordinates of the southeast corner of the map,
+#	in degrees North and West, with letters "a" through "h" indicating
+#	fractions from 0/8 through 7/8.  The final field is the file name.
+#
+#	If the layers in a file are inconsistent (for example, in the
+#	inferred ellipsoid), multiple lines appear with a "*" prefix.
+#	If display of a file is suppressed by the "-t" option, an X
+#	prefixes the line.
+#
+#	For text files, a notation such as "3:489+0" replaces layer
+#	indicators, counting continuous segments, total points, and
+#	feature labels.  Coordinate values are assumed to use the
+#	WGS 1984 ("W84") datum and ellipsoid.
+#
+#	The display appears during the longer second loading phase.  For
+#	each layer of each input file, bounds are drawn and a progress bar
+#	changes as data is read.  The color of the label indicates the
+#	layer being loaded.
+#
+############################################################################
+#
+#	Tiling multiple maps:
+#
+#	Multiple maps are displayed in proper relation.  To quickly see
+#	how the maps of a set will join, use "dlgvu -c".
+#
+#	Small gaps or overlaps occasionally appear along boundaries when
+#	maps are tiled; these are symptomatic of inconsistent datums, and
+#	they reflect the true relationships of the maps to the earth.
+#
+#	Dlgvu loads all necessary data into memory, so there is a very
+#	real limit to the amount of data that can be displayed.  Contour
+#	lines, especially, take lots of memory, but they can be excluded
+#	by calling "dlgvu -xc".  A 128MB Linux system can typically
+#	display three to five complex 24K quadrangles simultaneously
+#	without thrashing.
+#
+############################################################################
+#
+#	Known problems:
+#
+#	On Linux, we have seen occasional crashes of the XFree86 server,
+#	especially under conditions of tight memory and/or extreme zooming.
+#
+#	Colors on printed maps vary somewhat from those seen onscreen,
+#	depending on the printer.  Printed maps do not include the "n"
+#	(file name) layer.
+#
+#	While data is being loaded from a ZIP file, interrupting with ^Z
+#	can disrupt the "unzip" pipe and cause the program to crash or to
+#	display artifacts after resumption.
+#
+#	Some 100K USGS maps come with multiple sets of boundary files,
+#	leading to file name collisions for which no workaround has been
+#	found.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cartog, clipping, ddfread, geodat, graphics, io, mapnav,
+#	numbers, options, pscript, random, strings, wildcard, zipread
+#
+############################################################################
+
+
+
+$include "keysyms.icn"
+
+link cartog
+link clipping
+link ddfread
+link geodat
+link graphics
+link io
+link mapnav
+link numbers
+link options
+link pscript
+link random
+link strings
+link wildcard
+link zipread
+
+
+
+$define DLG_LAYERS "boclvdwsrtum"	# all "real" layers, in loading order
+
+$define WSIZE "size=1000,1000"		# default window size
+$define ZOOMF 1.5			# zoom factor
+
+$define MAXFONT 18			# maximum font size
+$define MINFONT 8			# minimum font size
+$define MINBOLD 10			# minimum bold font size
+
+$define MEGABYTE (1024 * 1024)		# how many bytes in a megabyte?
+$define STRSIZE (1 * MEGABYTE)		# default string region size
+$define BLKSIZE (16 * MEGABYTE)		# default block region size
+$define MAXDRAW 4000			# maximum (even) args to avoid error 301
+
+$define DEGSCALE 1.0e+6			# divisions per degree for integer scale
+
+# parameters for displaying progress during loading
+$define PINTERVAL 100			# progress interval
+$define PSQUARES 8			# number of progress squares
+$define PSQSIZE 10			# size of progress squares
+$define PSQGAP 2			# size of gap between squares
+
+# PostScript output parameters
+$define PSSCALE 10			# scaling from pixels to PS units
+$define PSPT 24				# size of point feature in PS units
+$define PSLWI 120			# linewidth scaling factor
+
+
+
+record arg (		# command-line argument, excluding options
+   name,		# file or directory name
+   type,		# "dir", "zip", or "txt"
+   wanted,		# if a wanted layer (null if suppressed by -t option)
+   ltable,		# table of layer records, indexed by layer code
+   pcount		# progress bar counter
+   )
+
+record layer (		# one layer in one directory (or zip file)
+   lcode,		# layer code character
+   arg,			# corresponding arg record
+   files,		# list of file names
+   zone,		# UTM zone, or -1 if data is in lat/lon , from XREF file
+   xscale, yscale,	# scaling factors for file values
+   datum,		# stated coordinate datum, from XREF file
+   ellipsoid,		# inferred geodetic ellipsoid
+   icorners,		# map corners in input terms
+   ocorners,		# map corners as projected to lat,lon
+   px, py,		# progress reporting coordinates
+   wd			# width of layer in screen units
+   )
+
+record attrec (		# line drawing attributes:
+   seq,			# drawing sequence
+   lcode,		# layer code
+   key,			# table key (layer or attribute code)
+   width,		# line width
+   color,		# line color
+   style,		# line style
+   segs			# list of segments (list of paths)
+   )
+
+record feature (	# feature or waypoint
+   lat,			# latitude
+   lon,			# longitude
+   label		# label
+   )
+
+
+
+global arglist				# list of arg records
+global opts				# command options
+global chosen				# cset of chosen layers
+
+global xmin, xmax, ymin, ymax		# data range
+global aspect				# input coordinate aspect ratio
+
+global attrib				# attribute style table
+global slist				# list of style records w/ seg lists
+global pcolors				# list of path background colors
+
+global features				# list of feature records
+
+global logfile				# feature log file, if any
+
+
+
+#  main program
+
+procedure main(args)
+   local a, c, e, g, i, r, s, t, v
+
+   # use large region sizes for better efficiency
+   collect(2, STRSIZE)			# string region
+   collect(3, BLKSIZE)			# block (heap) region
+
+   # open window first, to validate and remove any window options
+   Window("label=--", "gamma=1.5", "bg=white", "fg=brown",
+      "resize=on", "canvas=hidden", WSIZE, args)
+
+   randomize()
+   initattrib()
+
+   # process command options
+   opts := options(args, "o:l:x:cdnpqt")
+   if \opts["o"] then {
+      if opts["o"] == "-" then
+         logfile := &output
+      else
+         logfile := open(opts["o"], "w") | stop("cannot write ", opts["o"])
+      }
+   else
+      logfile := &output
+
+   chosen := cset(\opts["l"]) | (&lcase -- 'n')  # start with explicit layers
+   chosen ++:= 'go'			# add paths & other data, if loaded
+   chosen --:= cset(\opts["x"])		# now apply exclusions
+
+   # any remaining arguments are directory names
+   if *args = 0 then
+      stop("usage: ", &progname, " [options] dir...")
+
+   # build list of arg records, classifying each filename or directory
+   arglist := []
+   every s := !args do {
+      if directory(s) then
+         t := "dir"
+      else if iszip(s) then
+         t := "zip"
+      else
+         t := "txt"
+      put(arglist, arg(s, t, 1))
+      }
+
+   # scan text files first, because we haven't really done any validation
+   # (any unrecognized file is classified as a text file)
+   features := []
+   every (a := !arglist) & (a.type == "txt") do
+      rdtext(a)
+
+   # take inventory of DLG directories and files, and load XREF/NPnn info
+   every (a := !arglist) & (a.type ~== "txt") do {
+      inventory(a)
+      every r := !a.ltable do {
+         loadref(r)
+         if r.zone >= 0 then
+            loadcorners(r)
+         else
+            loadbounds(r)
+         }
+      if \opts["t"] & not traversed(!a.ltable) then
+         a.wanted := &null
+      lstats(a)
+      }
+
+   if \opts["n"] then
+      return
+   (*(!arglist).ltable > 0) | stop("no data")
+
+   # show initial screen
+   winit()
+   mapinit(draw, , xmin, xmax, ymax, ymin, aspect)
+   if WAttrib("label") == "--" then	# set window label, if not specified
+      WAttrib("label=" || args[1])
+   WAttrib("canvas=normal")		# make window visible
+   Font("sans,bold,72")
+   Fg("pale yellowish gray")
+   DrawString(60, 120, "LOADING...")
+
+   if \opts["c"] then			# if just coverage wanted
+      chosen := 'n'			# turn on names, turn off loaded paths
+   else {
+
+      # finally: load in the data
+      alllabels()			# show coverage while loading
+      every c := !DLG_LAYERS do		# load by layers
+         every a := !arglist do
+            if \a.wanted then
+               loadlayer(\a.ltable[c])
+
+      # report memory usage
+      every put(c := [], &collections)
+      collect()
+      every put(a := [], &storage)
+      if /opts["q"] then {
+         write(" ", (a[2] + a[3] + MEGABYTE / 2) / MEGABYTE,
+            " MB loaded (", c[3], "+", c[4], " GC)")
+         }
+      }
+
+   # put segment lists in order for drawing
+   # shuffle segments of each list to minimize "dead time" drawing offscreen
+   every put(slist := [], !attrib)
+   slist := sortf(slist, field(attrec, "seq"))
+   every g := (!slist).segs do
+      every !g :=: ?g			# imperfect but good enough shuffle
+
+   # report attribute counts, if -d given
+   if \opts["d"] then {
+      write()
+      every e := !slist do
+         if *e.segs > 0 then
+            write(right(e.seq, 3), ". ", e.lcode, " ",
+               left(e.key, 8), right(*e.segs, 7))
+      write()
+      }
+
+   # consume any events that may have occurred during loading
+   while *Pending() > 0 do
+      Event()
+
+   # draw initial screen
+   EraseArea()
+   mapgen()
+
+   # process interactive commands
+   repeat case e := Event() of {
+      &shift & &lpress:	{ logfeat(e) }
+      &shift & &rpress:	{ logfeat(e) }
+      &rpress:		{ locate() }
+      !"\n\r ":		{ mapgen() }
+      !"pP" | Key_PrSc:	{ print(); Bg("white") }
+      !"aA":		{ chosen := &lcase; mapgen() }
+      !"xX":		{ chosen := ''; EraseArea(); mapgen() }
+      !"qQ":		{ exit() }
+      any(&letters, e) & e: {
+         e := map(e)
+         if any(chosen, e) then {
+            chosen --:= e
+            EraseArea()
+            mapgen()
+            }
+         else {
+            chosen ++:= e
+            mapgen()
+            }
+         }
+      default:		{ mapevent(e) }
+      }
+end
+
+
+
+#  rdtext(arg) -- read a text file of paths and features
+
+procedure rdtext(arg)
+   local f, i, n, r, s, t, w, line
+   local lat, lon, alt, segs, points, nsegs, npts, nfeat
+   local xmn, xmx, ymn, ymx
+   static npaths
+   initial npaths := 0
+
+   f := open(arg.name) | stop("cannot open: ", arg.name)
+   s := "g" || (npaths % *pcolors + 1)
+   npaths +:= 1
+
+   segs := attrib[s].segs
+   nsegs := *segs
+   npts := 0
+   nfeat := 0
+   xmn := ymn := +180 * DEGSCALE
+   xmx := ymx := -180 * DEGSCALE
+
+   points := []
+   while line := read(f) do {			# read line
+      every put(w := [], words(line))		# break into fields
+      # check first for path entry
+      if (lat:=real(w[-3])) & (lon:=real(w[-2])) & (alt:=real(w[-1])) &
+            (-90.<=lat<=90.) & (-180.<=lon<=180.) & (-1400<alt<30000) then {
+         npts +:= 1
+         lon *:= DEGSCALE
+         lat *:= DEGSCALE
+         put(points, integer(lon), integer(lat))
+         xmn >:= lon
+         ymn >:= lat
+         xmx <:= lon
+         ymx <:= lat
+         }
+      else if (lat := real(w[-2])) & (lon := real(w[-1])) &
+            (-90. <= lat <= 90.) & (-180. <= lon <= 180.) then {
+         npts +:= 1
+         lon *:= DEGSCALE
+         lat *:= DEGSCALE
+         put(points, integer(lon), integer(lat))
+         xmn >:= lon
+         ymn >:= lat
+         xmx <:= lon
+         ymx <:= lat
+         }
+      else {
+         # interrupt path sequence
+         if *points > 0 then {
+            put(segs, points)
+            points := []
+            }
+         # check for feature (waypoint) label
+         if (lat := real(get(w))) & (lon := real(get(w))) &
+               (-90. <= lat <= 90.) & (-180. <= lon <= 180.) then {
+            nfeat +:= 1
+            lon *:= DEGSCALE
+            lat *:= DEGSCALE
+            xmn >:= lon
+            ymn >:= lat
+            xmx <:= lon
+            ymx <:= lat
+            s := ""
+            while s ||:= " " || get(w)
+            put(features, feature(lat, lon, s[2:0]))
+            }
+         }
+      }
+   if *points > 0 then
+      put(segs, points)
+
+   nsegs := *segs - nsegs
+   if nsegs = 0 & nfeat = 0 then
+      stop("no data: ", arg.name)
+
+   r := layer("g", arg)
+   r.zone := -1
+   r.datum := "WGS84"
+   r.ellipsoid := "WGS84"
+   r.icorners := r.ocorners := [xmn, ymn, xmn, ymx, xmx, ymx, xmx, ymn]
+   t := table()
+   t["g"] := r
+   arg.ltable := t
+
+   n := 0
+   every n +:= *segs[-nsegs to -1]
+   if /opts["q"] then
+      write(right(nsegs || ":" || npts || "+" || nfeat, 14), " ", lsumm(r))
+
+   close(f)
+   return
+end
+
+
+
+#  ddpopen(r, p) -- generate open DDF files from layer r matching pattern p
+
+procedure ddpopen(r, p)
+   local a, f, d, s, fname
+
+   a := r.arg
+   every fname := !r.files do {
+      if not (map(fname) ? wild_match(p)) then
+         next
+      s := a.name || "/" || fname
+      f := &null
+      if a.type == "zip" then
+         f := zipfile(a.name, fname)
+      else
+         f := open(s, "ru")
+      d := ddfopen(\f) | stop("cannot open as DDF: ", s)
+      suspend d
+      }
+   fail
+end
+
+
+
+#  inventory(a) -- inventory arg entry a
+
+procedure inventory(a)
+   local b, c, f, fname, m, flist, trcount
+
+   # load filenames into list, because we need to scan it twice
+   flist := []
+   if a.type == "zip" then
+      f := zipdir(a.name)
+   else
+      f := open(a.name)
+   while put(flist, read(f))
+   close(f)
+
+   # count TR01LE??.DDF files
+   trcount := 0
+   every fname := !flist do
+      if map(fname) ? (tab(-12) & ="tr01le") then
+         trcount +:= 1
+
+   # classify files and save the ones we want
+   a.ltable := table()
+   every fname := !flist do {
+      map(fname) ? {
+         while tab(upto('/') + 1)
+         pos(-12)				| next
+         move(8)				| next
+         =".ddf"				| next
+         }
+      b := fname[-12:-4]			| next
+
+      every c := !lcodes(b, trcount) do {
+         if any(chosen, c) then {
+            #  this is a wanted file in a wanted layer; remember it
+            /a.ltable[c] := layer(c, a, [])
+            put(a.ltable[c].files, fname)
+            }
+         }
+      }
+
+   return
+end
+
+
+
+#  lcodes(basename, trcount) -- deduce layer code(s) from file basename
+
+procedure lcodes(basename, trcount)
+   local n, s, tr
+
+   map(basename) ? {
+      if move(4) & ="a" & move(2) & any('f') then {
+         # xxxxAllF.DDF is layer ll attribute file
+         s := move(-2)
+         }
+      else if ="tr01" & =("le" | "np") & (n := integer(move(2))) then {
+         # TR01LEnn.DDF (or NPnn) is a transportation layer in a 100K map
+         if trcount > 12 then
+            s := ["mt", "rd", "rd", "rd", "rd", "rr"] [(n + 3) / 4]
+         else
+            s := ["mt", "rd", "rr"] [(n + 3) / 4]
+         }
+      else if move(2) & ="tr" & =("le" | "ne") & (n := integer(move(2))) then {
+         # xxTRLEnn.DDF (or NExx) is a transportation layer in state xx 250K map
+         s := ["mt", "rd", "rr"] [n % 3 + 1]
+         }
+      else {
+         move(2)
+         if any(&letters) then
+            s := move(2)	# xxllyyyy is layer ll for state xx
+         else
+            s := move(-2)	# ll01xxxx is layer ll otherwise
+         }
+      }
+
+   return case s of {
+      "bd":  "b"	# boundaries	(BD: boundaries)
+      "hp":  "c"	# contours	(HP: hypsography)
+      "nv":  "d"	# sand etc.	(NV: nonvegetative features)
+      "pl":  "l"	# land sections	(PL: public lands)
+      "sm":  "m"	# markers	(SM: survey markers)
+      "rd":  "r"	# roads		(RD: roads)
+      "ms":  "s"	# structures	(MS: manmade structures)
+      "rr":  "t"	# train tracks	(RR: railroads)
+      "mt":  "u"	# utilities	(MT: miscellaneous transportation)
+      "tr":  "rtu"	# transportatn  (TR: transportation, shared by r/t/u)
+      "sc":  "v"	# vegetation	(SC: surface cover)
+      "hy":  "w"	# water		(HY: hydrology)
+      default:  "o"	# other
+      }
+end
+
+
+
+#  getdata(r, p, l) -- get data vector l of layer r using file pattern p
+
+procedure getdata(r, p, l)
+   local ddfile, d, e, zone
+
+   ddfile := ddpopen(r, p) |
+      stop("no file ", p, " for layer ", r.lcode, ": ", r.arg.name)
+   while d := ddfread(ddfile) do
+      every e := !d do
+         if e[1] == l then
+            break break
+   ddfclose(ddfile)
+   return e
+end
+
+
+
+#  loadref(r) -- load XREF and IREF files for layer r of arg a
+
+procedure loadref(r)
+   local e
+
+   e := getdata(r, "*iref.ddf", "IREF")
+   until get(e) == "BI32"
+   r.xscale := real(get(e))
+   r.yscale := real(get(e))
+
+   e := getdata(r, "*xref.ddf", "XREF")
+   case e[5] of {
+      "NAS":	r.datum := "NAD27"	# North American 1927
+      "NAX":	r.datum := "NAD83"	# North American 1983
+      "WGA":	r.datum := "WGS60"	# World Geodetic System 1960
+      "WGB":	r.datum := "WGS66"	# World Geodetic System 1966
+      "WGC":	r.datum := "WGS72"	# World Geodetic System 1972
+      "WGE":	r.datum := "WGS84"	# World Geodetic System 1984
+      default:  r.datum := "?????"	# unrecognized
+      }
+   if e[4] == "UTM" then
+      r.zone := integer(e[6])
+   else
+      r.zone := -1
+
+   return
+end
+
+
+
+#  loadbounds(r) -- load SPDM file to determine range of locations
+#
+#  (SPDM files are used with 250K DLG layers)
+
+procedure loadbounds(r)
+   local e, xmn, xmx, ymn, ymx
+
+   e := getdata(r, "*spdm.ddf", "DMSA")
+   get(e)
+   xmn := get(e) * r.xscale * DEGSCALE
+   ymn := get(e) * r.yscale * DEGSCALE
+   xmx := get(e) * r.xscale * DEGSCALE
+   ymx := get(e) * r.yscale * DEGSCALE
+   r.ellipsoid := "Clarke66"
+   r.icorners := r.ocorners := [xmn, ymn, xmn, ymx, xmx, ymx, xmx, ymn]
+   return
+end
+
+
+
+#  loadcorners(r) -- load NPnn file to determine corner points
+#
+#  (NPnn files are used with 24K and 100K DLG layers)
+
+procedure loadcorners(r)
+   local ddfile, d, e, i, x, y, L, C66, G80
+
+   every ddfile := ddpopen(r, "*np??.ddf") do {
+      L := []
+      while d := ddfread(ddfile) do
+         every e := !d do
+            if get(e) == "SADR" then
+               while put(L, get(e))
+      ddfclose(ddfile)
+      r.icorners := cmerge(r.icorners, L)
+      }
+
+   if /r.icorners then
+      stop("no NPnn file for layer ", r.lcode, ": ", r.arg.name)
+
+   # infer ellipsoid of UTM projection
+   L := []
+   every i := 1 to *r.icorners by 2 do {
+      x := (r.icorners[i] * r.xscale - 500000.0)
+      y := (r.icorners[i+1] * r.yscale)
+      put(L, r.zone, x, y)
+      }
+   C66 := project(invp(utm("Clarke66")), L)
+   G80 := project(invp(utm("GRS80")), L)
+
+   if quadfit(C66) < quadfit(G80) then {
+      r.ellipsoid := "Clarke66"
+      r.ocorners := project(molodensky("NAD27", "NAD83"), C66)
+      }
+   else {
+      r.ellipsoid := "GRS80"
+      r.ocorners := G80
+      }
+
+   every !r.ocorners *:= DEGSCALE
+   return
+end
+
+
+
+#  cmerge(A, B) -- merge two corners lists
+#
+#  Assumes that the corner order is [SW, NW, NE, SE]
+#  and takes the more extreme value for each coordinate.
+
+procedure cmerge(A, B)
+   local C
+
+   if /A | /B then return \A | \B
+   C := []
+
+   if A[1] + A[2] < B[1] + B[2] then
+      put(C, A[1], A[2])
+   else
+      put(C, B[1], B[2])
+
+   if A[3] - A[4] < B[3] - B[4] then
+      put(C, A[3], A[4])
+   else
+      put(C, B[3], B[4])
+
+   if A[5] + A[6] > B[5] + B[6] then
+      put(C, A[5], A[6])
+   else
+      put(C, B[5], B[6])
+
+   if A[7] - A[8] > B[7] - B[8] then
+      put(C, A[7], A[8])
+   else
+      put(C, B[7], B[8])
+
+   return C
+end
+
+
+
+#  quadfit(L) -- proximity of coordinate in L to multiple of 1/8
+
+procedure quadfit(L)
+   local i, mn, mx, a, b
+
+   mn := 1.0
+   every i := 1 to *L by 2 do {
+      a := L[i] * 8
+      b := L[i+1] * 8
+      mx := max(abs(a - round(a)), abs(b - round(b)))
+      mn := min(mn, mx)
+   }
+   return mn
+end
+
+
+
+#  lstats(a) -- report statistics for the layers of arg a
+
+procedure lstats(a)
+   local c, d, g, k, l, n, r, v, z
+
+   if \opts["q"] then
+      return
+
+   # group by identical projection attributes
+   g := table('')
+   every r := !a.ltable do {
+      k := lsumm(r)
+      g[k] ++:= r.lcode
+      }
+
+   # report consistent layers together on one line
+   l := sort(g, 3)
+   while k := get(l) do {
+      v := get(l)
+      writes(if /a.wanted then "X" else " ")
+      writes(if *g = 1 then " " else "*")
+      every c := !cset(DLG_LAYERS) do			# list alphabetically
+         writes(if upto(v, c) then c else "-")
+      write(" ", k)
+      }
+   return
+end
+
+
+
+#  lsumm(r) -- return one-line layer info summary
+
+procedure lsumm(r)
+   return r.datum[1] || r.datum[-2:0] || " " ||
+      (if r.zone < 0 then "LL" else right(r.zone, 2)) || " " ||
+      r.ellipsoid[1] || r.ellipsoid[-2:0] || " " ||
+      right(degc(r.ocorners[-1]), 3) || " " ||
+      left(degc(r.ocorners[-2]), 4) || " " ||
+      r.arg.name
+end
+
+
+
+#  degc(d) -- code degree measurement as nnnx where x is a-h for 0/8 to 7/8
+
+procedure degc(d)
+   local n, x
+
+   d := abs(d / DEGSCALE) + 0.0625		# 1/16 for rounding
+   n := integer(d)
+   x := "abcdefgh" [1 + integer(8 * (d - n))]
+   return n || x
+end
+
+
+
+#  field(constr, key) -- given record constructor, find index of named field
+
+procedure field(constr, key)
+   local i, r
+   image(constr) ? ="record constructor" | fail
+   r := constr()
+   every i := 1 to *r do
+      r[i] := i
+   return r[key]
+end
+
+
+
+#  traversed(r) -- check whether layer r is traversed by a path
+
+procedure traversed(r)
+   local k, i, segs, pts, xmin, xmax, ymin, ymax
+
+   xmin := xmax := r.ocorners[1]
+   every xmin >:= r.ocorners[3 | 5 | 7]
+   every xmax <:= r.ocorners[3 | 5 | 7]
+   ymin := ymax := r.ocorners[2]
+   every ymin >:= r.ocorners[4 | 6 | 8]
+   every ymax <:= r.ocorners[4 | 6 | 8]
+
+   every k := key(attrib) do
+      if k ? (="g" & tab(many(&digits)) & pos(0)) then
+         every pts := !attrib[k].segs do
+            every i := 1 to *pts by 2 do
+               if xmin < pts[i] < xmax & ymin < pts[i+1] < ymax then
+                  return
+
+   fail
+end
+
+
+
+#  loadlayer(r) -- load one layer of files
+
+procedure loadlayer(r)
+   local p, attid, ddfile
+
+   setdraw(attrib[r.lcode])
+   drawlabel(r)
+
+   attid := table()
+   every ddfile := ddpopen(r, "*a??f.ddf") do {
+      loadatts(ddfile, r, attid)
+      ddfclose(ddfile)
+      }
+
+   every ddfile := ddpopen(r, "*ne??.ddf" | "*le??.ddf") do {
+      loadpts(ddfile, r, attid)
+      ddfclose(ddfile)
+      }
+
+   return
+end
+
+
+
+#  loadatts(ddfile, r, attid) -- load attribute ID table
+
+procedure loadatts(ddfile, r, attid)
+   local d, e, i, k, n, s, v
+
+   n := -1
+   if r.lcode == "t" then
+      i := [1, 7]		# for RR, append tunnel and rapid transit flags
+   else
+      i := []
+
+   while d := ddfread(ddfile) do {
+      k := &null
+      every e := !d do {
+         s := get(e)
+         if s == "ATPR" then
+            k := get(e) || get(e)
+         else if s == "ATTP" then {
+            v := get(e)
+            every \v ||:= (" " ~== e[!i])
+            attid[\k] := v
+            if (n +:= 1) % PINTERVAL = 0 then
+               progress(r)
+            }
+         }
+      }
+   return
+end
+
+
+
+#  loadpts(ddfile, r, attid) -- load coordinate file into memory
+
+procedure loadpts(ddfile, r, attid)
+   local a, d, e, i, k, m, n, p, s, v, vv, x, y
+   local lcode, zone, coords, arec
+
+   lcode := r.lcode
+   zone := r.zone
+
+   if zone >= 0 then {			# if not already in lat/lon form
+      if /opts["p"] then {		# if no -p option
+         p := pptrans(r.icorners, r.ocorners)	# use approx, faster projection
+         zone := &null				# indicate such for code below
+         }
+      else {
+         p := invp(utm(r.ellipsoid))	# use full inverse-UTM projection
+         if r.ellipsoid == "Clarke66" then		# and if needed,
+            p := compose(molodensky("NAD27", "NAD83"), p)  # datum conversion
+         }
+      }
+
+   n := 0
+   while d := ddfread(ddfile) do {
+      a := lcode || "-"
+      v := []
+      coords := []
+      every e := !d do {
+         if *e < 3 then
+            next
+         s := get(e)
+         if s == "ATID" then {
+            k := get(e) || get(e)
+            while k[4] ~== "F" do
+               k := get(e) || get(e) | break
+            a := \attid[k] | lcode
+            }
+         else if s == "SADR" then {
+            if /p then {
+               # latitude/longitude input
+               while x := get(e) & y := get(e) do
+                  put(v, x * r.xscale * DEGSCALE, y * r.yscale * DEGSCALE)
+               }
+            else if /zone then {
+               # using approximate projection, which includes scaling
+               while x := get(e) & y := get(e) do
+                  put(coords, x, y)
+               }
+            else {
+               # full inverse UTM projection
+               while x := get(e) & y := get(e) do
+                  put(coords, zone, x * r.xscale - 500000.0, y * r.yscale)
+               }
+            }
+         }
+
+      if \p then {				# if projection needed
+         coords := project(p, coords)		# project UTM to lat/lon
+         m := if /zone then 1 else DEGSCALE	# select multiplier
+         while put(v, integer(m * get(coords)))	# convert to scaled integer
+         }
+
+      if *v = 0 then
+         next
+
+      if not (arec := \attrib[a]) then {
+         # add unrecognized attribute code to table
+         arec := copy(attrib[lcode])
+         arec.key := a || "*"	# "*" indicates unregistered attribute
+         arec.segs := []
+         attrib[a] := arec
+         }
+
+      while *v > MAXDRAW do {		# break too-large path into pieces
+         vv := []
+         every 3 to MAXDRAW by 2 do
+            put(vv, get(v), get(v))	# move out of v
+         put(vv, v[1], v[2])		# leave one point for overlap
+         put(arec.segs, vv)		# store extracted piece
+         }
+
+      # loops are rare in the data, but can crash XFree86 server if dashed
+      if v[1] = v[-2] & v[2] = v[-1] then {  # if loop
+         put(v, v[3], v[4])		  # overshoot to 2nd point again
+         }
+      put(arec.segs, v)			# store what's left of original
+
+      if (n +:= 1) % PINTERVAL = 0 then
+         progress(r)
+
+      }
+   return
+end
+
+
+
+#  logfeat() -- record current location to log file
+
+procedure logfeat(e)
+   local ll, lat, lon, locn, label
+
+   until Event() === (&lrelease | &rrelease)		# wait for button up
+   ll := project(invp(mapproj()), [&x + 0.5, &y + 0.5])	# cvt coords to lat/lon
+   lon := get(ll) / DEGSCALE
+   lat := get(ll) / DEGSCALE
+   locn := frn(lat, 0, 6) || " " || frn(lon, 0, 6)
+   label := ""
+
+   if e === &lpress then {	# if named (not anonymous), ask for label
+      setdraw(attrib["DIALOG"])
+      VSetFont()
+      case TextDialog(
+         ["Enter label for", locn || ":"], , , 30, ["Okay", "Cancel"]) of {
+            "Okay":	label := " " || get(dialog_value)
+            "Cancel":	fail
+            }
+         put(features, feature(DEGSCALE * lat, DEGSCALE * lon, label[2:0]))
+         if any(chosen, "f") then
+            allfeats(mapproj(), Pending)	# redraw feats to display label
+      }
+
+   write(logfile, locn, label)
+   flush(logfile)
+   return
+end
+
+
+
+#  locate() -- display location while right button is held down
+
+$define BOXW 265		# popup box width
+$define BOXH 90			# popup box height
+$define SMAX (BOXW - 40)	# maximum scalebar length
+
+procedure locate()
+
+   setdraw(attrib["DIALOG"])	# set colors and font for drawing
+   Font("mono,bold,14")
+
+   if &x < BOXW + 40 & &y < BOXH + 40 then
+      Popup(20, WAttrib("height") - BOXH - 20, BOXW, BOXH, locproc, mapproj())
+   else
+      Popup(20, 20, BOXW, BOXH, locproc, mapproj())
+
+   return
+end
+
+
+
+#  locate(wproj) -- calculate scale and location using caller's projection
+
+procedure locproc(wproj)
+   local d, e, m, s, u, cx, dx, dy, ll, lat, lon, winv
+
+   winv := invp(wproj)			# get projection from screen to lat/lon
+   dx := WAttrib("dx")			# get popup box coordinate system
+   dy := WAttrib("dy")
+
+   #  compute a reasonably round length that works for a scale bar
+   u := 90 * DEGSCALE / 1e7		# one meter, in latitude units
+   m := sbsize(wproj, xmin, ymin, u, SMAX)
+
+   # draw the scale bar
+   ll := project(wproj, [xmin, ymin, xmin + m * u, ymin])
+   d := ll[3] - ll[1]
+   cx := BOXW / 2
+   FillRectangle(cx - d / 2, 55, d, 8)
+
+   if m >= 1000 then
+      s := (m / 1000) || " km"
+   else
+      s := m || " m"
+   CenterString(cx, 70, s)
+
+   #  give coordinates of mouse location until button released
+   until e === &rrelease do {
+
+      ll := project(winv, [&x + 0.5, &y + 0.5])	# cvt screen coords to lat/lon
+      lon := get(ll) / DEGSCALE		# and scale from integer to real
+      lat := get(ll) / DEGSCALE
+
+      GotoRC(1, 1)
+      WWrites("\n  ", dms(lat, "S", "N"), frn(lat, 13, 6))
+      WWrites("\n  ", dms(lon, "W", "E"), frn(lon, 13, 6))
+
+      e := Event()	# get next event
+      &x +:= dx		# remove effect of popup box coordinate system
+      &y +:= dy
+      }
+
+   return
+end
+
+procedure dms(n, s1, s2)
+   local deg, min, sec
+
+   if n < 0 then
+      n := -n
+   else
+      s1 := s2
+
+   n +:= 1 / 7200.				# rounding
+   deg := integer(n);  n := (n - deg) * 60
+   min := integer(n);  n := (n - min) * 60
+   sec := integer(n)
+
+   return s1 || right(deg, 4) || "\260" || right(min, 2, "0") || "'" ||
+      right(sec, 2, "0") || "\""
+end
+
+
+
+#  draw(win, pjn) -- draw all selected map layers, without erasing first
+
+procedure draw(win, pjn)
+   local a, d, v, arec
+
+   every (arec := !slist) & any(chosen, arec.lcode) do {
+      setdraw(arec) | next
+      every d := !arec.segs do {
+         v := project(pjn, d)		# project to window x/y coords
+         every !v >:= 30000.0		# clamp to legal X values allowing dx/dy
+         every !v <:= -30000.0		# clamp as floating to avoid lgint bug
+         if *v = 2 then
+            FillRectangle(v[1] - 1, v[2] - 1, 3, 3)
+         else
+            DrawLine ! v
+         if *Pending() > 0 then
+            return
+         }
+      }
+
+   # draw feature (waypoint) labels
+   if any(chosen, "f") then
+      allfeats(pjn, Pending)
+
+   # draw pseudo-layer "n"
+   if any(chosen, "n") then
+      alllabels(Pending)
+
+   collect()			# do this now, while awaiting input
+   return
+end
+
+
+
+#  winit() -- initialize window configuration
+
+procedure winit()
+   local a
+
+   xmin := ymin := +180 * DEGSCALE
+   xmax := ymax := -180 * DEGSCALE
+   every a := !arglist do
+      if \a.wanted then {
+         every xmin >:= (!a.ltable).ocorners[1 | 3]
+         every xmax <:= (!a.ltable).ocorners[5 | 7]
+         every ymin >:= (!a.ltable).ocorners[2 | 8]
+         every ymax <:= (!a.ltable).ocorners[4 | 6]
+         }
+   aspect := cos(dtor((ymax + ymin) / (2 * DEGSCALE)))
+   return
+end
+
+
+
+#  allfeats(pjn, p) -- draw feature labels
+#
+#  p is Pending procedure, if to check and quit early
+
+procedure allfeats(pjn, p)
+   local f, x, y, xy, xy2
+
+   xy := []
+   every f := !features do
+      put(xy, f.lon, f.lat)
+   xy := project(pjn, xy)
+   xy2 := copy(xy)
+
+   Font("sans, bold, 10")
+   setdraw(attrib["f"])
+   Fg("white")				# draw offset backgrounds in white
+   every f := !features do {
+      DrawString(get(xy2) + 4, get(xy2) + 5, f.label)
+      if *(\p)() > 0 then
+         break
+      }
+
+   setdraw(attrib["f"])			# draw labels in black
+   every f := !features do {
+      x := get(xy)
+      y := get(xy)
+      FillRectangle(x - 1, y - 1, 3, 3)
+      DrawString(x + 5, y + 4, f.label)
+      if *(\p)() > 0 then
+         break
+      }
+
+   return
+end
+
+
+
+#  alllabels(p) -- draw labels for all layers in standard color
+#
+#  p is Pending procedure, if to check and quit early
+
+procedure alllabels(p)
+   local a, r
+
+   setdraw(attrib["n"])
+   every a := !arglist do {
+      if \a.wanted then {
+         drawlabel(!a.ltable)		# pick any layer
+         if \opts["c"] then {
+            drawcoverage(a)
+            setdraw(attrib["n"])
+         }
+      }
+      if *(\p)() > 0 then
+         break
+      }
+   return
+end
+
+
+
+#  drawlabel(r) -- draw label for layer r in current color
+#
+#  sets r.px, r.py to progress bar position and r.wd to layer width
+
+procedure drawlabel(r)
+   local x, y, w, h, n, d, u, s, tw, tmax, v, wproj
+   static lc, uc
+   initial {
+      lc := string(&lcase)
+      uc := string(&ucase)
+      }
+
+   # draw the bounding box
+   wproj := mapproj()
+   v := copy(r.ocorners)
+   put(v, r.ocorners[1], r.ocorners[2])
+   v := project(wproj, v)		# project to window x/y coords
+   every !v >:= 30000.0			# clamp to legal X values allowing dx/dy
+   every !v <:= -30000.0		# clamp as floating to avoid lgint bug
+   DrawLine ! v
+
+   # find the center and range
+   x := (v[1] + v[3] + v[5] + v[7]) / 4
+   y := (v[2] + v[4] + v[6] + v[8]) / 4
+   w := (v[5] + v[7] - v[1] - v[3]) / 2
+   h := (v[4] + v[6] - v[2] - v[8]) / 2
+
+   # trim the name
+   s := r.arg.name
+   while s[-1] == "/" do
+      s := s[1:-1]
+   s ? {
+      while tab(upto('/') + 1)
+      s := map(tab(0), lc, uc)
+      }
+   if s[-4:0] == (".ZIP" | ".GPS" | ".RTE" | ".TRK") then
+      s := s[1:-4]
+
+   # draw the label
+   Font("sans,bold," || MAXFONT)
+   tw := TextWidth(s)
+   tmax := .90 * w
+   if tw > tmax then {
+      n := integer(MAXFONT * tmax / tw)
+      if n <:= MINFONT then {
+         # it doesn't fit, and will overlap neighbors with minimum font size;
+         # add pseudorandom vertical offset to mitigate overlap
+         d := abs(r.ocorners[7] / DEGSCALE)	# SE corner longitude
+         u := integer(8 * d + 0.5)		# 1/8-degree units
+         u +:= integer(2 * d + 0.5)		# half-degree units
+         y -:= 0.20 * h * (1.5 - u % 4)
+         }
+      if n < MINBOLD then
+         Font("sans," || n)
+      else
+         Font("sans,bold," || n)
+      }
+   CenterString(x, y, s)
+
+   r.px := integer(x)
+   r.py := integer(y + 0.75 * WAttrib("fheight"))
+   r.wd := w
+   return
+end
+
+
+
+#  progress(r) -- draw progress square for layer r
+
+procedure progress(r)
+   local a, x
+
+   a := r.arg
+   a.pcount := (\a.pcount + 1) | 0
+   x := r.px + PSQSIZE * (a.pcount % PSQUARES - PSQUARES / 2)
+   FillRectangle(x, r.py, PSQSIZE - PSQGAP, PSQSIZE - PSQGAP)
+   if (a.pcount / PSQUARES) % 2 = 1 then
+      EraseArea(x + 1, r.py + 1, PSQSIZE - PSQGAP - 2, PSQSIZE - PSQGAP - 2)
+   return
+end
+
+
+
+#  drawcoverage(a) -- draw coverage indicators for arg entry a
+
+procedure drawcoverage(a)
+   local c, r, x, y, w
+
+   r := \!a.ltable | return
+   w := r.wd / *DLG_LAYERS
+   w >:= PSQSIZE
+   w <:= 2
+   x := r.px - (w * *DLG_LAYERS) / 2
+   y := r.py
+
+   every c := !cset(DLG_LAYERS) do {
+      if r := \a.ltable[c] then {
+         setdraw(attrib[r.lcode])
+         FillRectangle(x, y, w, w)
+      }
+      x +:= w
+   }
+   return
+end
+
+
+
+#  print() -- print visible portion to file
+
+procedure print()
+   local psname, psfile
+
+   Bg("pale weak brown")
+   VSetFont()
+   setdraw(attrib["DIALOG"])		# set reasonable colors for dialog
+   repeat case OpenDialog("Print to file:") of {
+      "Okay": {
+         if *dialog_value = 0 then
+            next
+         if close(open(psname := dialog_value)) then
+            case TextDialog("Overwrite existing file?", , , ,
+               ["Yes", "No", "Cancel"]) of {
+                  "Yes":	&null
+                  "No":		next
+                  "Cancel":	fail
+               }
+         if psfile := open(psname, "w") then
+            break
+         case TextDialog("Cannot write " || psname) of {
+            "Okay":	next
+            "Cancel":	fail
+            }
+         }
+      "Cancel":
+         fail
+      }
+
+   Popup(, , 300, 50,
+      popwrite, [psfile, mapproj(), WAttrib("width"), WAttrib("height")])
+   close(psfile)
+   return
+end
+
+procedure popwrite(psargs)
+   CenterString(150, 25, "Writing PostScript...")
+   return writeps ! psargs
+end
+
+procedure writeps(psfile, projn, wwidth, wheight)
+   local arec, color, style, width, ptoff, xmax, ymax, xmul, ymul
+   local a, b, f, m, w, h, pj, d, s, u, v, x, y, dx, dy, fx, fy, ll
+
+   b := project(invp(projn), [0, 0, wwidth, wheight])
+   xmax := PSSCALE * wwidth
+   ymax := PSSCALE * wheight
+   xmul := xmax / (b[3] - b[1])
+   ymul := ymax / (b[2] - b[4])
+   pj := rectp(b[1], b[4], 0, 0, xmul, ymul)		# set projection
+
+   ptoff := PSPT / 2
+   s := " 0 " || PSPT || " rlineto"
+   s ||:= " " || PSPT || " 0 rlineto"
+   s ||:= " 0 -" || PSPT || " rlineto"
+
+   epsheader(psfile, 0, 0, PSSCALE * wwidth, PSSCALE * wheight, "r")
+   every write(psfile, ![
+      "1 setlinecap",
+      "/cdivr { 65535 div 3 1 roll } bind def",
+      "/color { cdivr cdivr cdivr setrgbcolor } bind def",
+      "/solid { [] 0 setdash } bind def",
+      "/dashed { [ .04 inch dup ] 0 setdash } bind def",
+      "/m { moveto } bind def",
+      "/r { rlineto } bind def",
+      "/s { rlineto stroke } bind def",
+      "/p { moveto" || s || " fill } bind def",
+      "/f { 2 copy p moveto 48 -36 rmoveto show } bind def",
+      ])
+
+   every (arec := !slist) & any(chosen, arec.lcode) do {
+      if *arec.segs = 0 | arec.width < 0 then
+         next
+      if color ~===:= arec.color then
+         write(psfile, map(ColorValue(arec.color), ",", " "), " color")
+      if width ~===:= arec.width then
+         write(psfile, arec.width / real(PSLWI), " inch setlinewidth")
+      if style ~===:= arec.style then
+         write(psfile, style)
+      every d := !arec.segs do {
+         v := project(pj, d)
+         if *v = 2 then {
+            x := integer(get(v))
+            y := integer(get(v))
+            if (0 <= x < xmax) & (0 <= y < ymax) then
+               write(psfile, x - ptoff, " ", y - ptoff, " p")
+            next
+            }
+         v := Coalesce(ClipLine(v, 0, 0, xmax, ymax)) | next
+         every a := !v do {
+            x := integer(get(a))
+            y := integer(get(a))
+            fy := integer(pull(a))
+            fx := integer(pull(a))
+            write(psfile, x, " ", y, " m")
+            while dx := integer(get(a) - x) do {
+               dy := integer(get(a) - y)
+               write(psfile, dx, " ", dy, " r")
+               x +:= dx
+               y +:= dy
+               }
+            write(psfile, fx - x, " ", fy - y, " s")
+            }
+         }
+      }
+
+   # write features
+   if *features > 0 & any(chosen, "f") then {
+      write(psfile)
+      write(psfile, "/Times-Roman findfont 120 scalefont setfont")
+      write(psfile, "0 0 0 color")
+      every f := !features do {
+         a := project(pj, [f.lon, f.lat])
+         x := integer(get(a))
+         y := integer(get(a))
+         if (0 <= x <= xmax) & (0 <= y <= ymax) then
+            write(psfile, "(", psprotect(f.label), ") ",
+               x - ptoff, " ", y - ptoff, " f")
+         }
+      }
+
+   # write scale bar
+   u := 90 * DEGSCALE / 1e7		# one meter, in latitude units
+   m := sbsize(pj, xmin, ymin, u, 2000)
+   ll := project(pj, [xmin, ymin, xmin + m * u, ymin])
+   d := ll[3] - ll[1]
+   if m >= 1000 then
+      s := (m / 1000) || " km"
+   else
+      s := m || " m"
+
+   every write(psfile, ![
+      "",
+      "0 0 0 color",
+      "0 0 m 0 120 r " || d || " 0 r 0 -120 r fill",
+      "/Helvetica findfont 100 scalefont setfont",
+      "65535 65535 65535 color",
+      integer(d / 2 - 120) || " 25 m (" || s || ") show",
+      ])
+   
+   write(psfile, "showpage")
+   return
+end
+
+
+
+
+#  initattrib() -- initialize drawing attributes
+#
+#  IMPORTANT: Map entities are drawn in the order of the def() calls below.
+
+procedure initattrib()
+   local i, s
+
+$define ROUTE "magenta-red"		# path foreground color
+   pcolors := [				# path background colors
+      "yellow",				#   yellow
+      "light green",			#   green
+      "light bluish cyan",		#   blue
+      "reddish yellow",			#   orange
+      "pale purple",			#   purple
+      "pale red-yellow",		#   peach
+      "pale moderate green",		#   greenish gray
+      "pale moderate cyan",		#   bluish gray
+      ]
+   pull(pcolors)	# remove trailing null
+
+   attrib := table()
+   deflayer(" ", "black")
+   def("SWEEP", 3, "reddish orange")	# interactive sweeping with mouse
+   def("DIALOG", 1, "black")		# dialog boxes
+
+   every i := 1 to *pcolors do {
+      s := "g" || i
+      deflayer(s, ROUTE)		# paths (first drawing)
+      def(s || "b", 10, pcolors[i])	# faint, wide highlighter background
+      def(s || "f", 2, ROUTE)		# bold foreground
+      }
+
+   deflayer("b", "light reddish yellow")  # boundaries (wide, so draw first)
+   def("b", 3)
+
+   deflayer("o", Fg())			# unknown other data; use specified Fg
+   def("o")
+
+   deflayer("c", "light red-yellow")	# contour lines (hypsography)
+   def("c-", , "pale moderate red-yellow")  # deemphasize unattributed segments
+   def("c")				# contour line
+   def("0200205", , "light moderate bluish-cyan")  # bathymetric contour
+   def("0200206", , "light moderate bluish-cyan")  # depth curve
+   def("0200210", , "light moderate bluish-cyan")  # suppl bathymetric contour
+   def("0200207", , "deep red-yellow")	# watershed (e.g. continental) divide
+
+   deflayer("l", "pale whitish red")	# land sections
+   def("l")
+
+   deflayer("v", "light green")		# vegetation (surface cover)
+   def("v")				# surface cover
+
+   deflayer("d", "light weak green")	# gravel etc. (nonvegetative features)
+   def("d")
+
+   deflayer("w", "bluish cyan")		# water (hydrology)
+   def("w-", , "pale bluish cyan")	# deemphasize unattributed segments
+   def("0500415", , , "dashed")		# aqueduct or water pipeline
+   def("0500200", 2)			# shoreline
+   def("0500201", 2)			# manmade shoreline
+   def("w")				# unspecified hydrology
+   def("0500412")			# stream
+
+   deflayer("s", "weak reddish yellow")	# manmade structures
+   def("2000299", , "pale reddish yellow")	# processing line
+   def("s")
+   def("s-")				# uattributed, incl building outlines
+   def("2000400")			# buildings as point nodes
+   def("2000202", , "light moderate reddish yellow")	# wall
+   def("2000206", , "light moderate reddish yellow")	# fence
+
+   deflayer("r", "deep gray")		# roads and trails
+   def("r-", , "pale gray")		# deemphasize unattributed segments
+   def("1700201", 3, "black")		# road, primary, undivided
+   def("1700202", 3, "black")		# road, primary, divided
+   def("1700203", 2, "black")		# road, primary, one of divided paths
+   def("1700204", 2, "black")		# road, primary, one-way
+   def("1700205", 2, "black")		# road, secondary
+   def("1700206", 2, "black")		# road, secondary
+   def("1700207", 2, "black")		# road, secondary
+   def("1700208", 2, "black")		# road, secondary
+   def("1700214", 1, "black", "dashed")	# ferry route
+   def("1700218")			# road, class 3, divided
+   def("1700209")			# road, class 3, undivided
+   def("1700402")			# entrance ramp
+   def("r")				# unspecified road or trail
+   def("1700210", , , "dashed")		# road, class 4
+   def("1700219", , , "dashed")		# road, class 4, one-way
+   def("1700212", , , "dashed")		# road, class 5, 4WD
+   def("1700211", , "dark red", "dashed")  # trail
+   def("1700213", , "dark red", "dashed")  # footbridge
+
+   deflayer("t", "dark orange")		# railroads
+   def("t-", , "pale weak orange")	# deemphasize unattrib segments
+   def("t")				# unspecified railroad
+   def("1800201", 2)			# railroad main
+   def("1800201E", 2)			# railroad main elevated
+   def("1800201R", 2)			# railroad main on drawbridge
+   def("1800201T", 2, , "dashed")	# railroad main in tunnel
+   def("1800207", 1, , "dashed")	# railroad ferry route
+   def("1800208", 1)			# railroad siding
+   def("1800209", 2)			# railroad yard
+   def("1800400", 1)			# railroad station
+$define TRANSIT "dark blue"
+   def("1800201Y", 2, TRANSIT)		# rapid transit rail main
+   def("1800201EY", 2, TRANSIT)		# rapid transit main elevated
+   def("1800201RY", 2, TRANSIT)		# rapid transit main on drawbrg
+   def("1800201TY", 2, TRANSIT, "dashed")  # rapid transit main in tunnel
+   def("1800202Y", 2, TRANSIT)		# rapid transit main in road
+   def("1800202RY", 2, TRANSIT)		# rapid transit, in road on drawbridge
+   def("1800208Y", 1, TRANSIT)		# rapid transit siding
+   def("1800400Y", 1, TRANSIT)		# rapid transit station
+
+   deflayer("u", "light gray")		# misc transpt: power, pipe, airport
+   def("u")
+   def("u-", , "white-gray")		# unattrib segments incl airport runways
+$define UTILITY "strong purple-magenta"
+   def("1900201", 1, UTILITY, "dashed")	# petroleum pipeline
+   def("1900202", 1, UTILITY)		# power line
+   def("1900203", 1, UTILITY)		# phone line
+   def("1900400", 1, UTILITY)		# power plant
+   def("1900401", 1, UTILITY)		# substation
+   def("1900402", 1, UTILITY)		# hydro plant
+   def("1900403", 1, "light gray")	# landing strip or airport
+   def("1900404", 1, "orange")		# helipad
+   def("1900405", 1, "light gray")	# launch complex
+
+   deflayer("m", "blue")		# survey markers
+   def("m-", , "pale weak blue")	# deemphasize unattributed lines
+   def("m")
+
+   deflayer("f", "black")		# feature labels
+   def("f")
+
+   deflayer("n", "deep green")		# file labels
+   def("n")
+
+   deflayer("g", ROUTE)			# paths (retraced)
+
+   every i := 1 to *pcolors do {	# link ea GPS bg/fg/bg set to one list
+      s := "g" || i
+      def(s, 2)
+      attrib[s || "b"].segs := attrib[s].segs
+      attrib[s || "f"].segs := attrib[s].segs
+      }
+
+   return
+end
+
+
+
+#  deflayer -- define layer code and default color for subsequent defs
+
+global layercode, layercolor
+
+procedure deflayer(lcode, color)
+   layercode:= lcode
+   layercolor := color
+   return
+end
+
+
+
+#  def(key, width, color, style) -- define style info for code or attribute
+#
+#  default width is 1
+#  default color is as last set by deflayer()
+#  default style is "solid"
+#
+#  a key of "x" matches undefined attributes of layer x
+#  a key of "x-" matches segments without attributes
+#
+#  a width of -1 means "don't draw"
+
+procedure def(key, width, color, style)
+   static seq
+   initial seq := 0
+
+   /width := 1
+   /color := layercolor
+   /style := "solid"
+   attrib[key] := attrec(seq +:= 1, layercode, key, width, color, style, [])
+   return
+end
+
+
+
+#  setdraw(arec) -- set color, linewidth, linestyle based on attribute record
+#
+#  fails if width is negative, meaning that drawing is to be suppressed
+
+procedure setdraw(arec)
+   if arec.width < 0 then
+      fail
+   WAttrib("fg=" || arec.color,
+      "linewidth=" || arec.width, "linestyle=" || arec.style)
+   return
+end
diff --git a/ipl/gprogs/drawup.icn b/ipl/gprogs/drawup.icn
new file mode 100644
index 0000000..4b9c0db
--- /dev/null
+++ b/ipl/gprogs/drawup.icn
@@ -0,0 +1,88 @@
+############################################################################
+#
+#	File:     drawup.icn
+#
+#	Subject:  Program to create draft from drawdown
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces an ISD from a bi-level image string or row file.
+#
+#  The following option is supported:
+#
+#	-n s	draft name, default "drawup"
+#
+#	-r	interpret input as row pattern; default image string
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, patutils, patxform, weavutil, xcode
+#
+############################################################################
+
+link options
+link patutils
+link patxform
+link weavutil
+link xcode
+
+procedure main(args)
+   local threading, treadling, rows, pattern, i
+   local symbols, symbol, drawdown, draft, opts
+
+   opts := options(args, "rn:")
+
+   if \opts["r"] then {
+      drawdown := []
+      while put(drawdown, read())
+      }
+   else drawdown := pat2rows(read()) | stop("*** invalid input")
+
+   treadling := analyze(drawdown)
+   drawdown := protate(drawdown, "cw")
+   threading := analyze(drawdown)
+
+   symbols := table("")
+
+   every pattern := !treadling.patterns do {
+      symbol := treadling.rows[pattern]
+      symbols[symbol] := repl("0", *threading.rows)
+      pattern ? {
+         every i := upto('1') do
+            symbols[symbol][threading.sequence[i]] := "1"
+         }
+      }
+
+   symbols := sort(symbols, 3)
+   rows := []
+
+   while get(symbols) do
+      put(rows, get(symbols))
+
+   draft := isd()
+
+   draft.name := \opts["n"] | "drawup"
+   draft.threading := threading.sequence
+   draft.treadling := treadling.sequence
+   draft.warp_colors := list(*threading.sequence, 1)
+   draft.weft_colors := list(*treadling.sequence, 2)
+   draft.color_list := ["black", "white"]
+   draft.shafts := *threading.rows
+   draft.treadles := *treadling.rows
+   draft.tieup := rows
+
+   xencode(draft, &output)
+
+end
diff --git a/ipl/gprogs/drip.icn b/ipl/gprogs/drip.icn
new file mode 100644
index 0000000..6e1c775
--- /dev/null
+++ b/ipl/gprogs/drip.icn
@@ -0,0 +1,150 @@
+############################################################################
+#
+#	File:     drip.icn
+#
+#	Subject:  Program to demonstrate color map animation
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage:  drip [-n ncolors] [-c correlation] [-d delay] [window options]
+#
+#     drip uses color map animation to simulate the spread of colored
+#  liquid dripping into the center of a pool.
+#
+#     ncolors is the number of different colors present at one time.
+#
+#     correlation (0.0 to 1.0) controls the similarity of two consecutive
+#  colors.  It probably doesn't meet a statistician's strict definition
+#  of the term.
+#
+#     delay is the delay between drops, in milliseconds.  This may not be
+#  needed; speed seems to vary greatly among different X servers, even on
+#  the same machine.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: evmux, options, optwindw, random
+#
+############################################################################
+
+
+link evmux
+link options
+link optwindw
+link random
+
+global opttab
+
+procedure main(args)
+   local win, mono, w, h, m, d
+   local a, r, i, xscale, yscale, rad, xctr, yctr, xrad, yrad
+   local cindex, cspec, ncolors, bg
+
+   # process options
+   opttab := options(args, winoptions() || "n+d+c.")
+   /opttab["B"] := "black"
+   /opttab["W"] := 512
+   /opttab["H"] := 512
+   /opttab["M"] := -1
+   /opttab["d"] := 50
+   /opttab["n"] := 32
+   /opttab["c"] := 0.8
+   win := optwindow(opttab, "cursor=off", "echo=off")
+   w := opttab["W"]
+   h := opttab["H"]
+   m := opttab["M"]
+   ncolors := opttab["n"]
+   d := opttab["d"]
+
+   # calculate radius of circle and limit number of colors to that
+   r := h / 2
+   r >:= w / 2
+   xscale := (w / 2.0) / r
+   yscale := (h / 2.0) / r
+   ncolors >:= r
+
+   # get background color as string of 3 integers (works faster that way)
+   bg := ColorValue(win, opttab["B"])
+
+   # allocate a set of mutable colors, initialized to the background
+   cindex := list()
+   every 1 to ncolors do
+      put(cindex, NewColor(win, bg))
+   if *cindex = 0 then
+      stop("can't allocate mutable colors")
+   if ncolors >:= *cindex then
+      write(&errout, "proceeding with only ", ncolors, " colors")
+
+   # make list of radii, with a minimum difference of 1
+   # try to equalize the *areas* of the rings, not their widths
+   a := &pi * r * r
+   rad := list(ncolors)
+   every i := 1 to *rad do
+      rad[i] := integer(sqrt((a * i) / (ncolors * &pi)) + 0.5)
+   every i := 1 to *rad-1 do
+      rad[i] >:= rad[i+1] - 1
+
+   # draw nested circles (in different mutable colors all set to the background)
+   xctr := m + w / 2
+   yctr := m + h / 2
+   every i := *rad to 1 by -1 do {
+      Fg(win, cindex[i])
+      xrad := xscale * rad[i]
+      yrad := yscale * rad[i]
+      FillArc(win, xctr - xrad, yctr - yrad, 2 * xrad, 2 * yrad)
+      }
+   WFlush(win)
+
+   # install a sensor to exit on q or Q
+   quitsensor(win)
+
+   # drip colors into the center and watch them spread,
+   # checking for events each time around
+   cspec := list(ncolors, bg)
+   repeat {
+      while *Pending(win) > 0 do
+         evhandle(win)
+      if d > 0 then {
+         WFlush(win)
+         delay(d)
+         }
+      pull(cspec)
+      push(cspec, newcolor())
+      every i := 1 to *cspec do
+         Color(win, cindex[i], cspec[i])
+      }
+
+end
+
+
+#  newcolor -- return a new color spec somewhat close to the previous color
+
+procedure newcolor()
+   static r, g, b, c
+
+   initial {
+      randomize()
+      r := ?32767
+      g := ?32767
+      b := ?32767
+      c := integer(32767 - 32767 * opttab["c"])
+      c <:= 1
+      }
+
+   r +:= ?c - c/2 - 1;  r <:= 0;  r >:= 32767
+   g +:= ?c - c/2 - 1;  g <:= 0;  g >:= 32767
+   b +:= ?c - c/2 - 1;  b <:= 0;  b >:= 32767
+   return (r + 32768) || "," || (g + 32768) || "," || (b + 32768)
+end
diff --git a/ipl/gprogs/etch.icn b/ipl/gprogs/etch.icn
new file mode 100644
index 0000000..d491554
--- /dev/null
+++ b/ipl/gprogs/etch.icn
@@ -0,0 +1,153 @@
+############################################################################
+#
+#	File:     etch.icn
+#
+#	Subject:  Program for distributed Etch-A-Sketch
+#
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#  
+# A drawing program.  Invoked with one optional argument, the
+# name of a remote host on which to share the drawing surface.
+#
+# Dragging the left button draws black dots
+# The middle button draws a line from button press to the release point
+# The right button draws white dots
+# Control-L clears the screen
+# The Escape character exits the program
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+procedure main(av)
+   local w1, w2, w3, w4, w5, w6, w, x1, xa, x2, xb, y1, ya, y2, yb, dragging,
+      da, xc, xd, yc, yd, dc, e
+   #
+   # open an etch window.  If there was a command line argument,
+   # attempt to open a second window on another display.  For
+   # each window, create a binding with reverse video for erasing.
+   #
+   w1 := WOpen("label=etch", "size=300,300") | stop("can't open window")
+   w2 := XBind(w1,"drawop=xor") | stop("can't XBind w2")
+   w3 := XBind(w1,"reverse=on") | stop("can't XBind w3")
+   if *av>0 then {
+      w4 := WOpen("label=etch", "display="||av[1]||":0","size=300,300") |
+	  stop("can't open window, display=",av[1])
+      w5 := XBind(w4,"drawop=xor") | stop("Can't XBind w5")
+      w6 := XBind(w4,"reverse=on") | stop("Can't XBind w6")
+  }
+  repeat {
+      #
+      # wait for an available event on either display
+      #
+      w := Active() | stop("Active fails")
+      if (w === (w1|w2)) then {
+	  x1 := xa
+	  x2 := xb
+	  y1 := ya
+	  y2 := yb
+	  dragging := da
+      } else {
+	  x1 := xc
+	  x2 := xd
+	  y1 := yc
+	  y2 := yd
+	  dragging := dc
+      }
+      
+      case e := Event(w) of {
+	  #
+	  # Mouse down events specify an (x1,y1) point for later drawing.
+	  # (x2,y2) is set to null; each down event starts a new draw command.
+	  #
+	  &lpress | &mpress | &rpress: {
+	      x1 := &x
+	      y1 := &y
+	      x2 := y2 := &null
+	  }
+	  #
+	  # Mouse up events obtain second point (x2,y2), and draw a line.
+	  #
+	  &lrelease: {
+	      DrawLine(w1,\x1,\y1,&x,&y)
+	      DrawLine(\w4,\x1,\y1,&x,&y)
+	  }
+	  &mrelease: {
+	      DrawLine(w1,x1,y1,&x,&y)
+	      DrawLine(\w4,x1,y1,&x,&y)
+	      dragging := &null
+	  }
+	  &rrelease: {
+	      DrawLine(w3,x1,y1,&x,&y)
+	      DrawLine(\w6,x1,y1,&x,&y)
+	  }
+	  #
+	  # Drag events obtain a second point, (x2,y2), and draw a line
+	  # If we are drawing points, we update (x1,y1); if we are
+	  # drawing lines, we erase the "rubberband" line and draw a new
+	  # one at each drag event; a permanent line will be drawn when
+	  # the button comes up.
+	  #
+	  &ldrag : {
+	      DrawLine(w1,x1,y1,&x,&y)
+	      DrawLine(\w4,x1,y1,&x,&y)
+	      # left and right buttons use current position
+	      x1 := &x   # for subsequent operations
+	      y1 := &y
+	  }
+	  &rdrag : {
+	      DrawLine(w3,x1,y1,&x,&y)
+	      DrawLine(\w6,x1,y1,&x,&y)
+	      # left and right buttons use current position
+	      x1 := &x   # for subsequent operations
+	      y1 := &y
+	  }
+	  &mdrag: {
+	      if /dragging then dragging := 1
+	      else { # erase previous line, if any
+		  DrawLine(w2,x1,y1,\x2,\y2)
+		  DrawLine(\w5,x1,y1,\x2,\y2)
+	      }
+	      x2 := &x
+	      y2 := &y
+	      DrawLine(w2,x1,y1,x2,y2)
+	      DrawLine(\w5,x1,y1,x2,y2)
+	  }
+	  "\^l": {
+	      EraseArea(w1)
+	      EraseArea(\w4)
+	  }
+	  "\e": break
+      }
+      if (w === (w1|w2)) then {
+	  xa := x1
+	  xb := x2
+	  ya := y1
+	  yb := y2
+	  da := dragging
+      } else {
+	  xc := x1
+	  xd := x2
+	  yc := y1
+	  yd := y2
+	  dc := dragging
+      }
+  }
+end
diff --git a/ipl/gprogs/facebend.icn b/ipl/gprogs/facebend.icn
new file mode 100644
index 0000000..9551847
--- /dev/null
+++ b/ipl/gprogs/facebend.icn
@@ -0,0 +1,792 @@
+############################################################################
+#
+#	File:     facebend.icn
+#
+#	Subject:  Program to generate caricatures
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 7, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Facebender is a caricature generator.  Read in an image and use the
+#  left mouse button to pick the key points as prompted.  Click the
+#  right button to skip a feature.  Pull down "drawing" on the display
+#  menu to see the caricature.  Move the slider to change the distortion.
+#
+############################################################################
+#
+#  References:
+#
+#  A. K. Dewdney, "Computer Recreations". Scientific American, Oct. 1986.
+#  Reprinted in two collections of his columns, both from W. H. Freeman:
+#  The Armchair Universe (1988) and The Tinkertoy Computer (1993).
+#
+#  Susan E. Brennan, "Caricature Generator: The Dynamic Exaggeration of
+#  Faces by Computer."  Leonardo, Vol.18 no.3, 1985, pp. 170-178.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics, vsetup
+#
+############################################################################
+
+
+link graphics				# graphics library
+link vsetup				# VIB library
+
+
+# constant definitions
+
+$define PupilRadius 2			# radius for drawing pupils of eyes
+
+$define TargetRad1 5			# radii for guide display target
+$define TargetRad2 20
+
+$define ImageMode 1			# drawing modes
+$define DrawMode 2
+$define DualMode 3
+
+
+# vidgets and geometry
+
+global vidgets				# vidget table
+
+global display_xoff, display_yoff	# image area
+global display_width, display_height
+global image_xoff, image_yoff		# centered image
+
+global guide_xoff, guide_yoff		# guide area
+global guide_width, guide_height
+
+global prompt_xoff, prompt_yoff		# prompt area
+global prompt_width, prompt_height
+
+global dmeter_xoff, dmeter_yoff		# distortion meter
+global dmeter_width, dmeter_height
+
+# windows and bindings
+
+global image_win			# scanned image
+global target_win			# binding for point targets
+global display_win			# binding for image or caricature
+global overlay_win			# binding for dual-mode display
+
+# face data
+#
+# (A face is a list of curves, beginning with the left and right pupils;
+# a curve is a list of x and y coordinates.)
+
+global descriptions			# labels for facial curves
+
+global stdface				# standard (average) face
+global guideface			# scaled / translated guide face
+global sketch				# points from subject face
+
+global tcurve				# index of current curve to place
+global tpoint				# index of point within curve
+
+# miscellaneous globals
+
+global pointfile			# file name for saving coordinates
+global touched				# has data changed since last save?
+
+global mode				# Image / Draw / Dual mode
+global distortion			# distortion factor (0.0 = undistorted)
+
+
+#  main program
+
+procedure main()
+   local l, r, y
+
+   # Open the window, extract layout information, initialize dialogs.
+
+   vidgets := ui()
+   WAttrib("pointer=circle")		# may fail, but at least try
+   init_geometry()
+
+   # Make two clipped bindings for displaying the image and sketch.
+
+   display_win := Clone("linewidth=2")
+   Clip(display_win, display_xoff, display_yoff, display_width, display_height)
+   overlay_win := Clone(display_win, "fillstyle=masked", "pattern=4,#9696")
+
+   # Make a clipped binding for displaying targets on the guide display.
+
+   target_win := Clone("drawop=reverse")
+   Clip(target_win, guide_xoff, guide_yoff, guide_width, guide_height)
+
+   # Initialize globals.
+
+   init_stdface()			# coordinates of "standard" face
+   mode := ImageMode			# display mode
+   setdist(0)				# distortion factor
+
+   # Use the standard face to create a guide display for locating targets.
+   # Calculate eye locations to use for scaling;  then draw the face
+   # with straight lines to emphasize the individual point locations.
+
+   l := guide_xoff + 3 * guide_width / 8
+   r := guide_xoff + 5 * guide_width / 8
+   y := guide_yoff + guide_height / 2
+   guideface := scaleface(stdface, [[l, y], [r, y]])
+   drawface(&window, guideface, DrawLine)
+
+   # Load and display an image; exit if dialog is cancelled.
+
+   new() | exit()
+
+   # Enter event loop.
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+
+#  caricature() -- draw sketch distorted by current distortion factor
+
+procedure caricature()
+   local base, face, win
+
+   if /sketch | /sketch[1, 1] | /sketch[2, 1] then
+      fail				# must have both pupils to draw
+
+   if mode = DrawMode then
+      win := display_win		# use all the display area pixels
+   else
+      win := overlay_win		# use subpattern of display pixels
+
+   Fg(win, "white")
+   FillRectangle(win)			# clear clipped area using fillstyle
+   Fg(win, "black")
+
+   base := scaleface(stdface, sketch)
+   face := distort(sketch, base, distortion)
+   drawface(win, face, DrawCurve)	# draw distorted face
+
+   return
+
+end
+
+
+# check_save() -- check to see if previous coordinate needs to be saved
+#
+# check_save fails if cancelled.
+
+procedure check_save()
+
+   if \touched then
+      case SaveDialog("Save coordinates first?", pointfile) of {
+         "Yes": {
+            pointfile := dialog_value
+            save() | save_as() | fail
+            }
+         "No":  return
+         "Cancel":  fail
+         }
+
+   return
+
+end
+
+
+#  distort(f, b, m) -- return distortion of face f from face b by factor m
+
+procedure distort(f, b, m)
+   local r, t, i, j, curve, base
+
+   r := []
+   every i := 1 to *f do {
+      base := b[i]
+      put(r, curve := copy(f[i]))
+      if /curve[-1] | /base[-1] then
+         next				# incomplete placeholder
+      every j := 1 to *curve by 2 do {
+         curve[j] +:= m * (curve[j] - base[j])
+         curve[j + 1] +:= m * (curve[j + 1] - base[j + 1])
+         }
+      }
+
+   return r
+
+end
+
+
+#  drawface(win, f, proc) -- draw face from curve list using proc
+
+procedure drawface(win, f, proc)
+   local curve
+
+   every curve := copy(!f) do {
+      if /curve[-1] then		# null coordinate
+         next				# incomplete curve
+      if *curve = 2 then
+         FillCircle(win, curve[1], curve[2], PupilRadius)
+      else {
+         push(curve, win)
+         proc ! curve
+         }
+      }
+
+   return
+
+end
+
+
+#  init_geometry() -- extract layout information from vidgets
+
+procedure init_geometry()
+
+   guide_xoff := vidgets["guide"].ax
+   guide_yoff := vidgets["guide"].ay
+   guide_width := vidgets["guide"].aw
+   guide_height := vidgets["guide"].ah
+
+   display_xoff := vidgets["image"].ax
+   display_yoff := vidgets["image"].ay
+   display_width := vidgets["image"].aw
+   display_height := vidgets["image"].ah
+
+   prompt_xoff := vidgets["prompt"].ax
+   prompt_yoff := vidgets["prompt"].ay
+   prompt_width := vidgets["prompt"].aw
+   prompt_height := vidgets["prompt"].ah
+
+   dmeter_xoff := vidgets["dmeter"].ax
+   dmeter_yoff := vidgets["dmeter"].ay
+   dmeter_width := vidgets["dmeter"].aw
+   dmeter_height := vidgets["dmeter"].ah
+
+   return
+
+end
+
+
+#  init_stdface() -- initialize standard face and description list
+
+procedure init_stdface()
+   local spec
+
+   descriptions := []
+   stdface := []
+   every spec := ![
+      ["left pupil",145,203],		# must be first
+      ["right pupil",255,203],		# must be second
+      ["top of left eyebrow",101,187,105,177,126,168,153,170,177,176,181,185],
+      ["top of right eyebrow",219,185,223,176,247,170,274,168,295,177,299,187],
+      ["bottom of left eyebrow",102,188,124,177,151,181,181,185],
+      ["bottom of right eyebrow",219,185,249,181,276,177,298,188],
+      ["top of left eye",114,199,141,187,172,198],
+      ["top of right eye",228,198,259,187,286,199],
+      ["bottom of left eyelid",116,207,143,194,170,206],
+      ["bottom of right eyelid",230,206,257,194,284,207],
+      ["bottom of left eye",120,208,142,213,170,206],
+      ["bottom of right eye",230,206,258,213,280,208],
+      ["left iris",144,195,132,201,144,211,156,201,145,195],
+      ["right iris",255,195,244,201,256,211,268,201,256,195],
+      ["left side of nose",190,193,190,219,190,244,186,257,189,271,200,277],
+      ["right side of nose",210,193,210,219,210,244,214,257,211,271,200,277],
+      ["left nostril",177,250,171,258,169,269,174,277,183,271,198,277],
+      ["right nostril",223,250,229,258,231,269,226,277,217,271,202,277],
+      ["top of upper lip",152,318,172,311,188,306,200,311,212,306,
+         228,311,248,318],
+      ["bottom of upper lip",152,318,170,319,186,317,200,319,214,317,
+         230,319,248,318],
+      ["top of lower lip",152,318,172,318,186,317,200,319,214,317,
+         228,318,248,318],
+      ["bottom of lower lip",152,318,169,327,184,333,200,335,216,333,
+         231,327,248,318],
+      ["left ear",75,212,61,201,54,213,58,233,64,260,75,285,85,281],
+      ["right ear",325,212,339,201,346,213,342,233,336,260,325,285,315,281],
+      ["top of head",60,317,28,254,31,189,46,108,82,47,141,4,200,1,259,4,
+         318,47,354,108,369,189,372,254,340,317],
+      ["hairline",79,200,90,168,104,141,119,120,143,104,172,100,200,99,
+         228,100,257,104,281,120,296,141,310,168,321,200],
+      ["left side of face",84,194,79,232,86,273],
+      ["right side of face",316,194,321,232,314,273],
+      ["jaw",85,272,93,311,108,342,133,369,167,392,200,399,233,392,
+         267,369,292,342,307,311,315,272],
+      ["left eye line",131,221,148,220,166,214],
+      ["right eye line",234,214,252,220,269,221],
+      ["left cheek line",167,264,154,278,145,294],
+      ["right cheek line",233,264,246,278,255,294],
+      ["left cheekbone",87,269,95,280,101,292],
+      ["right cheekbone",313,269,305,280,299,292],
+      ["chin cleft",200,377,200,389],
+      ["chin line",180,350,200,345,220,350]
+      ] do {
+         put(descriptions, get(spec))
+         put(stdface, spec)
+         }
+
+   return
+
+end
+
+
+#  load() -- load coordinate data
+
+procedure load()
+   local input, face
+
+   check_save() | fail
+   repeat {
+      case OpenDialog("Load coordinates:") of {
+         "Okay": {
+            if input := open(dialog_value) then break else
+               Notice("Can't open " || dialog_value)
+            }
+         "Cancel":  fail
+         }
+      }
+
+   if sketch := rdface(input) then {
+      close(input)
+      pointfile := dialog_value
+      touched := &null
+      if mode ~= ImageMode then
+         redisplay()
+      target(1, 1)
+      return
+      }
+
+   else {
+      Notice("Not a valid coordinate file")
+      close(input)
+      fail
+      }
+
+end
+
+
+#  menu_cb() -- handle menu selections
+
+procedure menu_cb(vidget, menu)
+
+   case menu[1] of {
+
+      "load    @L":	load()
+      "new     @N":	new()
+      "save    @S":	save()
+      "save as   ":	save_as()
+      "quit    @Q":	quit()
+
+      "image    @I": {
+         mode := ImageMode
+         redisplay()
+         }
+      "drawing  @D": {
+         mode := DrawMode
+         redisplay()
+         }
+      "both     @B": {
+         mode := DualMode
+         redisplay()
+         }
+      }
+
+   return
+
+end
+
+
+#  new() -- load new image
+
+procedure new()
+   local input, f
+
+   check_save() | fail
+   repeat {
+      case OpenDialog("Load image:") of {
+         "Okay": {
+            if rdimage(dialog_value) then
+               return
+            if f := open(dialog_value) then {
+               close(f)
+               Notice(dialog_value || " is not a valid image")
+               }
+            else
+               Notice("Can't open " || dialog_value)
+            }
+         "Cancel":  fail
+         }
+      }
+
+end
+
+
+#  point_cb() -- handle event in display region
+
+procedure point_cb(vidget, e)
+
+   if /tcurve then			# if no points are left unset
+      return
+
+   case e of {
+
+      &lrelease: {			# left button sets current point
+         sketch[tcurve, 2 * tpoint - 1] := &x
+         sketch[tcurve, 2 * tpoint] := &y
+         touched := 1
+         if mode ~= ImageMode & *sketch[tcurve] = 2 * tpoint then
+            redisplay()			# redraw if new curve done
+         target(tcurve, tpoint)		# update target display
+         }
+
+      &rrelease: {			# right button skips a curve
+         every !sketch[tcurve] := &null	# clear all points on curve
+         if (tcurve +:= 1) > *sketch then
+            tcurve := 1
+         target(tcurve, 1)		# set target to next curve
+         }
+
+      }
+
+   return
+
+end
+
+
+#  quit() -- terminate session
+
+procedure quit()
+
+   check_save() | fail
+   exit()
+
+end
+
+
+#  rdface(f) -- read face coordinates from file f
+
+procedure rdface(f)
+   local face, line, curve, i, n
+
+   face := []
+   while line := read(f) do line ? {
+      =":" | next			# ignore line missing ":"
+      curve := []
+
+      while tab(upto(&digits)) do {
+         n := integer(tab(many(&digits)))
+         if n ~= 0 then n +:= image_xoff else n := &null
+         put(curve, n)
+
+         tab(upto(&digits)) | break
+         n := integer(tab(many(&digits)))
+         if n ~= 0 then n +:= image_yoff else n := &null
+         put(curve, n)
+         }
+
+      put(face, curve)
+      }
+
+   # Validate the number of curves and points.
+
+   if *face ~= *stdface then fail
+   every i := 1 to *stdface do
+      if *face[i] ~= *stdface[i] then fail
+
+   return face
+
+end
+
+
+#  rdimage(filename) -- load image from file, failing if unsuccessful
+
+procedure rdimage(filename)
+   local curve
+
+   image_win := WOpen("image=" || filename, "canvas=hidden") | fail
+   pointfile := &null
+   touched := &null
+
+   # Calculate offsets that center the image in display area.
+
+   image_xoff := display_xoff +
+      (display_width - WAttrib(image_win, "width")) / 2
+   image_yoff := display_yoff +
+      (display_height - WAttrib(image_win, "height")) / 2
+
+   # Initialize a new set of (unset) points.
+
+   sketch := []
+   every curve := !stdface do
+      put(sketch, list(*curve, &null))
+   target(1, 1)				# reset to start with first point
+
+   # Ensure that current mode includes the image, and update the display.
+
+   if mode = DrawMode then
+      mode := ImageMode
+   EraseArea(display_xoff, display_yoff, display_width, display_height)
+   redisplay()
+
+   return
+
+end
+
+
+#  redisplay() -- display image and/or drawing, depending on mode
+
+procedure redisplay()
+
+   if mode ~= DrawMode then
+      CopyArea(image_win, display_win, , , , , image_xoff, image_yoff)
+   if mode ~= ImageMode then
+      caricature()
+
+   return
+
+end
+
+
+#  save() -- save coordinate data
+
+procedure save()
+   local output
+
+   if /pointfile then
+      return save_as()
+
+   output := open(pointfile, "w") | {
+      Notice("Can't write " || pointfile)
+      fail
+      }
+   wtface(output, sketch)
+   close(output)
+   touched := &null
+
+   return
+
+end
+
+
+#  save_as() -- save coordinate data in alternate file
+
+procedure save_as()
+   local output
+
+   repeat {
+      case SaveDialog("Save coordinates?", "") of {
+         "No":	    return
+         "Cancel":  fail
+         "Yes":
+            if output := open(dialog_value, "w") then break else
+               Notice("Can't write " || dialog_value)
+         }
+      }
+
+   wtface(output, sketch)
+   close(output)
+   pointfile := dialog_value
+   touched := &null
+
+   return
+
+end
+
+
+#  scaleface(f, g) -- return copy of face f scaled to overlay face g
+
+procedure scaleface(f, g)
+   local fl, fr, gl, gr, fx, fy, gx, gy, m, r, t, curve
+
+   fl := f[1] | fail			# left iris
+   fr := f[2] | fail			# right iris
+   gl := g[1] | fail			# target left iris
+   gr := g[2] | fail			# target right iris
+   fx := (fl[1] + fr[1]) / 2.0		# x offset of f
+   fy := (fl[2] + fr[2]) / 2.0		# y offset of f
+   gx := (gl[1] + gr[1]) / 2.0		# x offset of g
+   gy := (gl[2] + gr[2]) / 2.0		# y offset of g
+   m := (gr[1] - gl[1]) / real(fr[1] - fl[1])
+					# multiplier
+
+   r := []
+   every curve := copy(!f) do {
+      if /curve[-1] then
+         put(r, curve)			# incomplete placeholder
+      else {
+         put(r, t := [])
+         while put(t, m * (get(curve) - fx) + gx) do
+            put(t, m * (get(curve) - fy) + gy)
+         }
+      }
+
+   return r
+
+end
+
+
+#  setdist(val) -- set and display distortion value, in percent
+
+procedure setdist(val)
+
+   distortion := val / 100.0
+   GotoXY(dmeter_xoff, dmeter_yoff + dmeter_height)
+   WWrites(right(integer(val), 4), "%")
+
+   return
+
+end
+
+
+#  shortcuts() -- check event for keyboard shortcut
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "l": load()
+      "n": new()
+      "s": save()
+      "q": quit()
+      "i": {
+         mode := ImageMode
+         redisplay()
+         }
+      "d": {
+         mode := DrawMode
+         redisplay()
+         }
+      "b": {
+         mode := DualMode
+         redisplay()
+         }
+      }
+
+   return
+
+end
+
+
+#  slider_cb() -- handle adjustments of distortion slider
+
+procedure slider_cb(vidget, val)
+
+   setdist(val)				# update and display value
+   if mode = ImageMode then		# ensure that mode includes drawing
+      mode := DualMode
+   redisplay()				# draw updated sketch
+
+   return
+
+end
+
+
+#  target(curve, point) -- display next point to be placed
+
+procedure target(curve, point)
+   local s, n, x, y
+   static tx, ty
+
+   # Undraw the previous target and erase the previous prompt.
+
+   FillCircle(target_win, \tx, \ty, TargetRad1)
+   FillCircle(target_win, \tx, \ty, TargetRad2)
+   EraseArea(prompt_xoff, prompt_yoff, prompt_width, prompt_height)
+
+   # Start from specified place unless the pupils remain unplaced.
+
+   if \sketch[1, 1] & \sketch[2, 1] then {
+      tcurve := curve
+      tpoint := point
+      }
+   else {
+      tcurve := 1
+      tpoint := 1
+      }
+
+   # Find the next unset point.
+
+   until /sketch[tcurve, 2 * tpoint - 1] do {
+      tpoint +:= 1			# advance to next point
+      if tpoint > (2 * *guideface[tcurve]) then {
+         tpoint := 1			# need to move to next curve
+         tcurve +:= 1
+         }
+      if tcurve > *guideface then
+         tcurve := 1			# wrapped around list of curves
+      if tcurve = curve & tpoint = point then {
+         tcurve := tx := ty := &null	# there are no unset points
+         return
+         }
+      }
+
+   # Draw a target on the guide face.
+
+   tx := guideface[tcurve, 2 * tpoint - 1]
+   ty := guideface[tcurve, 2 * tpoint]
+   FillCircle(target_win, tx, ty, TargetRad1)
+   FillCircle(target_win, tx, ty, TargetRad2)
+
+   # Display the prompt.
+
+   x := prompt_xoff + prompt_width / 2
+   y := prompt_yoff + prompt_height / 2
+   s := "locate " || descriptions[tcurve]
+   n := *guideface[tcurve]
+   if n > 2 then
+      s ||:= " (select " || n / 2 || " points)"
+   CenterString(x, y, s)
+
+   return
+
+end
+
+
+#  wtface(f, face) -- write face data to file f
+
+procedure wtface(f, face)
+   local curve, i
+
+   every curve := !face do {
+      writes(f, ":")
+      every i := 1 to *curve by 2 do {
+         writes(f, " ", (\curve[i] - image_xoff) | 0)
+         writes(f, " ", (\curve[i + 1] - image_yoff) | 0)
+         }
+      write(f)
+      }
+
+   return
+
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=640,480", "bg=pale gray", "label=Caricaturist"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,640,480:Caricaturist",],
+   ["distort:Slider:h:1:10,436,230,22:-300,300,0",slider_cb],
+   ["dmenu:Menu:pull::36,0,57,21:Display",menu_cb,
+      ["image    @I","drawing  @D","both     @B"]],
+   ["fmenu:Menu:pull::0,0,36,21:File",menu_cb,
+      ["new     @N","load    @L","save    @S","save as   ","quit    @Q"]],
+   ["header_line:Line:::0,22,639,22:",],
+   ["label1:Label:::11,409,77,13:distortion:",],
+   ["label2:Label:::9,460,28,13:anti",],
+   ["label3:Label:::104,460,42,13:normal",],
+   ["label4:Label:::213,460,28,13:wild",],
+   ["vert_line:Line:::250,23,250,479:",],
+   ["dmeter:Rect:invisible::104,410,41,10:",],
+   ["prompt:Rect:invisible::252,1,387,19:",],
+   ["guide:Rect:invisible::1,24,247,280:",],
+   ["image:Rect:invisible::252,24,387,455:",point_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/fetti.icn b/ipl/gprogs/fetti.icn
new file mode 100644
index 0000000..b872f12
--- /dev/null
+++ b/ipl/gprogs/fetti.icn
@@ -0,0 +1,202 @@
+############################################################################
+#
+#	File:     fetti.icn
+#
+#	Subject:  Program to explore families of confetti squares
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 12, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      Fetti is an interactive program for generating decorative
+#  web-page sidebars composed of randomly colored squares.  Many
+#  different parameters can be varied on the control panel.  Note
+#  that the mouse must be over a numeric field to type in a new
+#  value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: vsetup
+#
+############################################################################
+
+link vsetup
+
+global vidgets, root, region, rwin
+
+procedure main(args)
+
+   Window ! put(ui_atts(), args)
+   vidgets := ui()				# set up vidgets
+   root := vidgets["root"]
+   region := vidgets["region"]
+   rwin := SubWindow(region.ax, region.ay, region.aw, region.ah)
+   Bg(rwin, "white")
+   
+   render()
+   GetEvents(root, , all)
+end
+
+procedure all(a, x, y)
+   if a === !" \n\r" then render()
+   else if &meta then case a of {
+      !"qQ":  exit()
+      !"sS":  save()
+      }
+   return
+end
+
+procedure huebutton(v, x)
+   case v.id of {
+      "r": huerange(0, 15) 
+      "o": huerange(15, 45) 
+      "y": huerange(45, 60) 
+      "g": huerange(90, 150) 
+      "c": huerange(165, 195) 
+      "b": huerange(195, 225) 
+      "p": huerange(255, 285) 
+      "m": huerange(285, 315)
+      "all": huerange(0, 360)
+      "ygb": huerange(45, 195)
+      "bmr": huerange(195,360)
+   }
+end
+
+procedure huerange(min, max)
+   txtval("hmin", min, min)
+   txtval("hmax", max, max)
+   render()
+end
+
+procedure render()
+   local side, gap, across, down
+   local hmin, hmax, smin, smax, vmin, vmax
+   local i, j, h, s, v, color ,clist
+
+   side := txtval("side", 1, 100)
+   gap := txtval("gap", 0, 100)
+   across := txtval("across", 1, 1000)
+   down := txtval("down", 1, 1000)
+   hmin := txtval("hmin", 0, 360)
+   hmax := txtval("hmax", hmin, 360)
+   smin := txtval("smin", 0, 100)
+   smax := txtval("smax", smin, 100)
+   vmin := txtval("vmin", 0, 100)
+   vmax := txtval("vmax", vmin, 100)
+
+   EraseArea()	# for color recycling
+   VDraw(root)	# needed after erase
+
+   EraseArea(rwin)
+   clist := []
+   every i := 0 to down - 1 do {
+      every j := 0 to across - 1 do {
+	 h := hmin + integer(?(hmax - hmin))
+	 s := smin + integer(?(smax - smin))
+	 v := vmin + integer(?(vmax - vmin))
+	 color := HSVValue(h || "/" || s || "/" || v)
+	 if Fg(rwin, color) then
+	    put(clist, color)
+	 else
+	    Fg(rwin, ?clist)
+	 FillRectangle(rwin,
+	    gap + j * (gap + side), gap + i * (gap + side), side, side)
+         }
+      }
+
+   return
+end
+
+procedure txtval(s, min, max)
+   local v, n
+
+   v := vidgets[s]
+   VEvent(v, "\r", v.ax, v.ay)
+   n := integer(VGetState(v)) | min
+   n <:= min
+   n >:= max
+   VSetState(v, n)
+   return n
+end
+
+procedure save()
+   local g
+
+   g := WAttrib("gamma")
+   WAttrib("gamma=1.0")		# don't gamma-correct on write
+   repeat case OpenDialog("Save confetti image:") of {
+      "Cancel": {
+	 WAttrib("gamma=" || g)
+	 fail
+	 }
+      "Okay": {
+         if WriteImage(dialog_value, region.ax, region.ay, region.aw, region.ah)
+	 then
+	    break
+         else
+	    Notice("cannot write file:", dialog_value)
+         }
+      }
+   WAttrib("gamma=" || g)
+   return
+end
+
+procedure quit()
+   exit()
+end
+
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=400,500", "bg=pale gray", "label=fetti"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,400,500:fetti",],
+   ["across:Text::3:300,59,87,19:Across: \\=5",],
+   ["all:Button:regular::259,235,28,17:all",huebutton],
+   ["b:Button:regular::315,218,14,17:b",huebutton],
+   ["bmr:Button:regular::315,235,28,17:bmr",huebutton],
+   ["c:Button:regular::301,218,14,17:c",huebutton],
+   ["down:Text::3:300,82,87,19:Down:   \\=50",],
+   ["g:Button:regular::287,218,14,17:g",huebutton],
+   ["gap:Text::3:213,82,73,19:Gap:  \\=1",],
+   ["hlab:Label:::267,126,21,13:Hue",],
+   ["hmax:Text::3:261,167,31,19:\\=360",],
+   ["hmin:Text::3:261,144,31,19:\\=0",],
+   ["m:Button:regular::343,218,14,17:m",huebutton],
+   ["malab:Label:::216,167,21,13:max",],
+   ["mnlab:Label:::216,144,21,13:min",],
+   ["o:Button:regular::259,218,14,17:o",huebutton],
+   ["p:Button:regular::329,218,14,17:p",huebutton],
+   ["quit:Button:regular::260,439,78,29:quit   @Q",quit],
+   ["r:Button:regular::245,218,14,17:r",huebutton],
+   ["render:Button:regular::269,318,62,35:RENDER",render],
+   ["save:Button:regular::260,408,78,29:save   @S",save],
+   ["side:Text::3:213,59,73,19:Side: \\=9",],
+   ["slab:Label:::314,126,21,13:Sat",],
+   ["smax:Text::3:308,167,31,19:\\=70",],
+   ["smin:Text::3:308,144,31,19:\\=20",],
+   ["title:Label:::250,21,98,13:Confetti Maker",],
+   ["vlab:Label:::361,126,21,13:Val",],
+   ["vmax:Text::3:355,167,31,19:\\=100",],
+   ["vmin:Text::3:355,144,31,19:\\=80",],
+   ["y:Button:regular::273,218,14,17:y",huebutton],
+   ["ygb:Button:regular::287,235,28,17:ygb",huebutton],
+   ["outline:Rect:sunken::261,309,78,52:",],
+   ["region:Rect:invisible::0,0,200,500:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/fev.icn b/ipl/gprogs/fev.icn
new file mode 100644
index 0000000..01ea01f
--- /dev/null
+++ b/ipl/gprogs/fev.icn
@@ -0,0 +1,170 @@
+############################################################################
+#
+#	File:	  fev.icn
+# 
+#	Subject:  Program to display text in fisheye view
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:	  June 17, 1994
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     A text file browser that employs a fish-eye view.  The
+# fish-eye view displays text in a larger font in the middle (focus)
+# gradually declining to tiny fonts at the top and bottom of the screen.
+#
+#     "q" or ESC to quit.  "n" slides the focus down one line
+# "p" slides the focus up one line.  "w" widens the focus by one.
+# "W" narrows the focus by one.  Mouse clicks move the focus to the line
+# on which the mouse is located; clicking in the left margin moves
+# in the file proportional to the mouse's y coordinate in the window.
+#
+############################################################################
+#
+#     Requires:  Version 9 graphics with X11R5 scalable fonts on the X server
+#
+############################################################################
+#
+#  Links: wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+procedure main(av)
+   local slope, fin, win, L, ht, focus, focuswidth, e, base
+   slope := 2
+   if av[1] == "-s" then slope := (pop(av), pop(av))
+   fin := open(av[1]) | stop("no file")
+   win := WOpen("label=" || av[1], "height=860") | stop("no window")
+   L := []
+   every put(L,!fin)
+   write(*L," lines")
+   ht := 23
+   focus := *L/2
+   focuswidth := 1
+   fisheye(win,L,focus,ht,slope,,,focuswidth)
+   repeat {
+      e := Event(win)
+      case e of {
+	 "q"|"\e": exit(0)
+	 "n" : focus := *L >= focus+1
+	 "p" : focus := 1 <= focus - 1
+	 "w" : focuswidth +:= 1
+	 "W" : (1 < focuswidth) -:= 1
+	 &lpress|&ldrag|&mpress|&mdrag|&rpress|&rdrag: {
+	    if &x < 17 then {
+	       focus := *L * &y / WAttrib(win,"height")
+	       }
+	    else {
+	       base := WAttrib(win,"height") / 2
+	       focus := moveFocusToMouse(win,L,focus,base,ht,slope,focuswidth)
+	       }
+	    }
+	 default : next
+	 }
+      fisheye(win,L,focus,ht,slope,,,focuswidth)
+      }
+end
+
+procedure fisheye(w,L,focus,maxht,slope,family,weight,focuswidth)
+   static fonttable
+   local past_end, i, splt
+   initial {
+      fonttable := table()
+      }
+   /focuswidth := 1
+   /family := "helvetica"
+   /weight := "bold"
+
+   /fonttable[w] := []
+
+   past_end := *fonttable[w] + 1
+   every i := past_end to maxht do {
+      put(fonttable[w], 
+	  XBind(w,"font=-adobe-"||family||"-"||weight||
+		"-r-normal--"||i||"-*-*-*-*-*-*-*") | stop("no XBind"))
+      }
+   EraseArea(w)
+   splt := WAttrib(w,"height") / 2
+   viewtop(fonttable[w],L,focus,splt,maxht,slope,focuswidth)
+   viewbottom(fonttable[w],L,focus+1,splt+maxht,maxht-slope,slope,focuswidth)
+   FillRectangle(w,0,(focus * WAttrib(w,"height") / *L)-WAttrib(w,"ascent"),
+		  16,WAttrib(w,"fheight"))
+   DrawLine(w,17,0,17,WAttrib(w,"height") * focuswidth)
+
+end
+
+procedure viewtop(w,L,focus,base,ht,slope,focuswidth)
+   local wh
+   wh := WAttrib(w[1],"height") | stop("no WAttrib")
+   while focus >= 1 & base >= 1 do {
+      if ht < 1 then ht := 1
+      GotoXY(w[1],20,base)
+
+      writes(w[ht],L[focus])
+      base -:= ht
+      if focus > 1 & base / focus < ht & focuswidth <= 1 then
+	 ht -:= slope
+      focuswidth -:= 1
+      focus -:= 1
+      }
+   if focus < 1 then return 1
+   return focus
+end
+
+procedure viewbottom(w,L,focus,base,ht,slope,focuswidth)
+   local wh
+   wh := WAttrib(w[1],"height") | stop("no WAttrib")
+   while focus <= *L & base <= wh do {
+      if ht < 1 then ht := 1
+      GotoXY(w[1],20,base)
+
+      writes(w[ht],L[focus])
+      base +:= ht
+      if focus < *L & (wh - base) / (*L - focus) < ht & focuswidth <= 1 then
+	 ht -:= slope
+      focuswidth -:= 1
+      focus +:= 1
+      }
+   if focus > *L then return *L
+   return focus
+end
+
+procedure moveFocusToMouse(w,L,focus,base,ht,slope,focuswidth)
+   local wh, fh
+   wh := WAttrib(w,"height") | stop("no WAttrib")
+   fh := WAttrib(w,"ascent") | stop("no WAttrib")
+   if &y < base then {
+      while focus >= 1 & base-fh >= &y do {
+	 if ht < 1 then ht := 1
+	 base -:= ht
+	 if focus > 1 & base / focus < ht & focuswidth <= 1 then
+	    ht -:= slope
+	 focuswidth -:= 1
+	 focus -:= 1
+	 }
+      }
+   else {
+      focus +:= 1
+      base +:= ht
+      ht -:= slope
+      while focus <= *L & base <= &y do {
+	 if ht < 1 then ht := 1
+	 base +:= ht
+	 if focus < *L & (wh - base) / (*L - focus) < ht & focuswidth <= 1 then
+	    ht -:= slope
+	 focuswidth -:= 1
+	 focus +:= 1
+	 }
+      }
+   if focus < 1 then return 1
+   if focus > *L then return *L
+   return focus
+end
diff --git a/ipl/gprogs/fileimag.icn b/ipl/gprogs/fileimag.icn
new file mode 100644
index 0000000..1c46190
--- /dev/null
+++ b/ipl/gprogs/fileimag.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     fileimag.icn
+#
+#	Subject:  Program to create GIF image of file text
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 8, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates an image file for a text file.  The results are
+#  unpredictable for binary files or files with control characters.
+#
+#  The image may be too large for a window.
+#
+#  Badly needed are options for the font.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local input, width, height, line
+
+   input := open(args[1]) | stop("*** cannot open file")
+
+   width := height := 0
+
+   while line := read(input) do {
+      height +:= 1
+      width <:= *line
+      }
+
+   height +:= 1
+
+   close(input)
+
+   input := open(args[1]) | stop("*** cannot re-open file")
+
+   WOpen("canvas=hidden", "columns=" || width, "lines=" || height) |
+      stop("*** cannot open window")
+
+   while WWrite(WRead(input))
+
+   WriteImage("untitled.gif")
+
+
+end
diff --git a/ipl/gprogs/findrpt.icn b/ipl/gprogs/findrpt.icn
new file mode 100644
index 0000000..de9a6a2
--- /dev/null
+++ b/ipl/gprogs/findrpt.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#	File:     findrpt.icn
+#
+#	Subject:  Program to find smallest repeat in a repeat pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces the smallest motif in an image that will tile
+#  to the image.
+#
+#  The image to be processed must be a "true" repeat -- pixel for pixel.
+#
+#  The options supported are:
+#
+#	-n s	suffix for output image, default _t.  The suffix is
+#  		appended to the basename of the input image, as in
+#		foo.gif -> foo_t.gif.
+#
+#	-s	show size; default produce image
+#
+#  Warning:  This program is *very* slow.
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, options, repetit, wopen
+#
+############################################################################
+
+link numbers
+link options
+link repetit
+link wopen
+
+procedure main(args)
+   local width, height, x, y, row, col, rows, cols, w, h, suffix, file
+   local basename, opts
+
+   opts := options(args, "n:s")
+   suffix := \opts["s"] | "_t"
+
+   every file := !args do {
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      file ? {
+         basename := 1(tab(find(".gif")), move(0)) | "unname"
+         }
+      width := WAttrib("width")
+      height := WAttrib("height")
+   
+      rows := []
+      every y := 0 to height - 1 do {
+         row := []
+         every put(row,Pixel(0, y, width, 1))
+         put(rows, repetit(row))
+         }
+      h := lcml ! rows
+      h >:= height
+   
+      cols := []
+      every x := 0 to width - 1 do {
+         col := []
+         every put(col, Pixel(x, 0, 1, height))
+         put(cols, repetit(col))
+         }
+      w := lcml ! cols
+      w >:= width
+
+      if w = width & h = height then {
+         write(&errout, file, " has no subrepeat")
+         next
+         }
+   
+      if \opts["s"] then
+         write(file, ": ", w, "x", h)
+      else
+         WriteImage(basename || suffix || ".gif", 0, 0, w, h) | {
+         write(&errout, "*** cannot write image for ", file)
+         write(&errout, "w=", w, " h=", h)
+         }
+      WClose(&window)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/findtile.icn b/ipl/gprogs/findtile.icn
new file mode 100644
index 0000000..0efc926
--- /dev/null
+++ b/ipl/gprogs/findtile.icn
@@ -0,0 +1,599 @@
+############################################################################
+#
+#	File:     findtile.icn
+#
+#	Subject:  Program to find tiles in an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 7, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in locating areas within an image
+#  that, when tiled, produce a desired effect.  For example, a background
+#  may consist of a tiled image; this program can be used to find the
+#  smallest tile for the repeat (by "eye-balling").  It's worth noting
+#  that interesting images can be found for other settings.  For example,
+#  another interesting use of this program is to produce striped patterns by
+#  selecting a row or column of an image to get a tile that is one character
+#  wide.  Sometimes a few rows or columns give an interesting "fabric"
+#  effect.
+#
+#  There are three windows:
+#
+#	the VIB control window
+#	the source image window
+#	a repeat window, which shows the selection from the source
+#	  image, tiled.
+#
+#  The selection from the source image is shown as a marquee in the
+#  source image window.  When a source image is loaded, the marquee starts
+#  with the entire image.  The marquee can be changed by buttons and
+#  arrow-key events on the control window (not the source image window).
+#
+#  The arrow keys have two modes.  With no modifier, they nudge the
+#  location of the marquee.  With the meta-key modifier, they nudge
+#  the dimensions of the marquee.
+#
+#  The reset button resets the marquee to the entire image.
+#
+#  The current selection can be mirrored using the mirror button.
+#
+#  The following features are provided through keyboard shortcuts:
+#  the File menu, and in some cases, on-board buttons:
+#
+#	@O	open new source image
+#	@Q	quit application
+#  	@S	save current selection as an image
+#	@Z	set size precisely
+#
+#  The repeat window can be resized by the user, but it is not redrawn
+#  until the marque is changed or the refresh button is pushed.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:   grecords, interact, mirror, tile
+#
+############################################################################
+#
+#  Includes:  keysyms.icn
+#
+############################################################################
+
+link grecords
+link interact
+link mirror
+link tile
+
+$include "keysyms.icn"
+
+#  Globals related to windows:
+
+global controls		# VIB control window
+global pattern		# repeat window
+global screen		# source image window visible
+global source		# source image window hidden
+global symmetry		# mirroring window
+
+global posx		# x position relative to interface window
+global posy		# y position relative to repeat window
+
+#  Globals related to the selection:
+
+global current		# current selection record
+global hmax		# maximum height of source image
+global wmax		# maximum width of source image
+global previous		# previous selection record
+
+global vidgets		# table of interface vidgets
+
+procedure main()
+   local atts, x1, y1
+
+   atts := ui_atts()
+   put(atts,  "posx=10", "posy=10")
+
+   controls := (WOpen ! atts) | ExitNotice("Cannot open control window.")
+
+   vidgets := ui()
+
+   init()
+
+   repeat {
+      while *Pending(controls) > 0 do
+         ProcessEvent(vidgets["root"], , shortcuts)
+      while *Pending(\screen) > 0 do
+         if Event(screen) === &lpress then draw_marquee()
+      }
+
+end
+
+#  Callback that handles all the buttons that change x, y, w, and h.
+
+procedure adjust_cb(vidget, value)
+
+   check_source() | fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value[1] of {
+      "w max"  :  current.w := (wmax - current.x)
+      "h max"  :  current.h := (hmax - current.y)
+      "w = 1"  :  current.w := 1
+      "h = 1"  :  current.h := 1
+      "full"   :  {
+         current.h := hmax
+         current.w := wmax
+         current.x := 0
+         current.y := 0
+         }
+      "w / 2"  :  check(current.w <- current.w / 2)
+      "h / 2"  :  check(current.h <- current.h / 2)
+      "w * 2"  :  check(current.w <- current.w * 2)
+      "h * 2"  :  check(current.h <- current.h * 2)
+      }
+
+   show()
+
+   return
+
+end
+
+procedure draw_marquee()
+   local x1, y1
+
+   current.x := &x
+   current.y := &y
+   current.h := current.w := 0
+
+   update()
+
+   repeat {
+      case Event(screen) of {
+         &ldrag     :  update_marquee()
+         &lrelease  :  {
+            update_marquee()
+            Raise(controls)
+            return
+            }
+         }
+      }
+
+end
+
+procedure update_marquee()
+
+   if &x < 0 then &x := 0
+   if &y < 0 then &y := 0
+   if &x > wmax then &x := wmax
+   if &y > hmax then &y := hmax
+   current.w := &x - current.x
+   current.h := &y - current.y
+
+   show()
+
+   return
+
+end
+
+procedure location_cb(vidget, value)
+
+   check_source() | fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value[1] of {
+      "nw"      :     current.x := current.y := 0
+      "ne"      :     {
+          current.x := wmax - current.w
+          current.y := 0
+          }
+      "se"      :     {
+          current.x := wmax - current.w
+          current.y := hmax - current.h
+          }
+      "sw"      :     {
+          current.x := 0
+          current.y := hmax - current.h
+          }
+      "x max"   :  current.x := wmax - current.w
+      "y max"   :  current.y := hmax - current.h
+      "center"  : {
+         current.x := (wmax - current.w) / 2
+         current.y := (hmax - current.h) / 2
+         }
+      "home"    :   {
+         current.x := 0
+         current.y := 0
+         }
+      "x / 2"   :    current.x <- current.x / 2
+      "y / 2"   :    current.y <- current.y / 2
+      "x * 2"   :    check(current.x <- current.x * 2)
+      "y * 2"   :    check(current.y <- current.y * 2)
+      }
+
+   show()
+
+   return
+
+end
+
+#  Check validity of selection.
+
+procedure check()
+
+   if (0 <= current.w <= (wmax - current.x)) &
+      (0 <= current.h <= (hmax - current.y)) &
+      (0 <= current.x <= hmax) &
+      (0 <= current.y <= wmax)
+   then return else {
+      Alert()
+      fail
+      }
+
+end
+
+#  Copy hidden source window to a visible window.
+
+procedure copy_source(label)
+
+   screen := WOpen(
+      "size=" || WAttrib(source, "width") || "," || WAttrib(source, "height"),
+      "posx=" || posx,
+      "posy=" || posy,
+      "label=" || label,
+      "drawop=reverse",
+      "linestyle=onoff"
+      ) | ExitNotice("Cannot open image window.")
+
+   CopyArea(source, screen)
+
+   Raise(controls)
+
+   wmax := WAttrib(source, "width")
+   hmax := WAttrib(source, "height")
+
+   WAttrib(pattern, "width=" || (WAttrib(screen, "width")))
+   WAttrib(pattern, "height=" || (WAttrib(screen, "height")))
+   EraseArea(pattern)
+
+   current := rect(0, 0, wmax, hmax)
+
+   show()
+
+   return
+
+end
+
+#  Handle file menu.
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O"  :  get_image()
+      "quit  @Q"  :  quit_cb()
+      "save  @S"  :  save_cb()
+      }
+
+   return
+
+end
+
+#  Get new source image.
+
+procedure get_image()
+
+   WClose(\source)
+   WClose(\screen)
+   WClose(\symmetry)
+   EraseArea(pattern)
+
+   repeat {
+      (OpenDialog("Open image:") == "Okay") | fail
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Can't open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      wmax := WAttrib(source, "width")
+      hmax := WAttrib(source, "height")
+      break
+      }
+
+   return
+
+end
+
+#  These values are for Motif; they may need to be changed for other
+#  window managers.
+
+$define Offset1	32
+$define Offset2	82
+
+#  Initialize the program.
+
+procedure init()
+   local iheight
+
+   posx := WAttrib(controls, "width") + Offset1
+
+   iheight := WAttrib(controls, "height")
+
+   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
+      "," || iheight, "posx=" || posx, "posy=10") |
+         ExitNotice("Cannot open pattern window.")
+
+   posy := WAttrib(pattern, "height") + Offset2
+
+   Raise(controls)
+
+   return
+
+end
+
+procedure update()
+   static sx, sy
+
+   initial {
+      sx := vidgets["marker"].ax
+      sy := vidgets["marker"].ay
+      }
+
+   #  Update selection information on interface.
+
+   WAttrib(controls, "drawop=reverse")
+
+   DrawString(controls, sx, sy, "marquee:  x=" || (\previous).x  || "  y=" ||
+      previous.y || "  w=" || previous.w || "  h=" || previous.h)
+   DrawString(controls, sx, sy, "marquee:  x=" || current.x  || "  y=" ||
+      current.y || "  w=" || current.w || "  h=" || current.h)
+
+   WAttrib(controls, "drawop=copy")
+
+   #  Update the selection rectangle.
+
+   DrawRectangle(screen, (\previous).x, previous.y, previous.w, previous.h)
+   DrawRectangle(screen, current.x, current.y, current.w, current.h)
+
+   previous := copy(current)
+
+   return
+
+end
+
+procedure mirror_cb()
+
+   check_source() | fail
+
+   #  Normalize selection rectangle.
+
+   if current.w < 0 then {
+      current.w := -current.w
+      current.x -:= current.w
+      }
+
+   if current.h < 0 then {
+      current.h := -current.h
+      current.y -:= current.h
+      }
+
+   WClose(\symmetry)
+
+   symmetry := mirror(source, current.x, current.y, current.w, current.h) | {
+      Notice("Cannot mirror tile.")
+      fail
+      }
+
+   #  In case the window manager opens a window larger than requested ...
+
+   tile(symmetry, pattern, 0, 0, current.w * 2, current.h * 2)
+
+   #  Hide it but keep it in case the user wants to save it.
+
+#  WAttrib(symmetry, "canvas=hidden")
+
+   Raise(controls)
+
+   return
+
+end
+
+#  Terminate program execution.
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+procedure refresh_cb()
+
+   tile(source, pattern, current.x, current.y, current.w, current.h)
+
+   return
+
+end
+
+#  Callback procedure to allow use of standard tile sizes.
+
+procedure size_cb(vidget, value)
+   local dim
+
+   check_source() | fail
+ 
+   if value[1] == "set  @Z" then {
+      set_size()
+      return
+      }
+
+   value[1] ? {
+      dim := tab(upto('x'))
+      }
+
+   check(current.w <- current.h <- dim) | fail
+
+   show()
+
+   return
+
+end
+
+#   Setting of specific selection rectangle values.
+
+procedure set_size()
+
+   repeat {
+      if TextDialog("Set values:",
+         ["x", "y", "w", "h"],
+         [current.x, current.y, current.w, current.h ]
+         ) == "Cancel" then fail
+      check(
+         current.x <- integer(dialog_value[1]) &
+         current.y <- integer(dialog_value[2]) &
+         current.w <- integer(dialog_value[3]) &
+         current.h <- integer(dialog_value[4])
+         ) | {
+            Notice("Invalid value.")
+            next
+            }
+      show()
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   case type(e) of {
+      "string"   : {
+         if &meta then case map(e) of {			# fold case
+            "m"  :  mirror_cb()
+            "o"  :  get_image()
+            "q"  :  exit()
+            "s"  :  save_cb()
+            "z"  :  set_size()
+            }
+         }
+      "integer"  : {
+         if &meta then {	# nudge dimensions
+            if check(
+               case e of {
+                  Key_Left   :  current.w <- current.w - 1
+                  Key_Right  :  current.w <- current.w + 1
+                  Key_Up     :  current.h <- current.h - 1
+                  Key_Down   :  current.h <- current.h + 1
+                  }
+               ) then show() else fail
+            }
+         else {			# nudge location
+            if check (
+               case e of {
+                  Key_Left   :  current.x <- current.x - 1
+                  Key_Right  :  current.x <- current.x + 1
+                  Key_Up     :  current.y <- current.y - 1
+                  Key_Down   :  current.y <- current.y + 1
+                  }
+               ) then show() else fail
+            }
+         }
+      }
+
+   return
+
+end
+
+#  Show selection tiled.
+
+procedure show()
+   local x, y, w, h
+
+   check_source() | fail
+
+   x := current.x
+   y := current.y
+   w := current.w
+   h := current.h
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   tile(source, pattern, x, y, w, h)
+
+   update()
+
+   return
+
+end
+
+#  Save current selection.
+
+procedure save_cb()
+
+   check_source() | fail
+
+   return snapshot(source, current.x, current.y, current.w, current.h)
+
+end
+
+#  Check for source image.
+
+procedure check_source()
+
+   \source | {
+      Notice("No source image.")
+      fail
+      }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=360,243", "bg=pale gray", "label=Tile Finder"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,360,243:Tile Finder",],
+   ["adjust:Menu:pull::131,1,50,21:Adjust",adjust_cb,
+      ["home","w max","h max","w * 2","h * 2",
+      "w / 2","h / 2","w = 1","h = 1"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","save  @S","save mirrored","quit  @Q"]],
+   ["line1:Line:::0,22,360,22:",],
+   ["location:Menu:pull::35,0,64,21:Location",location_cb,
+      ["nw","ne","se","sw","center",
+      "x max","y max","x * 2","y * 2","x / 2",
+      "y / 2"]],
+   ["mirror:Button:regular::100,41,58,20:mirror",mirror_cb],
+   ["refresh:Button:regular::22,41,58,20:refresh",refresh_cb],
+   ["size:Menu:pull::98,0,36,21:Size",size_cb,
+      ["set  @Z","4x4","8x8","16x16","32x32",
+      "64x64","72x72","96x96","100x100","128x128",
+      "200x200","256x256","400x400","512x512"]],
+   ["marker:Rect:invisible::8,110,32,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/flake.icn b/ipl/gprogs/flake.icn
new file mode 100644
index 0000000..21b7d00
--- /dev/null
+++ b/ipl/gprogs/flake.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#       File:     flake.icn
+#
+#	Subject:  Program to draw a fractal snowflake
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program display a fractal snowflake of specified
+#       order.  Options exist to do colors, etc.
+#	See the procedure 'helpmsg' for command line options
+#
+#	An order 4 snowflake is particularly nice.
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#	Links: glib, wopen
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+global nextcolor
+
+procedure main (args)
+    local nextarg, arg, n, doclip, docolor, Cpoly
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       else if arg == "-n" then n := integer(@nextarg)
+       else if arg == "-clip" then doclip := "yes"
+       else if arg == "-color" then docolor := "yes"
+       }
+
+    /n := 3		# default order
+
+    if \doclip then {
+       Cpoly := [	# a simple convext polygon to clip against
+                 [0.3,0.4],[0.5,0.8],[0.7,0.4]
+                ]
+       }
+
+    win := WOpen("label=Fractal Snowflake", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    if \docolor then
+       nextcolor := create vpara([0,0,65535], [65535,0,0], |((0 to 12)/12.0))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+
+    fract_flake(Window, point(0.20,0.33), point(0.80,0.33), n, 1, Cpoly)
+
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Flake [-n order] [-clip] [-color]")
+   write("   where")
+   write("     -n order		-- Depth of recursion {3}")
+   write("     -clip		-- Clip to a convex polygon")
+   write("     -color		-- Color cycle while drawing")
+   return
+end
diff --git a/ipl/gprogs/floats.icn b/ipl/gprogs/floats.icn
new file mode 100644
index 0000000..9061c28
--- /dev/null
+++ b/ipl/gprogs/floats.icn
@@ -0,0 +1,77 @@
+############################################################################
+#
+#	File:     floats.icn
+#
+#	Subject:  Program to count floats
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes the floats in a drawdown as a BLP or row file
+#  from standard input.
+#
+############################################################################
+#
+#  Links:  pattread, patxform
+#
+############################################################################
+
+link pattread
+link patxform
+
+procedure main()
+   local front, back, black, white
+
+   front := pattread()
+   
+   back := pinvert(front)
+
+   analyze("Front weft floats", front, "0")
+
+   front := protate(front)
+
+   analyze("Front warp floats", front, "1")
+   analyze("Back weft floats", back, "0")
+
+   back := protate(back)
+
+   analyze("Back warp floats", back, "1")
+
+end
+
+procedure analyze(caption, rows, color)
+   local counts, length, row
+
+   counts := table(0)
+
+   every row := !rows do {
+         row ? {
+            while tab(upto(color)) do {
+               length := *tab(many(color))
+            if length > 2 then counts[length] +:= 1
+            }
+         }
+      }
+
+   if *counts = 0 then return
+
+   write(caption)
+
+   counts := sort(counts, 3)
+
+   write()
+
+   while write("\t", get(counts), "\t", get(counts))
+
+   write()
+
+   return
+
+end
diff --git a/ipl/gprogs/flohisto.icn b/ipl/gprogs/flohisto.icn
new file mode 100644
index 0000000..59772ac
--- /dev/null
+++ b/ipl/gprogs/flohisto.icn
@@ -0,0 +1,171 @@
+############################################################################
+#
+#	File:     flohisto.icn
+#
+#	Subject:  Program to display float histograms
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 28, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes the floats in BLPs for drawdowns.
+#
+#  The names of BLPs are given on the command line.  The output images
+#  are named <basename>_float.gif
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  link basename, numbers, options, wopen
+#
+############################################################################
+
+link basename
+link wopen
+link numbers
+link pattread
+
+$define FloatMax 15
+$define Width 300
+$define Gutter 20
+$define Height 250
+$define Delta 9
+$define Gap 4
+$define Xoff 20
+$define Yoff 30
+
+procedure main(args)
+   local front, back, black, white, name, i, canvas
+   local warp_front, warp_back, weft_front, weft_back, win, input
+
+   every name := !args do {
+      input := open(name) | stop("Cannot open ", name)
+      front := pattread(input)
+      close(input)
+      back := copy(front)	 #  0 = black, 1 = white.
+   every i := 1 to *back do
+      back[i] := map(back[i], "10", "01")
+   weft_front := analyze(front, "1")
+   front := rot(front)
+   warp_front := analyze(front, "0")
+   weft_back := analyze(back, "1")
+   back := rot(back)
+   warp_back := analyze(back, "0")
+   win := WOpen("size=" || (2 * Width + 2 * Gutter) || "," ||
+         (2 * Height + 2 * Gutter), "canvas=hidden") |
+         stop("*** cannot open main window")
+   CopyArea(plot(warp_front, "warp front"), win, , , , , 0, 0)
+   CopyArea(plot(weft_front, "weft front"), win, , , , , Width + Gutter, 0)
+   CopyArea(plot(warp_back, "warp back"), win, , , , , 0, Height + Gutter)
+   CopyArea(plot(weft_back, "weft back"), win, , , , , Width + Gutter,
+      Height + Gutter)
+      WriteImage(win, basename(name, ".blp") || "_floats.gif")
+      WClose(win)
+      }
+
+end
+
+procedure analyze(rows, color)
+   local counts, length, row, k, count_list
+
+   counts := table(0)
+
+   every row := !rows do {
+      row ? {
+         while tab(upto(color)) do {
+            length := *tab(many(color))
+            if length > 1 then counts[length] +:= 1
+            }
+         }
+      }
+
+   if *counts = 0 then fail	# no floats
+
+   count_list := list(FloatMax, 0)	# list of counts
+
+   every k := key(counts) do
+      if k > FloatMax then count_list[FloatMax] +:= counts[k]
+      else count_list[k - 1] := counts[k]
+
+   return count_list
+
+end
+
+procedure plot(data, legend)
+   local i, j, scale, maximum, y, width, win
+
+   win := WOpen("size=" || Width || "," || Height, "font=times,10", "canvas=hidden") |
+      stop("*** cannot open plotting window")
+
+   WAttrib(win, "dx=" || Xoff)
+   WAttrib(win, "dy=" || (Yoff + Gap))
+
+   DrawLine(win, 0, 0 - Gap, Width, 0 - Gap)
+   DrawLine(win, 0, 0 - Gap, 0, Height - Gap)
+
+   DrawString(win, -2, -(18 + Gap), legend)
+
+   if /data then return win
+
+   maximum := max ! data
+   maximum := integer((maximum + 99.0) / 100) * 100	# get to next hundred
+
+   width := real(Width - 2 * Xoff)
+   scale := width / maximum
+
+   every i := 0 to 4 do
+      CenterString(win, (width / 4) * i, 18 - Yoff, (maximum / 4) * i)
+
+   every j := 2 to FloatMax + 1 do {
+      y := (j - 2) * (Delta + Gap)
+      FillRectangle(win, 0, y, data[j - 1] * scale, Delta)
+      if j > FloatMax then j := ">"
+      RightString(win, 15 - Xoff, y + Gap, j)
+      }
+
+   return win
+
+end
+
+procedure win2rows(win)
+   local width, height, row, rows, pixel, y
+
+   width := WAttrib(win, "width")
+   height := WAttrib(win, "height")
+
+   rows := []
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every pixel := Pixel(win, 0, y, width, 1) do
+         row ||:= if pixel == "0,0,0" then "0" else "1"
+      put(rows, row)
+      }
+
+   return rows
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/fmap2pdb.icn b/ipl/gprogs/fmap2pdb.icn
new file mode 100644
index 0000000..91709b9
--- /dev/null
+++ b/ipl/gprogs/fmap2pdb.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     fmap2pdb.icn
+#
+#	Subject:  Program to create custom palettes from color maps
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 15, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program builds a palette database from Fracting color maps.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links: basename, palettes, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, input, clist, color, line, name
+
+    every file := !args do {
+       input := open(file) | {
+          write(&errout, "*** cannot open ", image(file))
+          next
+          }
+       name := basename(file, ".map")
+       clist := []
+       while line := read(input) do {
+          line ? {
+             tab(upto(&digits))
+             color := (tab(many(&digits)) * 257) || ","
+             tab(upto(&digits))
+             color ||:= (tab(many(&digits)) * 257) || ","
+             tab(upto(&digits))
+             color ||:= (tab(many(&digits)) * 257)
+             }
+          put(clist, color)
+          }
+       close(input)
+       makepalette(name, clist) |
+          write(&errout, "*** could not make palette from ", image(file))
+       }
+
+    xencode(PDB_, &output)
+       
+end
diff --git a/ipl/gprogs/fontpick.icn b/ipl/gprogs/fontpick.icn
new file mode 100644
index 0000000..5b5497e
--- /dev/null
+++ b/ipl/gprogs/fontpick.icn
@@ -0,0 +1,163 @@
+############################################################################
+#
+#	File:     fontpick.icn
+#
+#	Subject:  Program to show the characters of a font
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  fontpick [fontname]
+#
+#  fontpick is an interactive tool for displaying fonts.  Initially, the
+#  specified font, or the VIB default font, is displayed.  To display a
+#  different font, type its name and press return.  To exit, enter Meta-Q
+#  or click the QUIT button.
+#
+#  Caveats:
+#  -- any character that is too large is clipped to fit its cell
+#  -- the window cannot be resized to handle large fonts
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: vsetup
+#
+############################################################################
+
+link vsetup
+
+global vidgets
+
+
+#  main procedure
+
+procedure main(args)
+   Window ! put(ui_atts(), args)
+   vidgets := ui()
+   setfont(, args[1] | Font())			# display named or default font
+   repeat ProcessEvent(vidgets["root"], other)
+end
+
+
+#  setfont(vidget, value) -- display the font named "value"
+
+procedure setfont(vidget, value)
+   local ttl, sub, rgn, fontname, x, y, w, h, win
+
+   # ignore return if no name has been entered
+   if *value = 0 then
+      return
+
+   # get vidget handles
+   ttl := vidgets["title"]
+   sub := vidgets["subtitle"]
+   rgn := vidgets["region"]
+
+   # display font name in title region
+   EraseArea(ttl.ux, ttl.uy, ttl.uw, ttl.uh)
+   EraseArea(sub.ux, sub.uy, sub.uw, sub.uh)
+   CenterString(ttl.ux + ttl.uw / 2, ttl.uy + ttl.uh / 2, value)
+
+   # open and display the font
+   EraseArea(rgn.ux, rgn.uy, rgn.uw, rgn.uh)
+   if win := Clone("font=" || value) then {
+      dumpfont(win, rgn.ux, rgn.uy, rgn.uw, rgn.uh)
+      fontname := Font(win)
+      if fontname ~== value then
+         CenterString(sub.ux + sub.uw / 2, sub.uy + sub.uh / 2, fontname)
+      }
+   else {
+      CenterString(sub.ux + sub.uw / 2, sub.uy + sub.uh / 2,
+         "(cannot find font)")
+      }
+
+   # clear the text entry field to accept the next name
+   VSetState(vidgets["fontname"], "")
+   return
+end
+
+
+#  dumpfont(win, x, y, w, h) -- display the characters of a font
+
+procedure dumpfont(win, x, y, w, h)
+   local dx, dy, x1, x2, y1, y2, i, j
+
+   # calculate size of cells
+   dx := (w - 1.001) / 16.0
+   dy := (h - 1.001) / 16.0
+
+   # draw light gray lines to delimit character cells
+   Fg("light gray")
+   every x1 := x + integer(dx * (1 to 15)) do
+      DrawLine(x1, y, x1, y + h - 1)
+   every y1 := y + integer(dy * (1 to 15)) do
+      DrawLine(x, y1, x + w - 1, y1)
+   Fg("black")
+
+   # display characters, one per cell
+   every i := 0 to 15 do {
+      y1 := integer(y + i * dy)
+      y2 := integer(y + (i + 1) * dy)
+      every j := 0 to 15 do {
+         x1 := integer(x + j * dx)
+         x2 := integer(x + (j + 1) * dx)
+         Clip(win, x1 + 1, y1 + 1, x2 - x1 - 1, y2 - y1 - 1)
+         CenterString(win, (x1 + x2) / 2, (y1 + y2) / 2, char(16 * i + j))
+         }
+      }
+   return
+end
+
+
+#  revent(v, e, x, y) -- pass region event to font name vidget
+
+procedure revent(v, e, x, y)
+   return VEvent(vidgets["fontname"], e, x, y)
+end
+
+
+#  other(e) -- pass event outside of regions to font name vidget
+#
+#  Also handles meta-Q event rejected by other vidgets.
+
+procedure other(e)
+   if &meta & map(e) == "q" then
+      exit()
+   return VEvent(vidgets["fontname"], e, &x, &y)
+end
+
+
+#  quit() -- process QUIT button
+
+procedure quit()
+   exit()
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=512,640", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,512,640:",],
+   ["fontname:Text::51:5,616,444,19:font name: \\=",setfont],
+   ["quit:Button:regular::471,615,35,20:QUIT",quit],
+   ["subtitle:Rect:invisible::7,31,496,25:",revent],
+   ["title:Rect:invisible::7,6,496,25:",revent],
+   ["region:Rect:sunken::8,56,492,553:",revent],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/fractclr.icn b/ipl/gprogs/fractclr.icn
new file mode 100644
index 0000000..fa2686e
--- /dev/null
+++ b/ipl/gprogs/fractclr.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     fractclr.icn
+#
+#	Subject:  Program to map Fractint color maps to Icon color lists
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 1, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   This program converts Fractint .map files to lists of Icon colors.
+#
+############################################################################
+
+procedure main()
+   local line, output
+
+   while line := read() do
+      line ? {
+         tab(upto(&digits))
+         writes(tab(many(&digits)) * 256, ",")
+         tab(upto(&digits))
+         writes(tab(many(&digits)) * 256, ",")
+         tab(upto(&digits))
+         writes(tab(many(&digits)) * 256)
+         if not pos(0) then write(output, "\t", tab(0))
+         else write(output)
+         }
+
+end
diff --git a/ipl/gprogs/fractlin.icn b/ipl/gprogs/fractlin.icn
new file mode 100644
index 0000000..c9a3639
--- /dev/null
+++ b/ipl/gprogs/fractlin.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#       File:     fractlin.icn
+#
+#	Subject:  Program to demonstrate fractal lines
+#
+#	Author:   Stephen Wampler
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program shows how fractal lines work.
+#
+#	See the procedure 'helpmsg' for command line options
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#	Links: glib, wopen
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local nextarg, arg, i
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       }
+
+    win := WOpen("label=Fractal Lines", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+
+    every  i := 1 to 10 do {
+       fract_line(Window, point(0.25,0.25), point(0.50,0.67), i/10.0)
+       fract_line(Window, point(0.50,0.67), point(0.75,0.25), i/10.0)
+       fract_line(Window, point(0.75,0.25), point(0.25,0.25), i/10.0)
+       }
+
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Fract")
+   return
+end
+
diff --git a/ipl/gprogs/fstarlab.icn b/ipl/gprogs/fstarlab.icn
new file mode 100644
index 0000000..e9a767f
--- /dev/null
+++ b/ipl/gprogs/fstarlab.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     fstarlab.icn
+#
+#	Subject:  Program to draw fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws fractal "stars".  For a discussion of fractal
+#  stars, see
+#
+#	Fractals; Endlessly Repeated Geometrical Figures, Hans Lauwerier,
+#	Princeton University Press, 1991, pp. 72-77.
+#
+#  and
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 55-63.
+#	
+#  The window is square.  The window size can be given on the command line,
+#  default 600.
+#
+#  The present user interface is crude.  To see all the fractal stars
+#  that are provided by default, type
+#
+#	all
+#
+#  from standard input.  After each star is drawn, the program waits
+#  for an event before going on to the next star.
+#
+#  Alternatively, a single star can be drawn by typing its name preceded
+#  by an equals sign.  The names are fstar01 through fstar13.  For example,
+#
+#	=fstar09
+#
+#  draws the ninth star.
+#
+#  In future extensions, provision will be made for user-defined stars.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  drawlab, fstars, fstartbl
+#
+############################################################################
+
+link drawlab
+link fstars
+link fstartbl
+
+global size
+
+procedure main(argl)
+
+   size := integer(argl[1]) | 600
+
+   drawlab(fstar, fstartbl, "fractal stars")
+
+end
diff --git a/ipl/gprogs/gallery.icn b/ipl/gprogs/gallery.icn
new file mode 100644
index 0000000..4dcd0a7
--- /dev/null
+++ b/ipl/gprogs/gallery.icn
@@ -0,0 +1,545 @@
+############################################################################
+#
+#	File:     gallery.icn
+#
+#	Subject:  Program to display many images at once
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 3, 2005
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  gallery [-{whs}nnn] [-{rmtud}] file...
+#
+#  Gallery displays multiple images in a single window.  The images
+#  are shrunken by resampling and tiled in columns or rows.
+#
+#  GIF and XPM format images are always supported.  JPEG format is
+#  supported when built by Jcon.  JPEG, PPM, TIFF, PNG, and RLE formats
+#  are also available under Unix if the necessary conversion utilities
+#  are available in the shell search path.
+#
+#  When the window fills, diagonal lines in the extreme corners of the
+#  window indicate that you can press Enter for the next screenful.
+#  Solid triangles appear when there are no more images; press Q to exit.
+#
+#  At either of those pauses, pressing 'S' brings up a dialog for saving
+#  a snapshot of the window.  Clicking the left mouse button on an
+#  image displays a popup window with information about the image.  A
+#  second click dismisses the popup, as does the space bar or Enter key.
+#  The right mouse button activates the same popup momentarily until
+#  the button is released.
+#
+#  -wnnn sets the maximum width for displaying an image;
+#  -hnnn sets the maximum height.  -snnn sets both.
+#  By default, sizes are chosen automatically, subject to a minimum
+#  size of 32x32, to allow all images to fit in a single window.
+#
+#  -r arranges images in rows instead of columns.
+#  -m maximizes the window size before displaying images.
+#  -t trims file names of leading path components and extensions.
+#  -u shows images completely unlabeled.
+#  -d prints some debugging information.
+#
+#  The standard Window() options are accepted and can be used to
+#  set the window size and other parameters.  A default gamma value
+#  of 1.0 can be changed by using (e.g.) "-A gamma=1.6".
+#
+#  -cn and -gn options, which formerly selected a color palette,
+#  are now ignored.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor, interact, options, io, random, cfunc
+#
+############################################################################
+
+
+#  TO DO:
+#
+#  improve prompts -- something more obvious & intuitive
+
+
+link graphics
+link imscolor
+link interact
+link options
+link io
+link random
+
+
+$define Gap 4			# gap between images
+$define MinWidth 32		# minimum width if auto-scaled
+$define MinHeight 32		# minimum height if auto-scaled
+
+
+record imrec(win, fullw, fullh)
+record area(fname, x, y, w, h, iw, ih)
+
+global opts			# command options
+global tempname			# temporary file name
+
+global ww, wh, fh, fw		# window dimensions
+global maxw, maxh		# maximum size of displayed image
+
+global areas			# areas used for display
+
+
+
+procedure main(args)
+   local cw, ch, bigh, bigw, x, y, w, h, gg, aspr, aspmax, horz
+   local fname, label, f, tw, s, nchars, nlines, img, imwin, e
+
+   # generate a random name for the temporary file
+   randomize()
+   tempname := "/tmp/gal" || right(?99999, 5, "0") || ".tmp"
+
+   # open the window and process options
+   Window("size=800,500", "bg=pale gray", "font=sans,8", "gamma=1.0", args)
+   opts := options(args, "g+c+w+h+s+rmtud")
+   if \opts["m"] then
+      WAttrib("canvas=maximal")
+   if *args = 0 then
+      stop("usage: ", &progname, " [-{gc}n] [-{whd}nnn] [-{mtv}] file...")
+
+   # allow user resizing of window
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   # record window dimensions
+   ww := WAttrib("width")
+   wh := WAttrib("height")
+   if \opts["u"] then
+      fh := 0
+   else
+      fh := WAttrib("fheight")
+   fw := WAttrib("fwidth")
+   maxw := \opts["w"] | \opts["s"] | 2 * \opts["h"]
+   maxh := \opts["h"] | \opts["s"] | 2 * \opts["w"]
+
+   # If no image size specified, try to guess to fill the window
+   if /maxw then
+      layout(*args)
+
+   aspmax := real(maxw) / real(maxh)
+
+   # Display the files.
+   x := y := Gap
+   bigw := bigh := 0
+   areas := list()
+   every fname := !args do {
+
+      close(\f)
+      close(\imwin)
+      f := imwin := &null
+
+      # Check for an interrupt
+      while *Pending() > 0 do
+         if Event() === QuitEvents() then
+            return
+
+      # Get the next file and translate its image.
+      f := open(fname) |
+         { write(&errout, fname, ": can't open"); next }
+
+      # Read the image, full sized, into a scratch canvas
+      if not (img := rdimage(fname, f, maxw, maxh)) then
+         { write(&errout, fname, ": can't decode"); next }
+      imwin := img.win
+
+      # Scale the image to the desired size
+      w := WAttrib(imwin, "width")
+      h := WAttrib(imwin, "height")
+      aspr := real(w) / real(h)
+      if w > maxw | h > maxh then {
+         if aspr > aspmax then {
+            w := maxw
+            h := maxw / aspr
+            }
+         else {
+            w := maxh * aspr
+            h := maxh
+            }
+         w <:= 1
+         h <:= 1
+         Zoom(imwin, , , , , , , w, h)
+         }
+
+      # Trim the file name if so requested.
+      if \opts["t"] then
+         fname ? {
+            while tab(upto('/') + 1)
+            ="cache"
+            label := tab(upto('.') | 0)
+            }
+      else
+         label := fname
+
+      # Calculate the area needed for display
+      cw := w					# cell width
+      if /opts["u"] then
+         cw <:= TextWidth(label)		# ensure room for label
+      ch := h + fh				# cell height
+
+      # Place the new image on a new row or new window if needed.
+      if x + cw > ww | y + ch > wh then {	# if row or column is full
+
+         if /opts["r"] then {
+            x +:= bigw + Gap			# start new column
+            y := Gap
+            bigw := 0
+            }
+         else {
+            x := Gap				# start new row
+            y +:= bigh + Gap
+            bigh := 0
+            }
+
+         if x + cw > ww | y + ch > wh then {
+            # no room for new row or column
+            pause()				# wait for OK
+            EraseArea()				# clear the window
+            ww := WAttrib("width")
+            wh := WAttrib("height")
+            x := y := Gap
+            bigw := bigh := 0
+            areas := list()
+            }
+         }
+
+      # Draw the image and its label.
+      CopyArea(imwin, &window, 0, 0, w, h, x, y)
+      if /opts["u"] then
+         DrawString(x, y + h + fh - WAttrib("descent"), label)
+
+      # Record the space it occupies
+      put(areas, area(fname, x - Gap / 2, y - Gap / 2, w + Gap, h + fh + Gap,
+         img.fullw, img.fullh))
+
+      # Move on to next position.
+      if /opts["r"] then
+         y +:= ch + Gap
+      else
+         x +:= cw + Gap
+      bigh <:= ch
+      bigw <:= cw
+      }
+
+   # All images have been displayed.  Wait for "q" before exiting.
+   close(\f)
+   close(\imwin)
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+   gg := 2 * Gap - 1
+   FillPolygon(0, 0, 0, gg - 1, gg - 1, 0)
+   FillPolygon(0, h, 0, h - gg, gg - 1, h - 1)
+   FillPolygon(w, 0, w - gg, 0, w - 1, gg - 1)
+   FillPolygon(w, h, w - gg, h - 1, w - 1, h - gg)
+
+   while e := Event() do case e of {		# wait for event
+      QuitEvents():		exit()		# quit on "q" etc
+      !"sS":			snapshot()	# save window shapshot
+      &lpress | &rpress:	info(e)		# display info about image
+      }
+end
+
+
+
+#  layout(n) -- calculate layout for n images
+
+$define GuessAspect 1.5		# aspect ratio guess used for layout
+
+procedure layout(n)
+   local aspf, nhigh, nwide
+
+   aspf := real(ww) / real(wh) / GuessAspect
+   nhigh := integer(sqrt(n / aspf) + 0.5)
+   nhigh <:= 1
+   nwide := (n + nhigh - 1) / nhigh
+   maxw := ((ww - Gap) / nwide) - Gap
+   maxh := ((wh - Gap) / nhigh) - Gap - fh
+   maxw <:= MinWidth
+   maxh <:= MinHeight
+
+   if \opts["d"] then
+      write(&errout, "npix=", n, " aspf=", aspf, " nhigh=", nhigh,
+         " nwide=", nwide, " maxh=", maxh, " maxw=", maxw)
+   return
+end
+
+
+
+## pause() -- wait for clearance to start a new window
+
+procedure pause()
+   local w, h, gg, e
+
+   while *Pending() > 0 do		# consume and ignore older events
+      Event()
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+   gg := 2 * Gap - 1
+   DrawLine(0, gg - 1, gg - 1, 0)	# draw diagonals to indicate pause
+   DrawLine(0, h - gg, gg - 1, h - 1)
+   DrawLine(w - gg, 0, w - 1, gg - 1)
+   DrawLine(w - gg, h - 1, w - 1, h - gg)
+
+   while e := Event() do case e of {		# wait for event
+      QuitEvents():		exit()		# quit on "q" etc
+      !" \t\r\n":		break		# continue on "\r" etc
+      !"sS":			snapshot()	# save window shapshot
+      &lpress | &rpress:	info(e)		# display info about image
+      }
+   return
+end
+
+
+
+## info(event) -- display info about image under the mouse
+
+$define InfoMargin 10	# margin around image
+$define InfoHeight 80	# text area height
+$define InfoWidth 300	# text area width
+
+procedure info(e)
+   local a, w, h, wmin, wmax, hmax
+
+   wmin := InfoWidth + 2 * InfoMargin
+   wmax := WAttrib("width") - 4 * InfoMargin
+   hmax := WAttrib("height") - 5 * InfoMargin - InfoHeight
+
+   every a := !areas do
+      if InBounds(a.x, a.y, a.w, a.h) then {
+         w := a.iw
+         h := a.ih
+         if w >:= wmax then
+            h := a.ih * w / a.iw
+         if h >:= hmax then
+            w := a.iw * h / a.ih
+         wmin <:= w + 2 * InfoMargin
+         Popup(, , wmin, h + InfoHeight + 3 * InfoMargin, popinfo, a, e, w, h)
+         break
+         }
+   return
+end
+
+
+
+##  popinfo(area, event, w, h) -- display info in the popup
+#
+#   if event was &rpress, wait for &rrelease
+#   otherwise wait for &lpress, Enter, or space to dismiss
+
+procedure popinfo(a, e, w, h)
+   local f, i, n, x, y
+
+   f := open(a.fname)
+   seek(f, 0)
+   n := where(f)
+   seek(f, 1)
+   i := rdimage(a.fname, f, w, h) | fail
+
+   x := (WAttrib("clipw") - w) / 2
+   y := InfoMargin
+   Zoom(i.win, &window, , , , , x, y, w, h)
+
+   Font("sans,bold,12")
+   WAttrib("leading=16")
+   GotoXY(0, InfoMargin + h + InfoMargin + WAttrib("ascent"))
+   WWrite("    ", a.fname)
+   WWrite("    ", a.iw, " x ", a.ih, " pixels")
+   WWrite("    ", n, " bytes")
+   WWrite("    ", iformat(f), " format")
+
+   if e === &rpress then
+      until Event() === &rrelease		# dismiss upon button release
+   else {
+      until Event() === &lrelease		# consume matching release
+      until Event() === &lrelease | !" \n\r"	# wait for dismissal
+   }
+
+   WClose(i.win)
+   return
+end
+
+
+
+## iformat(f) -- return image format of file f
+
+procedure iformat(f)
+   local s
+
+   seek(f, 1)
+   s := reads(f, 1024) | fail
+   seek(f, 1)
+   s ? {
+      if ="GIF8"		then return "GIF"
+      if ="\x89PNG"		then return "PNG"
+      if ="\xFF\xD8\xFF"	then return "JPEG"
+      if ="MM\x00\x2A"		then return "TIFF"
+      if ="II\x2A\x00"		then return "TIFF"
+      if =("P1" | "P4")		then return "PBM"
+      if =("P2" | "P5")		then return "PGM"
+      if =("P3" | "P6")		then return "PPM"
+      if ="\x52\xCC"		then return "RLE"
+      if ="BM"			then return "BMP"
+      if find("XPM")		then return "XPM"
+      fail
+      }
+end
+
+
+
+## rdimage(fname, f, maxw, maxh) -- read image into scratch window
+
+procedure rdimage(fname, f, maxw, maxh)
+   local iwin
+
+   case iformat(f) of {
+      "GIF" | "XPM":		iwin := load(fname)
+      "PNG":			iwin := convert(fname, "pngtopnm")
+      "TIFF":			iwin := convert(fname, "tifftopnm")
+      "PBM" | "PGM" | "PPM":	iwin := convert(fname, "cat")
+      "RLE":			iwin := convert(fname, "rletopnm")
+      "BMP":			iwin := convert(fname, "bmptoppm")
+      "JPEG":			return jpegread(fname, maxw, maxh)
+      }
+
+   return imrec(\iwin, WAttrib(iwin, "width"), WAttrib(iwin, "height"))
+end
+
+
+
+## convert(fname, utilname) -- read image by converting through PPM to GIF
+
+procedure convert(fname, utilname)
+   needprog(utilname) | fail
+   needprog("ppmquant") | fail
+   needprog("ppmtogif") | fail
+   return mkgif(utilname ||
+      " 2>/dev/null | ppmquant 256 2>/dev/null | ppmtogif 2>/dev/null",
+      fname)
+end
+
+
+
+## mkgif(cmd, fname) -- run filter to produce GIF file
+
+procedure mkgif(cmd, fname)
+   local win, f
+
+   remove(tempname)
+   cmd := "<\"" || fname || "\" " || cmd || " >" || tempname
+   if \opts["d"] then
+      write(&errout, "+ ", cmd)
+   system(cmd)
+   f := open(tempname) | fail
+   win := load(tempname)
+   close(f)
+   remove(tempname)
+   return \win
+end
+
+
+
+## jpegread(fname, maxw, maxh) -- read JPEG image
+
+procedure jpegread(fname, maxw, maxh)
+   local scale, iwin, irec
+
+   $ifdef _JAVA
+      iwin := load(fname)
+      return imrec(\iwin, WAttrib(iwin, "width"), WAttrib(iwin, "height"))
+   $else
+      needprog("djpeg") | fail
+      irec := imrec()
+      if jsize(irec, fname) then
+         scale := jscale(irec, \maxw, \maxh) | ""
+      else
+         scale := ""
+      irec.win := mkgif("djpeg " || scale || " -g 2>/dev/null", fname) | fail
+      /irec.fullw := WAttrib(iwin, "width")
+      /irec.fullh := WAttrib(iwin, "height")
+      return irec
+   $endif
+
+
+end
+
+
+
+## jsize(irec, fname) -- set fullw and fullh fields for JPEG image
+
+procedure jsize(irec, fname)
+   local s, p, line, w, h
+
+   s := ""
+   p := open("rdjpgcom -verbose " || fname, "p") | fail
+   while line := read(p) do line ? {
+      ="JPEG image is "				| next
+      w := tab(many(&digits))			| next
+      ="w * "					| next
+      h := tab(many(&digits))			| next
+      ="h, "					| next
+      close(p)
+      irec.fullw := integer(w)
+      irec.fullh := integer(h)
+      return
+      }
+   close(p)
+   fail
+end
+
+
+
+## jscale(irec, maxw, maxh) -- determine scaling for faster JPEG reading
+
+procedure jscale(irec, maxw, maxh)
+   local m
+
+   m := irec.fullw / maxw
+   m <:= irec.fullh / maxh
+   if m >= 8 then return "-scale 1/8"
+   if m >= 4 then return "-scale 1/4"
+   if m >= 2 then return "-scale 1/2"
+   return ""
+end
+
+
+
+
+
+## load(fname) -- read image using WOpen
+
+procedure load(fname)
+   return WOpen("canvas=hidden", "bg=" || WAttrib("bg"),
+      "gamma=" || WAttrib("gamma"), "image=" || fname)
+end
+
+
+
+## needprog(s) -- check for presence of program s in $PATH
+#
+#  Fails if the program is not available.
+#  Issues a diagnostic only once per program.
+
+procedure needprog(s)
+   static ptable
+   initial ptable := table()
+
+   /ptable[s] := pathfind(s, map(getenv("PATH"), ":", " ")) |
+      (write(&errout, "can't find program \"", s, "\" in $PATH") & "")
+   return "" ~=== ptable[s]
+end
diff --git a/ipl/gprogs/gamma.icn b/ipl/gprogs/gamma.icn
new file mode 100644
index 0000000..0d9a57d
--- /dev/null
+++ b/ipl/gprogs/gamma.icn
@@ -0,0 +1,220 @@
+############################################################################
+#
+#	File:     gamma.icn
+#
+#	Subject:  Program to perform gamma correction on images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 5, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program allows changing the gamma correction for images.  It can
+#  be used, for example, to desaturate images for use as backgrounds.
+#  Note:  Fully saturated nd fully unsaturated colors are not affected by
+#  gamma correction.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, vfilter, vsetup
+#
+############################################################################
+
+link interact
+link vfilter
+link vsetup
+
+global continuous_vidget	# continuous update toggle
+global gamma			# current gamma value
+global gamma_vidget		# gamma vidget
+global default_gamma		# original gamma value
+global name			# name of current image file
+global pane			# window for current image
+global vidgets			# table of vidgets
+
+
+
+procedure main()
+
+   vidgets := ui()
+
+   continuous_vidget := vidgets["continuous"]
+   gamma_vidget := vidgets["gamma"]
+
+   VSetState(continuous_vidget, "1")
+
+   default_gamma := WAttrib("gamma")
+
+   set_gamma(default_gamma)
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+procedure continuous_cb(vidget, value)
+
+   if \value then VSetFilter(gamma_vidget, &null) else
+      VSetFilter(gamma_vidget, "1")
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "load @L" :  load_image()
+      "quit @Q" :  exit()
+      "save @S" :  save_image()
+      }
+
+   return
+
+end
+
+procedure gamma_cb(vidget, value)
+
+   set_gamma(10.0 ^ value)
+
+   return
+
+end
+
+procedure load_image()
+
+   WClose(\pane)
+
+   repeat {
+      if OpenDialog("Load image file:") == "Cancel" then fail
+      pane := WOpen("label=" || dialog_value, "image=" || dialog_value,
+         "gamma=" || gamma) | {
+            Notice("Cannot open image file.")
+            next
+            }
+      name := dialog_value
+      Raise()
+      return
+      }
+
+end
+
+procedure reset_cb()
+
+   set_gamma(default_gamma)
+
+end
+
+procedure save_image()
+
+   WAttrib(\pane, "gamma=" || default_gamma) | {
+      Notice("No image loaded.")
+      fail
+      }
+   snapshot(pane)
+   WAttrib(pane, "gamma=" || gamma)
+
+   return
+
+end
+
+procedure set_cb()
+
+   repeat {
+      if OpenDialog("Set gamma value:", gamma, 10) == "Cancel" then fail
+      if 0.0 <= numeric(dialog_value) <= 100.0 then {
+         set_gamma(dialog_value)
+         return
+         }
+      else {
+         Notice("Invalid gamma value.")
+         next
+         }
+      }
+
+end
+
+procedure set_gamma(value)
+
+   gamma := value
+
+   WAttrib(\pane, "gamma=" || gamma)
+   VSetState(gamma_vidget, log(value, 10))
+   show_gamma()
+   ReadImage(\pane, name)
+   Raise()
+
+   return
+
+end
+
+procedure shortcuts(value)
+
+   if &meta then case map(value) of {
+      "l" :  load_image()
+      "q" :  exit()
+      "r" :  set_gamma(default_gamma)
+      "s" :  save_image()
+      }
+
+   return
+
+end
+
+procedure show_gamma()
+   static old_gamma, x, y
+
+   initial {
+      old_gamma := ""
+      x := vidgets["show_gamma"].ax
+      y := vidgets["show_gamma"].ay
+      }
+
+   WAttrib("drawop=reverse")
+   DrawString(x, y, old_gamma)
+   DrawString(x, y, gamma)
+   WAttrib("drawop=copy")
+
+   old_gamma := gamma
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=337,210", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,337,210:",],
+   ["10:Label:::109,97,21,13:1.0",],
+   ["20:Label:::193,97,28,13:10.0",],
+   ["3:Label:::23,97,21,13:0.1",],
+   ["continuous:Button:regular:1:12,120,126,20:continuous update",continuous_cb],
+   ["file:Menu:pull::0,2,36,21:File",file_cb,
+      ["load @L","save @S","quit @Q"]],
+   ["gamma:Scrollbar:h::12,62,305,16:-1.0,2.0,2.0",gamma_cb],
+   ["glabel:Label:::102,37,112,13:gamma correction",],
+   ["label1:Label:::276,97,35,13:100.0",],
+   ["label2:Label:::117,162,56,13:gamma = ",],
+   ["line1:Line:::0,23,336,23:",],
+   ["line2:Line:::34,80,34,90:",],
+   ["line3:Line:::209,80,209,90:",],
+   ["line4:Line:::121,80,121,90:",],
+   ["line5:Line:::295,80,295,90:",],
+   ["reset:Button:regular::57,159,42,20:reset",reset_cb],
+   ["set:Button:regular::12,159,35,20:set",set_cb],
+   ["show_gamma:Button:regularno::179,174,35,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/gif2blp.icn b/ipl/gprogs/gif2blp.icn
new file mode 100644
index 0000000..ff603ed
--- /dev/null
+++ b/ipl/gprogs/gif2blp.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     gif2blp.icn
+#
+#	Subject:  Program to convert B&W GIF to a BLP
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Assumes any non-black pixel is white.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patxform, wopen
+#
+############################################################################
+
+link patxform
+link wopen
+
+procedure main(args)
+   local width, height, row, p, y, rows
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   rows := []
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      put(rows, row)
+      }
+
+   write(rows2pat(rows))
+
+end
diff --git a/ipl/gprogs/gif2isd.icn b/ipl/gprogs/gif2isd.icn
new file mode 100644
index 0000000..3eeac2b
--- /dev/null
+++ b/ipl/gprogs/gif2isd.icn
@@ -0,0 +1,131 @@
+############################################################################
+#
+#	File:     gif2isd.icn
+#
+#	Subject:  Program to produce a ISD from bi-level image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 17, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes a B&W GIF image whose name is given on the
+#  command line and writes an ISD for a draft to standard output.
+#
+#  If the GIF is not strictly B&W, non-black pixels are assumed to
+#  be white.
+#
+############################################################################
+#
+#  Links:  graphics, weavutil, xcode
+#
+############################################################################
+
+link graphics
+link weavutil
+link xcode
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, y, width, height
+   local shafts, treadles, i, tie_line, row, treadle, draft, p
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   rows := []			# start with empty list
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      put(rows, row)
+      }
+
+   cols := rot(rows)		# rotate to get columns
+
+   treadles := examine(rows)	# get treadles
+   shafts := examine(cols)	# get shafts
+
+   treadling := []		# construct treadling sequence
+   every put(treadling, treadles[!rows])
+
+   threading := []		# construct threading sequence
+   every put(threading, shafts[!cols])
+
+   tieup := []
+
+   every row := key(treadles) do {		# get unique rows
+      treadle := treadles[row]			# assigned treadle number
+      tie_line := repl("0", *shafts)		# blank tie-up line
+      every i := 1 to *row do			# go through row
+         if row[i] == "1" then			#    if warp on top
+            tie_line[threading[i]] := "1"	#       mark shaft position
+      put(tieup, tie_line)		# add line to tie-up
+      }
+
+   draft := isd("gif2isd")
+
+   draft.threading := threading
+   draft.treadling := treadling
+   draft.shafts := *shafts
+   draft.treadles := *treadles
+   draft.width := *shafts
+   draft.height := *treadles
+   draft.tieup := tieup
+   draft.color_list := ["black", "white"]
+   draft.warp_colors := list(*threading, 1)
+   draft.weft_colors := list(*treadling, 2)
+
+   write(xencode(draft))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure examine(array)
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/gif2rows.icn b/ipl/gprogs/gif2rows.icn
new file mode 100644
index 0000000..ff93154
--- /dev/null
+++ b/ipl/gprogs/gif2rows.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     gif2rows.icn
+#
+#	Subject:  Program to convert B&W GIF to 0/1 rows
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 11, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  AD HOC.  Assumes any non-black pixel is white.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local width, height, row, p, y
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      write(row)
+      }
+
+end
diff --git a/ipl/gprogs/gif2wif.icn b/ipl/gprogs/gif2wif.icn
new file mode 100644
index 0000000..37678b1
--- /dev/null
+++ b/ipl/gprogs/gif2wif.icn
@@ -0,0 +1,196 @@
+############################################################################
+#
+#	File:     gif2wif.icn
+#
+#	Subject:  Program to produce a WIF from black & white image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 7, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the name of a GIF file for a black & white image
+#  and outputs a WIF for a corresponding draft.  If the GIF is not
+#  strictly black & white, all non-black pixels are interpreted as
+#  white.
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+
+############################################################################
+
+link graphics
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, y, width, height
+   local shafts, treadles, i, tie_line, row, treadle, draft, p
+
+   WOpen("image=" || args[1], "canvas=hidden") |
+      stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   rows := []			# start with empty list
+
+   every y := 0 to height - 1 do {
+      row := ""
+      every p := Pixel(0, y, width, 1) do
+         if ColorValue(p) == "0,0,0" then row ||:= "1"
+            else row ||:= "0"
+      put(rows, row)
+      }
+
+   cols := rot(rows)		# rotate to get columns
+
+   treadles := examine(rows)	# get treadles
+   shafts := examine(cols)	# get shafts
+
+   treadling := []		# construct treadling sequence
+   every put(treadling, treadles[!rows])
+
+   threading := []		# construct threading sequence
+   every put(threading, shafts[!cols])
+
+   tieup := table()
+
+   every row := key(treadles) do {		# get unique rows
+      treadle := treadles[row]			# assigned treadle number
+      tie_line := repl("0", *shafts)		# blank tie-up line
+      every i := 1 to *row do			# go through row
+         if row[i] == "1" then			#    if warp on top
+            tie_line[threading[i]] := "1"	#       mark shaft position
+      tieup[treadle] := tie_line		# add line to tie-up
+      }
+
+   #  Now output the WIF.
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=gif2wif.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=2")
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=example")
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[WEAVING]")
+   write("Shafts=", *shafts)
+   write("Treadles=", *treadles)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *threading)
+   write("Units=Decipoints")
+   write("Thickness=10")
+   write("Color=1")
+
+   write("[WEFT]")
+   write("Threads=", *treadling)
+   write("Units=Decipoints")
+   write("Thickness=10")
+   write("Color=2")
+
+   write("[COLOR TABLE]")
+   write("1=0,0,0")
+   write("2=65535,65535,65535")
+
+   write("[THREADING]")
+   every i := 1 to *threading do
+      write(i, "=", threading[i])
+
+   write("[TREADLING]")
+   every i := 1 to *treadling do
+      write(i, "=", treadling[i])
+
+   write("[TIEUP]")
+   every i := 1 to *tieup do
+      write(i, "=", tromp(tieup[i]))
+
+end
+
+#procedure tromp(treadle)
+#   local result
+#
+#   result := ""
+#   
+#   treadle ? {
+#      every result ||:= upto("1") || ","
+#      }
+#
+#   return result[1:-1]
+#
+#end
+#
+procedure tromp(treadle)
+   local result, i
+
+   result := ""
+   
+   every i := 1 to *treadle do
+      if treadle[i] == 1 then result ||:= i || ","
+
+   return result[1:-1]
+
+end
+
+procedure examine(array)
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
+
+procedure rot(rows)
+   local cols, row, grid, i
+
+   cols := list(*rows[1], "")
+
+   every row := !rows do {
+      i := 0
+      every grid := !row do
+         cols[i +:= 1] := grid || cols[i]
+      }
+
+   return cols
+
+end
diff --git a/ipl/gprogs/gifs2pdb.icn b/ipl/gprogs/gifs2pdb.icn
new file mode 100644
index 0000000..f84bf0d
--- /dev/null
+++ b/ipl/gprogs/gifs2pdb.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     gifs2pdb.icn
+#
+#	Subject:  Program to produce custom palettes from GIF images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 13, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program makes a custom palette database from the colors in GIF
+#  images
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  basename, palettes, wopen, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link wopen
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, name, output, colors, win
+
+   every file := !args do {
+      win := WOpen("image=" || file, "canvas=hidden") | {
+          write(&errout, "*** cannot open image: ", image(file))
+          next
+          }
+      name := basename(file, ".gif")
+      colors := set()
+      every insert(colors, Pixel(win, 0, 0, WAttrib(win, "width"),
+         WAttrib(win, "height")))
+      WClose(win)
+      makepalette(name, sort_colors(colors)) |
+         write(&errout, "*** cannot make palette from ", image(file))
+      }
+
+    xencode(PDB_, &output)
+
+end
diff --git a/ipl/gprogs/giftoims.icn b/ipl/gprogs/giftoims.icn
new file mode 100644
index 0000000..4440b5b
--- /dev/null
+++ b/ipl/gprogs/giftoims.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     giftoims.icn
+#
+#	Subject:  Program to convert GIF files to image strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts GIF images whose names are given on the command
+#  line to image strings as used by DrawImage().
+#
+#  The image strings are written to files with the basenames of the GIF
+#  files and the suffix "ims" or "iml" depending on the output option.
+#
+#  The following options are supported:
+#
+#	-l	write Icon literal instead of plain string; suffix is
+#		  .iml (default .ims).
+#	-i i	make lines of literals at most i characters long
+#	-p s	palette to use; default c1.
+#
+#  For -l, the length refers to the number of characters represented.  If
+#  they require escapes, thea actual line length will be longer.  This is
+#  to prevent errors from trying to continue a string literal in the
+#  middle of an escape sequence.  In addition, three blanks are prepended
+#  to each line and the characters # and $ are escaped to prevent then
+#  from being misinterpreted by Icon's translator.
+#
+#  .iml files are suitable for inclusion in program text, either
+#  directly or by $include.
+#
+#  .ims files are suitable for reading.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, graphics, options, strings
+#
+############################################################################
+
+link basename
+link graphics
+link options
+link strings
+
+procedure main(args)
+   local file, opts, name, output, literal, length, seg, palette, str
+   local suffix
+
+   opts := options(args, "i+lp:")
+
+   literal := opts["l"]
+   length := opts["i"]
+   palette := \opts["p"] | "c1"
+
+   suffix := if \literal then ".iml" else ".ims"
+
+   if not PaletteChars(palette) then
+      stop("*** invalid palette specification")
+
+   every file := !args do {
+      name := basename(file, ".gif") || suffix
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "**** can't open ", file)
+         next
+         }
+      output := open(name, "w") | {
+         write(&errout, "*** can't write to ", name)
+         next
+         }
+      str := Capture(palette)
+      if /literal then writes(output, str)
+      else {
+         if  /length then str ? {
+         length := integer(tab(upto(',')))
+         }
+         str ? {
+            write(output, "   \"", tab(upto(',') + 1), tab(upto(',') + 1), "_")
+            while seg := move(length) do {
+               if pos(0) then write(output, "   ", esc(seg), "\"")
+               else write(output, "   ", esc(seg), "_")
+               }
+            if not pos(0) then write(output, "   ", esc(tab(0)), "\"")
+            }
+         }
+      close(output)
+      WClose()
+      }
+
+end
+
+procedure esc(s)
+
+   s := image(s)
+   s := replace(s, "$", "\\x24")
+   s := replace(s, "#", "\\x23")
+
+   return s[2:-1]
+
+end
diff --git a/ipl/gprogs/giftopat.icn b/ipl/gprogs/giftopat.icn
new file mode 100644
index 0000000..86abe9d
--- /dev/null
+++ b/ipl/gprogs/giftopat.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     giftopat.icn
+#
+#	Subject:  Program to convert GIF image to hex-form pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 29, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program convert GIF images, whose names are given on the command
+#  line to bi-level patterns.  The GIFs are expected to be black and white.
+#  All non-white pixels are treated as black
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imsutils, wopen
+#
+############################################################################
+
+link imsutils
+link wopen
+
+procedure main(args)
+   local file, win
+
+   while file := get(args) do {
+      win := WOpen("image=" || file, "canvas=hidden") | {
+         write(&errout, "cannot open ", file)
+         next
+         }
+      write(pix2pat(win, 0, 0, WAttrib("width"), WAttrib("height")))
+      WClose(win)
+      }
+
+end
diff --git a/ipl/gprogs/gpxtest.icn b/ipl/gprogs/gpxtest.icn
new file mode 100644
index 0000000..e8b8587
--- /dev/null
+++ b/ipl/gprogs/gpxtest.icn
@@ -0,0 +1,743 @@
+############################################################################
+#
+#	File:     gpxtest.icn
+#
+#	Subject:  Program to test graphics procedures
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 1, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program exercises a wide variety of graphics operations.  Several
+#  independent output tests are run in square cells within a window.  The
+#  resulting image can be compared with a standard image to determine its
+#  correctness.  
+#
+#  The "Dialog" button brings up an interactive dialog box test; the
+#  "Quit" button exits the program.
+#
+#  Some variations among systems are expected in the areas of fonts,
+#  attribute values, and availability of mutable colors.  The first test,
+#  involving window resizing, produces results that do not exactly fit the
+#  grid pattern of the other tests; that is also expected.
+#
+#  This program is designed for a color display, but it also works on
+#  monochrome systems.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, dsetup, evmux, graphics
+#
+############################################################################
+
+link button
+link dsetup
+link evmux
+link graphics
+
+
+$define CELL 80				# size of one test "cell"
+$define HALF (CELL / 2)			# half a cell
+$define GAP 10				# gap between cells
+
+$define NWIDE 6				# number of cells across
+$define NHIGH 4 			# number of cells down
+
+$define WIDTH (NWIDE * (CELL + GAP))	# total width
+$define HEIGHT (NHIGH * (CELL + GAP))	# total height
+
+$define ABET "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
+
+
+global cx, cy				# current cell indices
+
+
+##############################  Overall control  ##############################
+
+
+procedure main(args)
+   local x, y
+
+   # Start with a medium window; shrink, test defaults, grow.
+   Window("size=300,300", "bg=light-weak-reddish-yellow", args)
+   VSetFont()
+
+   # The following sequence *should* have no permanent effect
+   WAttrib("drawop=xor", "fillstyle=masked", "pattern=checkers", "linewidth=5")
+   DrawCircle(CELL / 2, CELL / 2, CELL / 3)
+   EraseArea()
+   WAttrib("drawop=copy", "fillstyle=solid", "linewidth=1")
+
+   # Shrink the window, test defaults, grow to final size.
+   deftest()
+   WAttrib("size=" || WIDTH || "," || HEIGHT)
+   WAttrib("width=" || WIDTH)			# should be no-op
+   WAttrib("size=" || WIDTH || "," || HEIGHT)	# should be no-op
+
+   # Make a simple background.
+   if WAttrib("depth") > 1 then
+      Fg("44000,39000,24000")
+   every y := (3 * CELL / 2) to (2 * HEIGHT) by 7 do
+      DrawLine(0, y, 2 * y, 0)
+   Fg("#000")
+
+   # Run a series of tests confined to small, square cells.
+   cx := cy := 0			# current cell (already filled)
+   cell(simple)
+   cell(lines)
+   cell(rects)
+   cell(star)
+   cell(pretzel)
+   cell(spiral)
+   cell(arcs)
+   cell(copying)
+   cell(rings)
+   cell(fontvars)
+   cell(stdfonts)
+   cell(stdpats)
+   cell(patts)
+   cell(attribs)
+   cell(gamma)
+   cell(balls)
+   cell(slices)
+   cell(details)
+   cell(rainbow)
+   cell(whale)
+   cell(cheshire)
+
+   # Use the final cell area for Dialog and Quit buttons.
+   buttonrow(&window, WIDTH - CELL - GAP/2, HEIGHT - GAP / 2, CELL, 2 * GAP,
+      0, - 3 * GAP, "Quit", argless, exit, "Dialog", argless, dltest)
+   quitsensor(&window)
+   sensor(&window, 'Dd', argless, dltest)
+   evmux(&window)
+end
+
+
+## cell(proc) -- run a test in the next available cell
+#
+#  Proc is called with a private graphics context assigned to &window.
+#  Clipping set to cell boundaries and the origin is at the center.
+
+procedure cell(proc)
+   local x, y, stdwin
+
+   if (cx +:= 1) >= NWIDE then {
+      cx := 0
+      cy +:= 1
+      }
+   x := integer((cx + .5) * (CELL + GAP))
+   y := integer((cy + .5) * (CELL + GAP))
+
+   stdwin := &window
+   &window := Clone("dx=" || x, "dy=" || y, "bg=white")
+   ClearOutline(-HALF - 1, -HALF - 1, CELL + 1, CELL + 1)
+   Clip(-HALF, -HALF, CELL, CELL)
+   proc()
+   Uncouple(&window)
+   &window := stdwin
+end
+
+
+##############################  Cell Tests  ##############################
+
+
+## arcs() -- draw a series of arcs forming a tight spiral
+#
+#  Tests DrawCircle with angle limits.
+
+procedure arcs()
+   local r, a, d
+
+   r := 2
+   a := 0
+   d := &pi / 10
+   while r < HALF do {
+      DrawCircle(0, 0, r, a, d)
+      r +:= 1
+      a +:= d
+      d +:= &pi / 40
+      }
+end
+
+
+## attribs() -- test WAttrib().
+#
+#  For each of several attributes we should be able to inquire the current
+#  setting, set it to that value, and get it back again.  If that works,
+#  display some system-dependent attributes in the cell window.
+
+procedure attribs()
+   local alist, afail, n, a, f, cw, ch, cl, v1, v2
+
+   alist := [
+      "fg", "bg", "reverse", "drawop", "gamma", "font", "leading", 
+      "linewidth", "linestyle", "fillstyle", "pattern",
+      "clipx", "clipy", "clipw", "cliph", "dx", "dy",
+      "label", "pos", "posx", "posy", "size", "height", "width", "canvas",
+      "resize", "echo", "cursor", "x", "y", "row", "col", "pointer",
+      "pointerx", "pointery", "pointerrow", "pointercol", 
+      ]
+   afail := []
+
+   every a := \!alist do {
+      v1 := WAttrib(a)		| { put(afail, a); next }
+      WAttrib(a || "=" || v1)	| { put(afail, a || "=" || v1); next }
+      v2 := WAttrib(a)		| { put(afail, a); next }
+      v1 == v2		| { put(afail, a || ": " || v1 || "/" || v2); next }
+      }
+
+   Translate(-HALF, -HALF)
+   GotoRC(1, 1)
+
+   if *afail > 0 then {
+      Font("sans,bold,10")
+      WWrite("FAILED:")
+      every WWrite("  ", !afail)
+      every write(&errout, "WAttrib() failure: ", !afail)
+      fail
+      }
+
+   f := WAttrib("font") | "[FAILED]"
+   cw := WAttrib("fwidth") | "[FAILED]"
+   ch := WAttrib("fheight") | "[FAILED]"
+   cl := WAttrib("leading") | "[FAILED]"
+   Font("sans,10")
+   WWrite("display=", WAttrib("display") | "[FAILED]")
+   WWrite("  (", WAttrib("displaywidth") | "????", "x", 
+      WAttrib("displayheight") | "????", "x", WAttrib("depth") | "??", ")") 
+   every a := "gamma" | "pointer" do
+      WWrite(a, "=", WAttrib(a) | "[FAILED]")
+   WWrite("vfont=", f)
+   WWrite("  (", cw, "x", ch, ", +", cl, ")")
+end
+
+
+## balls() -- draw a grid of spheres
+#
+#  Tests DrawImage using g16 palette.
+
+procedure balls()
+   every DrawImage(-HALF + 2 to HALF by 20, -HALF + 2 to HALF by 20, 
+      " 16 , g16 , FFFFB98788AEFFFF_
+      FFD865554446AFFF FD856886544339FF E8579BA9643323AF_
+      A569DECA7433215E 7569CDB86433211A 5579AA9643222108_
+      4456776533221007 4444443332210007 4333333222100008_
+      533322221100000A 822222111000003D D41111100000019F_
+      FA200000000018EF FFA4000000028EFF FFFD9532248BFFFF")
+end
+
+
+## cheshire() -- cheshire cat display
+#
+#  Tests mutable colors, WDelay, various drawing operations.
+
+procedure cheshire()
+   local face, eyes, grin, i, g
+
+   if (face := NewColor("white")) & 
+   (eyes := NewColor("black")) & (grin := NewColor("black")) then {
+      Fg("gray")
+      FillRectangle(-HALF, -HALF)
+      Fg(face)
+      FillArc(-HALF, .3 * CELL, CELL, -HALF)
+      FillPolygon(0, 0, -.35 * CELL, -.35 * CELL, -.35 * CELL, 0)
+      FillPolygon(0, 0, .35 * CELL, -.35 * CELL, .35 * CELL, 0)
+      Fg(eyes)
+      WAttrib("linewidth=2")
+      DrawCircle(-.18 * CELL, -.0 * CELL, 3, , , .18 * CELL, -.0 * CELL, 3)
+      Fg(grin)
+      DrawCircle(0, -HALF, .7 * CELL, &pi / 3, &pi / 3)
+      WDelay(500)
+      every i := 0 to 30 by 2 do {
+         WDelay(100)
+         g := i * 65535 / 60
+         Color(eyes, g || "," || g || "," || g)
+         g := 65535 - g
+         Color(face, g || "," || g || "," || g)
+         }
+      every i := 0 to 26 by 2 do {
+         WDelay(100)
+         g := i * 65535 / 60
+         Color(grin, g || "," || g || "," || g)
+         }
+      }
+   else {
+      Translate(-HALF + 4, -HALF)
+      GotoRC(1, 1)
+      WWrite("this test\nrequires\nmutable\ncolors")
+      }
+end
+
+
+## copying() -- test CopyArea
+#
+#  Tests hidden canvas, overlapping copies, and generation
+#  of background color for missing source pixels.
+
+procedure copying()
+   local win, o, w, h
+
+   win := WOpen("canvas=hidden", "size=" || CELL || "," || CELL) | {
+      GotoRC(1, 1)
+      WWrite("Can't get\nhidden\ncanvas")
+      fail
+      }
+   every DrawCircle(win, HALF, HALF, HALF - 2 to sqrt(2) * HALF by 3)
+
+   o := 5		# offset for copy
+   w := CELL / 4	# width of square to be copied
+   h := w / 2		# half of that, for centering
+   Bg(win, "black")
+
+   CopyArea(win, -o, -o, w, w, 0, 0)
+   CopyArea(win, HALF - h, -o, w, w, HALF - h, 0)
+   CopyArea(win, CELL + o, -o, -w, w, CELL - w, 0)
+
+   CopyArea(win, -o, HALF - h, w, w, 0, HALF - h)
+   CopyArea(win, CELL + o, HALF - h, -w, w, CELL - w, HALF - h)
+
+   CopyArea(win, -o, CELL + o, w, -w, 0, CELL - w)
+   CopyArea(win, HALF - h, CELL + o, w, -w, HALF - h, CELL - w)
+   CopyArea(win, CELL + o, CELL + o, -w, -w, CELL - w, CELL - w)
+
+   CopyArea(win, o, o, w, w, HALF - w, HALF - w)
+   CopyArea(win, CELL - o, o, -w, w, HALF, HALF - w)
+   CopyArea(win, o, CELL - o, w, -w, HALF - w, HALF)
+   CopyArea(win, CELL - o, CELL - o, -w, -w, HALF, HALF)
+
+   CopyArea(win, &window, , , , , -HALF, -HALF)
+   close(win)
+end
+
+
+## deftest() -- test defaults
+#
+#  Tests x/y/w/h defaulting by adjusting the window size several times.
+#  Also exercises "drawop=reverse" incidentally.
+#
+#  This test must be run first.  It uses the entire window and leaves
+#  results in the first cell.
+
+procedure deftest()
+   WAttrib("drawop=reverse")
+   WAttrib("size=" || CELL || "," || CELL / 2)
+   FillArc()
+   FillArc(, , CELL / 4)
+   FillArc(3 * CELL / 4)
+   WAttrib("height=" || CELL)
+   DrawArc(, CELL / 2)
+   WAttrib("drawop=copy")
+end
+
+
+## details() -- test drawing details
+#
+#  Tests some of the details of filling and stroking.
+
+procedure details()
+   Shade("light gray")
+   FillRectangle()
+
+   WAttrib("linewidth=7", "fg=white")
+   DrawLine(10, 10, 10, 25, 30, 25, 20, 10)
+   WAttrib("linewidth=1", "fg=black")
+   DrawLine(10, 10, 10, 25, 30, 25, 20, 10)
+
+   Fg("white")
+   DrawRectangle(-5, -5, -25, -30)
+   Fg("black")
+   DrawArc(-5, -5, -25, -30)
+
+   Fg("white")
+   FillArc(5, -5, 24, -30)
+   Fg("black")
+   DrawArc(5, -5, 24, -30)
+
+   Shade("light gray")
+   FillCircle(17, -17, 6)
+   Fg("black")
+   DrawCircle(17, -17, 6)
+
+   Fg("white")
+   FillPolygon(-5,20, -17,23, -20,35, -23,23, -35,20, -23,17, -20,5, -17,17)
+   Fg("black")
+   DrawPolygon(-5,20, -17,23, -20,35, -23,23, -35,20, -23,17, -20,5, -17,17)
+end
+
+
+## fontvars() -- test font variations
+#
+#  Tests various font characteristics combined with standard font names.
+#  Also exercises Shade, GoToXY, WWrites.
+
+procedure fontvars()
+   Translate(-HALF + 4, -HALF)
+   Shade("gray")
+   FillRectangle(-4)
+   Shade("black")
+   GotoXY(0, 0)
+   WWrites("\nFonts...")
+   WWrites("\n", if Font("mono,12") then ABET else "no mono 12")
+   WWrites("\n", if Font("serif,italic") then ABET else "no SF ital")
+   WWrites("\n", if Font("sans,bold,18") then ABET else "no SN B 18")
+   WWrites("\n", if Font("fixed") then ABET else "no fixed!") 
+end
+
+
+## gamma() -- test gamma correction
+#
+#  Draws 50%-gray bars with various values of the gamma attribute, beginning
+#  with the system default.  Incidentally tests some font attributes.
+
+procedure gamma()
+   local g
+
+   GotoXY(0, -HALF + WAttrib("leading") - WAttrib("descent"))
+   every g := &null | 1.0 | 1.5 | 2.2 | 3.3 | 5.0 | 7.5 do {
+      Shade("gray")
+      WAttrib("gamma=" || \g)
+      FillRectangle(-4, WAttrib("y") + WAttrib("descent"),
+         -HALF, -WAttrib("leading"))
+      Shade("black")
+      WWrite(WAttrib("gamma"))
+      }
+end
+
+
+## lines() -- test line drawing
+#
+#  Tests proper drawing and joining of lines of various widths.  There
+#  once were problems here in Icon, and there still are in some X servers.
+
+procedure lines()
+   local i, y
+   y := -HALF - 6
+   every WAttrib("linewidth=" || (0 to 4)) do
+      tline(-HALF + 10, y +:= 15)
+end
+
+procedure tline(x, y)
+   DrawLine(x + 1, y, x + 3, y)
+   DrawLine(x - 1, y, x - 3, y)
+   DrawLine(x, y + 1, x, y + 3)
+   DrawLine(x, y - 1, x, y - 3)
+   x +:= 15
+   DrawLine(x - 3, y - 3, x + 3, y - 3)
+   DrawLine(x + 3, y - 3, x + 3, y + 3)
+   DrawLine(x + 3, y + 3, x - 3, y + 3)
+   DrawLine(x - 3, y + 3, x - 3, y - 3)
+   x +:= 15
+   DrawLine(x - 3, y - 3, x + 3, y + 3)
+   DrawLine(x - 3, y + 3, x + 3, y - 3)
+   x +:= 15
+   DrawLine(x, y - 4, x + 4, y)
+   DrawLine(x + 4, y, x, y + 4)
+   DrawLine(x, y + 4, x - 4, y)
+   DrawLine(x - 4, y, x, y - 4)
+   x +:= 15
+   DrawRectangle(x - 4, y - 4, 8, 8)
+end
+
+
+## patts() -- test custom patterns
+#
+#  Tests custom patterns in hex and decimal forms; tests fillstyle=masked.
+
+procedure patts()
+   local i, j, s, w
+
+   WAttrib("linewidth=4")
+   DrawCircle(0, 0, 0.38 * CELL)	# circle should persist after patts
+   WAttrib("linewidth=1")
+   Translate(-HALF, -HALF)
+   w := (CELL + 2) / 3;
+
+   WAttrib("fillstyle=masked")
+   s := ["8,#01552B552B552BFF", "8,#020E070420E07040",
+      "8,31,14,68,224,241,224,68,14", "8,#2020FF020202FF20", "4,#5A5A",
+      "8,#0ABBA0BE82BAAAEA", "8,#E3773E383E77E383", "8,#4545C71154547C11",
+      "8,#FF7F3F1F0F070301"]
+
+   every i := 0 to 2 do
+      every j := 0 to 2 do {
+         WAttrib("pattern=" || s[3 * i + j + 1])
+         FillRectangle(w * j, w * i, w, w)
+         }
+end
+
+
+## pretzel() -- draw a pretzel
+#
+#  Tests DrawCurve.
+
+procedure pretzel()
+   WAttrib("linewidth=3")
+   DrawCurve(20, -20, -5, 0, 20, 20, 35, 0, 0,
+      -20, -35, 0, -20, 20, 5, 0, -20, -20)
+end
+
+
+## rainbow() -- draw a rainbow
+#
+#  Tests several color naming variations.
+
+procedure rainbow()
+   local r, c, l
+
+   Shade("moderate blue-cyan")
+   FillRectangle()
+   WAttrib("fillstyle=solid")
+   r := 20
+   l := ["pink", "pale orange", "light yellow", "pale green", "pale blue",
+         "light bluish violet", " pale violet"]
+   WAttrib("linewidth=3")
+   every Fg(!l) do
+      DrawCircle(0, 20, r +:= 3, 0, -&pi)
+end
+
+
+## rects() -- draw rectangles
+#
+#  Tests rectangles specified with positive & negative width & height.
+
+procedure rects()
+   local r, a
+
+   WAttrib("drawop=reverse")
+   r := HALF
+   every a := 1 to 19 by 2 do
+      DrawRectangle(0, 0, r * cos(0.33 * a), r * sin(0.33 * a))
+end 
+
+
+## rings() -- draw a pile of rings
+#
+#  Tests linewidth and DrawCircle in combination.
+
+procedure rings()
+   local x, y
+   Translate(-HALF, -HALF)
+   FillRectangle()
+   every 1 to 15 do {
+      x := ?CELL
+      y := ?CELL
+      WAttrib("fg=black", "linewidth=5")
+      DrawCircle(x, y, 30)		# draw ring in black
+      WAttrib("fg=white", "linewidth=3")
+      DrawCircle(x, y, 30)		# color with white band
+      }
+end
+
+
+## simple() -- an easy first test
+#
+#  Tests DrawString, DrawCircle, FillRectangle, EraseArea, linestyles.
+
+procedure simple()
+   DrawCircle(0, 0, CELL / 3)
+   DrawString(-HALF + 4, -HALF + 12, "hello,")
+   DrawString(-HALF + 4, -HALF + 25, "world")
+   FillRectangle(0, 0)
+   EraseArea(10, 4, CELL / 5, CELL / 3)
+   WAttrib("linestyle=dashed")
+   DrawLine(HALF - 3, HALF, HALF - 3, -HALF)
+   WAttrib("linestyle=striped")
+   DrawLine(HALF - 6, HALF, HALF - 6, -HALF)
+end
+
+
+## slices() -- draw a pie with different-colored slices
+#
+#  Tests RandomColor, Shade, FillArc.
+
+procedure slices()
+   local n, a, da, ov
+
+   n := 10
+   da := 2 * &pi / n			# change in angle
+   a := -&pi / 2 - da			# current angle
+   ov := &pi / 1000			# small overlap
+
+   FillRectangle(-HALF, -HALF)
+   every 1 to n do {
+      Shade(RandomColor())
+      FillArc(-HALF, -CELL / 3, CELL, 2 * CELL / 3, a +:= da, da + ov)
+      }
+end
+
+
+## spiral() -- draw a spiral, one point at a time
+#
+#  Tests DrawPoint.
+
+procedure spiral()
+   local r, a, d
+
+   r := 3			# initial radius
+   a := 0			# initial start angle
+   while r < HALF do {
+      DrawPoint(r * cos(a), r * sin(a))
+      d := 1.0 / r
+      a +:= d
+      r +:= 2 * d
+      }
+end
+
+
+## star() -- draw a five-pointed star.
+#
+#  Tests FillPolygon and the even-odd winding rule.
+
+procedure star()
+   FillPolygon(-40, -10, 40, -10, -25, 40, 0, -40, 25, 40)
+end
+
+
+
+## stdfonts() -- test standard fonts
+#
+#  Shows the default font (the header line), standard fonts, and "fixed".
+
+procedure stdfonts()
+   Translate(-HALF + 4, -HALF)
+   Shade("gray")
+   FillRectangle(-4)
+   Shade("black")
+   GotoRC(1, 1)
+   WWrite(if Font("mono") then "mono" else "no mono!") 
+   WWrite(if Font("typewriter") then "typewriter" else "no typewriter!") 
+   WWrite(if Font("sans") then "sans" else "no sans!") 
+   WWrite(if Font("serif") then "serif" else "no serif!") 
+   WWrite(if Font("fixed") then "fixed" else "no fixed!") 
+end
+
+
+## stdpats() -- test standard patterns
+#
+#  Tests standard pattern names; tests fillstyle=textured.
+
+procedure stdpats()
+   local i, j, s, x, y
+
+   WAttrib("fillstyle=textured")
+   s := [
+      "black", "verydark", "darkgray", "gray", "lightgray", "verylight",
+      "white", "vertical", "diagonal", "horizontal", "grid", "trellis",
+      "checkers", "grains", "scales", "waves"]
+   every i := 0 to 3 do
+      every j := 0 to 3 do {
+         WAttrib("pattern=" || s[4 * i + j + 1])
+         x := -HALF + j * CELL / 4
+         y := -HALF + i * CELL / 4
+         FillRectangle(x, y)	# depends on opacity of patterns to work
+         }
+end
+
+
+## whale() -- draw a whale
+#
+#  Tests transparent and regular images, Capture, Zoom.
+
+procedure whale()
+   local s
+
+   Fg("moderate greenish cyan")
+   FillRectangle()
+   Translate(-HALF, -HALF)
+
+   DrawImage(3, 3, "32, c1, _
+      ~~~~~~~~~~~~000~~~~~~00~~~~~~~00_
+      ~~~~~~~~~~~0JJJ00~~~~0J00~~~00J0_
+      ~~~~~~~000000JJJJ0~~~0J0J000J0J0_
+      ~~~~~000iiiii000JJ0~~0JJJ0J0JJi0_
+      ~~~~06660ii000ii00J0~~00JJJJJ00~_
+      ~~~066000i06600iii00~~~~0iii0~~~_
+      ~~0066000i06000iiii0~~~~~0i0~~~~_
+      ~~0i0000iii000iiiiii0~~~~0i0~~~~_
+      ~0iiiiiiiiiiiiiiiiiii0~~0ii0~~~~_
+      ~00000iii0000iiiiiiiii00iiii0~~~_
+      0AAAAA000AAAA00iiiiiiiiiiiii0~~~_
+      0AAAAAAAAAAAAAA0iiiiiiiiiiii0~~~_
+      ~0000AAAAA0000AA0iiiiiiiiiiii0~~_
+      ~06060000060600AA0iiiiiiiiiii0~~_
+      ~060606060606000A0iiiii00iiii0~~_
+      ~~0~006060000000AA0iiiiiJ0iii0~~_
+      ~~~~~~00000000000A0iiii0JJ0ii0~~_
+      ~~~~~~00000000000A0iiiiJ0J0ii0~~_
+      ~~~0~~00000000000A0iii0JJ00i0~~~_
+      ~~060000000000000A0i0JJ0JJ0i0~~~_
+      ~~06060600000600AA0ii0JJ00ii0~~~_
+      ~00006060606060AA0iiii000ii0~~~~_
+      0AAA0000060600AAA0iiiiiiiii0~~~~_
+      0AAAAAAAA000AAAA0iiiiiiiiii0~~~~_
+      ~000AAAAAAAAAAA0iiiiiiiiii0~~~~~_
+      ~~0i0000AAAAA00iiiiiiiiiii0~~~~~_
+      ~~0iiiii00000iiiiiiiiiiii0~~~~~~_
+      ~~~0iiiiiiiiiiiiiiiiiiii0~~~~~~~_
+      ~~~~0iiiiiiiiiiiiiiiii00~~~~~~~~_
+      ~~~~~00iiiiiiiiiiiii00~~~~~~~~~~_
+      ~~~~~~~000iiiiiii000~~~~~~~~~~~~_
+      ~~~~~~~~~~0000000~~~~~~~~~~~~~~~")
+
+   s := Capture(, 0, 0, 36, 36)
+   DrawImage(0, 40, s)
+
+   Zoom(0, 0, 36, 36, 40, 20, 72, 72)
+end
+
+
+##############################  Dialog test  ##############################
+
+
+## dltest() -- dialog test
+#
+#  Present a dialog box with "Validate" and "Cancel" buttons.
+#  For "Validate", check all values, and repeat dialog if incorrect.
+#  For "Cancel", return immediately.
+
+procedure dltest()
+   while dlog() ~== "Cancel" do {
+      if dialog_value["button"] ~=== 1 then
+         { Notice("The button was not left dark."); next }
+      if dialog_value["xbox"] ~=== 1 then
+         { Notice("The checkbox was not checked."); next }
+      if dialog_value["slider"] < 0.8 then
+         { Notice("The slider was not set."); next }
+      if map(dialog_value["text"]) ~== "icon" then
+         { Notice("The text did not say `Icon'"); next }
+      Notice("All values were correct.")
+      return
+      }
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure dlog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["dlog:Sizer::1:0,0,370,220:",],
+   ["button:Button:regular:1:291,21,56,21:button",],
+   ["cancel:Button:regular::198,174,100,30:Cancel",],
+   ["label1:Label:::20,25,252,13:Click this button and leave it dark:",],
+   ["label2:Label:::20,55,105,13:Check this box:",],
+   ["label3:Label:::20,85,238,13:Move this slider to the far right:",],
+   ["rule:Line:::20,157,350,157:",],
+   ["slider:Slider:h::273,86,76,15:0.0,1.0,0.5",],
+   ["text:Text::6:20,115,214,17:Enter the word `Icon': \\=here",],
+   ["validate:Button:regular:-1:75,174,100,30:Validate",],
+   ["xbox:Button:xbox:1:131,54,16,16:",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/gridedit.icn b/ipl/gprogs/gridedit.icn
new file mode 100644
index 0000000..71706dd
--- /dev/null
+++ b/ipl/gprogs/gridedit.icn
@@ -0,0 +1,56 @@
+############################################################################
+#
+#	File:     gridedit.icn
+#
+#	Subject:  Program to create and edit binary arrays
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This application provides a variety of facilities for creating and
+#  editing binary arrays.  It is intended for use with weaving tie-ups
+#  and liftplans.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, /tmp
+#
+############################################################################
+#
+#  Links: tieedit
+#
+############################################################################
+
+link tieedit
+
+procedure main(args)
+
+   grid_init()
+
+   ready()
+
+   while ProcessEvent(grid_root, ,  grid_shortcuts) do
+      if \grid_state then exit()
+
+end
+
+procedure ready()
+
+   grid_state := &null
+
+   grid_rows := pat2rows("10,#001002004008010020040080100200")
+
+   setup()
+
+   WAttrib(grid_window, "canvas=normal")
+
+   return
+
+end
diff --git a/ipl/gprogs/gxplor.icn b/ipl/gprogs/gxplor.icn
new file mode 100644
index 0000000..3e331aa
--- /dev/null
+++ b/ipl/gprogs/gxplor.icn
@@ -0,0 +1,380 @@
+############################################################################
+#
+#	File:     gxplor.icn
+#
+#	Subject:  Program to explore graphics facilities
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 20, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Usage:  gxplor [-s] [window options]
+#
+#      gxplor is an interactive explorer for experimenting with Icon's
+#   graphics facilities.  Commands read from standard input set window
+#   attributes or invoke procedures.  Result values are reported on
+#   standard output.  Errors are caught when possible.
+#
+#      Here's an example, with commentary at the side,  that illustrates
+#   some of the possibilities:
+#
+#	% gxplor			start program; a window appears
+#	> fg				query value of "fg" attribute
+#	black
+#	> fg blue			set "fg" attribute
+#	blue
+#	> linewidth 7			set "linewidth" attribute
+#	7
+#	> drawline 12 20 55 73		a fat blue line appears
+#	> erasearea			clear window
+#	> fillarea
+#	[unrecognized]			oops -- wrong name
+#	> fillrectangle
+#	> pattern			query "pattern" attribute
+#	[failed]
+#	> pattern grid			set it
+#	grid
+#	> fillstyle
+#	solid
+#	> fillstyle opaque
+#	error 205: invalid value
+#	> fillstyle textured		set fillstyle
+#	textured
+#	> clip 50 50 400 200		set clipping
+#	> fillrectangle			fill clipped area with pattern
+#	> zoom 40 40 100 100 300 50 200 200
+#					zoom a region
+#	> &storage			query memory usage
+#	0
+#	274
+#	12184
+#	> exit				exit the program
+#	%
+#
+#      Input consists of blank-separated words, as shown.  If the first
+#   word is recognized as the name of an attribute, a WAttrib() call is
+#   made.  If it is an Icon keyword, the keyword value is printed.
+#   Otherwise, the word is treated as a procedure name.  Any built-in
+#   function or linked procedure can be invoked, and procedure names are
+#   treated as case-insensitive for ease of entry.
+#
+#      If a line begins with an integer, the remainder of the line is
+#   interpreted as a command to be repeated that number of times.
+#   Afterwards, the elapsed CPU and wall-clock time is reported;
+#   these figures include loop and call overhead.
+#
+#      The -s option selects "script" mode:  input is echoed on standard
+#   output, and at EOF the program pauses in WDone().
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: many
+#
+############################################################################
+
+link graphics 
+link options
+link datetime
+link random
+
+link barchart, bitplane, drawcard, decay, imscolor
+link psrecord, putpixel, strpchrt, turtle, vsetup
+
+invocable all
+
+$define MaxErrors 100
+
+
+#  main procedure
+
+procedure main(args)
+   local line, words, n, tm, ck, verb, p, s, w, r, atts, keywds, opts
+
+   atts := attnames()
+   keywds := kwnames()
+   Window(args)
+   opts := options(args, "s")
+
+   repeat {
+
+      # read next line
+      writes("> ")
+      line := read() | break
+      if \opts["s"] then
+         write(line)
+      words := crack(line)
+
+      # set up for timing, if wanted
+      if n := integer(words[1]) then {
+         get(words)
+         tm := &time
+         ck := &clock
+         }
+      else {
+         n := 1
+         tm := ck := &null
+         }
+
+      verb := get(words) | next
+      &error := MaxErrors
+
+      if member(atts, verb) then {
+
+	 # attribute name
+         s := verb || "="
+         every w := !words do
+            s ||:= (\w | "") || " "
+         s := trim(s, ' =')
+         every 2 to n do
+            WAttrib(s)
+         r := image(WAttrib(s)) | "[failed]"
+         }
+
+      else if member(keywds, verb) then {
+
+	 # keyword name
+	 every kwval(verb, n - 1)
+	 s := &null
+         every write(s := image(kwval(verb, 1)))
+	 if /s then write("[failed]")
+	 r := "window"	# inhibit later result printing
+         }
+
+      else if p := getproc(verb) then {
+
+	 # procedure call
+         dialog_value := &null
+         every 2 to n do
+            p ! words
+         r := image(p ! words) | "[failed]"
+         r ||:= "    (dialog_value = " || image(\dialog_value) || ")"
+         }
+
+      else {
+
+         r := "[unrecognized]"
+         tm := ck := &null
+         }
+
+      # calculate elapsed time
+      if \tm then {
+         WSync()
+         tm := &time - tm
+         ck := clkdiff(&clock, ck)
+         }
+
+      # report result or error
+      if &error = MaxErrors then {
+         # no error occurred
+         if not (r ? ="window") then
+            write(r)
+         }
+      else if &error = MaxErrors - 1 then {
+         # an error occurred
+         write("error ", &errornumber, ": ", &errortext)
+         write("offending value: ", &errorvalue)
+         }
+      else {
+         # error conversion led to a second error;
+         # original information has been lost
+         write("error (details lost)")
+         }
+
+      # write timing results
+      write("n=", n, " time=", \tm / 1000.0, " clock=", \ck)
+
+      &error := 0
+      }
+
+   # at EOF, if called with -s option, wait for "Q" in window
+   if \opts["s"] then {
+      write("EOF")
+      WDone()
+      }
+end
+
+
+
+#  crack(s) -- parse line, returning list of words
+
+procedure crack(s)
+   local words
+
+   words := []
+   s ? {
+      tab(many(' \t'))
+      while not pos(0) do {
+	 put(words, tab(upto(' \t') | 0))
+         tab(many(' \t'))
+         }
+      }
+   return words
+end
+
+
+
+#  getproc(s) -- get procedure named s, case insensitive
+
+procedure getproc(s)
+   local p, f, line, tname
+   static proctab
+
+   initial {
+      # put every builtin function in the table
+      proctab := table()
+      every p := function() do
+         proctab[map(p)] := proc(p)
+
+      # open a temporary file to get procedure names
+      randomize()
+      tname := "gxp" || right(?99999, 5, "0") || ".tmp"
+$ifdef _UNIX
+      tname := "/tmp/" || tname
+$endif
+      f := open(tname, "crw") | stop("can't open ", tname)
+
+      # put every linked procedure in the table
+      display(0, f)
+      seek(f, 1)
+      while line := read(f) do line ? {
+         tab(upto('=')) | next
+         tab(many('= '))
+         ="procedure" | next
+         tab(many(' '))
+         p := trim(tab(0))
+         proctab[map(p)] := proc(p)
+         }
+      close(f)
+      remove(tname)
+   }
+
+   return \proctab[map(s)]
+end
+
+
+
+#  attnames() -- return set of known attribute names
+
+procedure attnames()
+   return set([
+      "ascent", "bg", "canvas", "ceol", "cliph", "clipw", "clipx", "clipy",
+      "col", "columns", "cursor", "depth", "descent", "display",
+      "displayheight", "displaywidth", "drawop", "dx", "dy", "echo", "fg",
+      "fheight", "fillstyle", "font", "fwidth", "gamma", "geometry", "height",
+      "iconic", "iconimage", "iconlabel", "iconpos", "image", "label",
+      "leading", "lines", "linestyle", "linewidth", "pattern", "pointer",
+      "pointercol", "pointerrow", "pointerx", "pointery", "pos", "posx",
+      "posy", "resize", "reverse", "row", "rows", "size", "visual", "width",
+      "windowlabel", "x", "y"])
+end
+
+
+
+#  kwnames() -- return set of known keyword names
+
+procedure kwnames()
+   return set([
+      "&allocated", "&ascii", "&clock", "&col", "&collections",
+      "&control", "&cset", "&current", "&date", "&dateline", "&digits",
+      "&dump", "&e", "&error", "&errornumber", "&errortext", "&errorvalue",
+      "&errout", "&fail",
+      "&features", "&file", "&host", "&input", "&interval", "&lcase", "&ldrag",
+      "&letters", "&level", "&line", "&lpress", "&lrelease", "&main", "&mdrag",
+      "&meta", "&mpress", "&mrelease", "&null", "&output", "&phi", "&pi",
+      "&pos", "&progname", "&random", "&rdrag", "&regions", "&resize", "&row",
+      "&rpress", "&rrelease", "&shift", "&source", "&storage", "&subject",
+      "&time", "&trace", "&ucase", "&version", "&window", "&x", "&y"])
+end
+
+
+
+#  kwval(name, n) -- generate values of a keyword n times
+
+procedure kwval(name, n)
+   case name of {
+      "&allocated":	every 1 to n do suspend &allocated
+      "&ascii":		every 1 to n do suspend &ascii
+      "&clock":		every 1 to n do suspend &clock
+      "&col":		every 1 to n do suspend &col
+      "&collections":	every 1 to n do suspend &collections
+      "&control":	every 1 to n do suspend &control
+      "&cset":		every 1 to n do suspend &cset
+      "&current":	every 1 to n do suspend &current
+      "&date":		every 1 to n do suspend &date
+      "&dateline":	every 1 to n do suspend &dateline
+      "&digits":	every 1 to n do suspend &digits
+      "&dump":		every 1 to n do suspend &dump
+      "&e":		every 1 to n do suspend &e
+      "&error":		every 1 to n do suspend &error
+      "&errornumber":	every 1 to n do suspend &errornumber
+      "&errortext":	every 1 to n do suspend &errortext
+      "&errorvalue":	every 1 to n do suspend &errorvalue
+      "&errout":	every 1 to n do suspend &errout
+      "&fail":		every 1 to n do suspend &fail
+      "&features":	every 1 to n do suspend &features
+      "&file":		every 1 to n do suspend &file
+      "&host":		every 1 to n do suspend &host
+      "&input":		every 1 to n do suspend &input
+      "&interval":	every 1 to n do suspend &interval
+      "&lcase":		every 1 to n do suspend &lcase
+      "&ldrag":		every 1 to n do suspend &ldrag
+      "&letters":	every 1 to n do suspend &letters
+      "&level":		every 1 to n do suspend &level
+      "&line":		every 1 to n do suspend &line
+      "&lpress":	every 1 to n do suspend &lpress
+      "&lrelease":	every 1 to n do suspend &lrelease
+      "&main":		every 1 to n do suspend &main
+      "&mdrag":		every 1 to n do suspend &mdrag
+      "&meta":		every 1 to n do suspend &meta
+      "&mpress":	every 1 to n do suspend &mpress
+      "&mrelease":	every 1 to n do suspend &mrelease
+      "&null":		every 1 to n do suspend &null
+      "&output":	every 1 to n do suspend &output
+      "&phi":		every 1 to n do suspend &phi
+      "&pi":		every 1 to n do suspend &pi
+      "&pos":		every 1 to n do suspend &pos
+      "&progname":	every 1 to n do suspend &progname
+      "&random":	every 1 to n do suspend &random
+      "&rdrag":		every 1 to n do suspend &rdrag
+      "&regions":	every 1 to n do suspend &regions
+      "&resize":	every 1 to n do suspend &resize
+      "&row":		every 1 to n do suspend &row
+      "&rpress":	every 1 to n do suspend &rpress
+      "&rrelease":	every 1 to n do suspend &rrelease
+      "&shift":		every 1 to n do suspend &shift
+      "&source":	every 1 to n do suspend &source
+      "&storage":	every 1 to n do suspend &storage
+      "&subject":	every 1 to n do suspend &subject
+      "&time":		every 1 to n do suspend &time
+      "&trace":		every 1 to n do suspend &trace
+      "&ucase":		every 1 to n do suspend &ucase
+      "&version":	every 1 to n do suspend &version
+      "&window":	every 1 to n do suspend &window
+      "&x":		every 1 to n do suspend &x
+      "&y":		every 1 to n do suspend &y
+   }
+end
+
+
+
+#  clkdiff(a, b) -- return difference in seconds between two &clock values
+#
+#  If a < b, the time is assumed to have wrapped past midnight.
+
+procedure clkdiff(a, b)
+   local t
+   t := ClockToSec(a) - ClockToSec(b)
+   if t < 0 then
+      t +:= ClockToSec("24:00:00")
+   return t
+end
diff --git a/ipl/gprogs/hb.icn b/ipl/gprogs/hb.icn
new file mode 100644
index 0000000..077c3c2
--- /dev/null
+++ b/ipl/gprogs/hb.icn
@@ -0,0 +1,334 @@
+############################################################################
+#
+#	File:	  hb.icn
+#
+#	Subject:  Program for Hearts & Bones game
+#
+#	Author:	  Robert J. Alexander
+#
+#	Date:	  March 10, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Hearts & Bones
+#
+#  Usage: hb [-h <board height>] [-w <board width>] [-b <# bones>] [-B]
+#
+#  -B says to print the actual number of bones placed.
+#
+#  For best results, use odd board heights and widths, and even
+#  square heights and widths.
+#
+#  Defaults: board height = 9, board width = 13, # bones = 25.
+#
+#  --- Game Play ---
+#
+#  Hit "q" to quit, "r" to start a new game.
+#
+#  The object is to visit all the safe squares without stepping on a
+#  bone.
+#
+#  You *visit* a square by clicking the left mouse button in it.  If the
+#  square is safe, a number is posted in it that reveals the number of
+#  squares in the eight neighboring squares the contain bones.  Squares
+#  containing hearts (represented by $) are always safe.
+#
+#  You can only visit squares that are adjacent to squares already
+#  visited.  At the start of a game, the upper left square (a heart
+#  square) is pre-visited for you.  If a visited square has no
+#  neighbors, its adjacent squares are automatically visited for you, as
+#  a convenience.
+#
+#  At any time you can *mark* a square that you believe has a bone by
+#  clicking the right (or center) mouse button on it.  This is a memory
+#  aid only -- if you visit it later (and you were right), you're dead.
+#  There is no confirmation whether a square you have marked really
+#  contains a bone, although you will probably find out later when it
+#  causes you to make a mistake.  A right-button click on a marked
+#  square unmarks it.
+#
+#  The game ends when you have visited all safe squares or stepped on a
+#  bone.  (Presently, there is no automatic detection of a winning board
+#  -- you just have to notice that for yourself).
+#
+#  NOTE:  If you use the command line options to alter the setup
+#  parameters (e.g.  increasing the number of squares, or *decreasing*
+#  the number of bones), you might get a stack overflow due, I think, to
+#  deep recursion.  I have found that setting the environment variable
+#  MSTKSIZE=30000 works well.
+#
+############################################################################
+#
+#  Links: options, random, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link options
+link random
+link wopen
+
+global height, width, nbr_bones, x1, y1, sq, print_bone_count
+
+
+procedure main(arg)
+   initialize(arg)
+   play()
+   return
+end
+
+
+procedure draw_board(win)
+   local x, y, x2, y2
+   x2 := x1 + width * sq
+   y2 := y1 + height * sq
+   x := x1
+   every 1 to width + 1 do {
+      DrawLine(win, x, y1, x, y2)
+      x +:= sq
+      }
+   y := y1
+   every 1 to height + 1 do {
+      DrawLine(win, x1, y, x2, y)
+      y +:= sq
+      }
+   return
+end
+
+
+procedure set_up_board(win, visited)
+   local board, pt
+   EraseArea(win)
+   board := make_board()
+   set_bones(board, nbr_bones)
+   calc_neighbors(board)
+   draw_board(win)
+   draw_hearts(win)
+   every pt := spread_zeros(board, 1, 1) do {
+      write_to_square(win, pt[1], pt[2], pt[3])
+      visited[pt[1], pt[2]] := 1
+      }
+   return board
+end
+
+
+procedure draw_hearts(win)
+   local pt
+   every pt := generate_heart_squares() do
+	 write_to_square(win, pt[1], pt[2], "$")
+   return
+end
+
+
+procedure legal_move(x, y, visited)
+   local xx, yy
+   every xx := x - 1 to x + 1 & yy := y - 1 to y + 1 do
+	 if \visited[xx, yy] then {
+	    visited[x, y] := 1
+	    return
+	    }
+end
+
+
+procedure play()
+   local win, x, y, evt, mark, marks, board, visited, pt, value
+   sq := (if match("OS/2", &host) then 30 else 20)
+   x1 := 10
+   y1 := 10
+   win := WOpen("label=HB", "size=" || width * sq + 2 * x1 || "," ||
+	 height * sq + 2 * y1)
+   repeat {
+      visited := make_board()
+      board := set_up_board(win, visited)
+      marks := make_board(" ")
+      repeat {
+	 evt := Event(win)
+	 case type(evt) of {
+	    "string": case map(evt) of {
+	       "q": exit()
+	       "r": break next
+	       }
+	    "integer": {
+	       if evt = &lrelease then {
+		  x := (&x - x1) / sq + 1
+		  y := (&y - y1) / sq + 1
+		  if legal_move(x, y, visited) then {
+		     value := board[x, y]
+		     if value ~=== "X" then {
+			#
+			#  Visited a safe square.
+			#
+			if value = 0 then 
+			      every pt := spread_zeros(board, x, y) do {
+				 write_to_square(win, pt[1], pt[2], pt[3])
+				 visited[pt[1], pt[2]] := 1
+				 }
+			else write_to_square(win, x, y, value)
+			}
+		     else {
+			#
+			#  Stepped on a bone -- game over.
+			#
+			every x := 1 to width & y := 1 to height do {
+			   value := board[x, y]
+			   write_to_square(win, x, y, "X" === value)
+			   }
+			draw_hearts(win)
+			repeat {
+			   evt := Event(win)
+			   case type(evt) of {
+			      "integer": if evt = &lrelease then break
+			      "string": case map(evt) of {
+				 "q": exit()
+				 "r": break
+				 }
+			      }
+			   }
+			break
+			}
+		     }
+		  }
+	       else if evt = (&mrelease | &rrelease) then {
+		  x := (&x - x1) / sq + 1
+		  y := (&y - y1) / sq + 1
+		  mark := marks[x, y] := if marks[x, y] == " " then "#" else " "
+		  write_to_square(win, x, y, mark)
+		  }
+	       }
+	    }
+	 }
+      }
+end
+
+
+procedure spread_zeros(board, x, y, doneset)
+   local xx, yy, v, donekey
+   /doneset := set()
+   donekey := x || "," || y
+   if member(doneset, donekey) then fail
+   insert(doneset, donekey)
+   (v := board[x, y]) | fail
+   suspend [x, y, v]
+   if v === 0 then {
+      every xx := x - 1 to x + 1 & yy := y - 1 to y + 1 do 
+	    if not(x = xx & y = yy) & board[xx, yy] then
+	    suspend spread_zeros(board, xx, yy, doneset)
+      }
+end
+
+
+procedure write_to_square(win, x, y, s)
+   WAttrib(win,
+	 "x=" || x1 + (x - 1) * sq + sq / 2 - 2,
+	 "y=" || y1 + (y - 1) * sq + sq / 2 + 4)
+   return writes(win, s)
+end
+
+
+procedure get_options(arg)
+   local opt
+   opt := options(arg, "h+w+b+B")
+   height := \opt["h"] | 9
+   width := \opt["w"] | 15
+   nbr_bones := \opt["b"] | (height * width - 9) / 5
+   print_bone_count := opt["B"]
+   width <:= 5
+   height <:= 5
+   nbr_bones >:= height * width * 2 / 3
+   return opt
+end
+
+
+procedure initialize(arg)
+   randomize()
+   get_options(arg)
+   return
+end
+
+
+procedure make_board(init_value)
+   local board
+   board := list(width)
+   every !board := list(height, init_value)
+   return board
+end
+
+
+procedure generate_heart_squares()
+   suspend [1 | (width + 1) / 2 | width, 1 | (height + 1) / 2 | height]
+end
+
+
+procedure set_bones(board, nbr_bones)
+   local i, j, pt, bone_count
+   every pt := generate_heart_squares() do board[pt[1], pt[2]] := "$"
+   board[1, 2] := board[2, 1] := board[2, 2] := "$"
+   bone_count := 0
+   every 1 to nbr_bones do {
+      #
+      #  Loop to find a spot with a path back to the start.  If we don't
+      #  find one after several tries, quit placing bones.
+      #
+      (every 1 to 20 do {
+	 i := ?width
+	 j := ?height
+	 if /board[i, j] then {
+	    board[i, j] := "X"
+	    if hearts_reachable(board) then {
+	       bone_count +:= 1
+	       break
+	       }
+	    else board[i, j] := &null
+	    }
+	 }) | break
+      }
+   if \print_bone_count then write(&errout, bone_count, " bones")
+   return
+end
+
+
+procedure calc_neighbors(board)
+   local i, j, ii, jj, neighbors
+   every i := 1 to width & j := 1 to height do {
+      if board[i, j] ~=== "X" then {
+	 neighbors := 0
+	 every ii := i - 1 to i + 1 & jj := j - 1 to j + 1 do {
+	    if board[ii, jj] === "X" then neighbors +:= 1
+	    }
+	 board[i, j] := neighbors
+	 }
+      }
+   return
+end
+
+
+procedure hearts_reachable(board)
+   local pt
+   every pt := generate_heart_squares() do {
+      if not path_to_start(pt[1], pt[2], board) then fail
+      }
+   return
+end
+
+
+procedure path_to_start(x, y, board, doneset)
+   local xx, yy, donekey
+   /doneset := set()
+   if not(board[x, y] ~=== "X") then fail
+   if x = 1 & y = 1 then return
+   donekey := x || "," || y
+   if member(doneset, donekey) then fail
+   insert(doneset, donekey)
+   every xx := x - 1 to x + 1 & yy := y - 1 to y + 1 do {
+      if x = xx & y == yy then next
+      if path_to_start(xx, yy, board, doneset) then return
+      }
+end
+
diff --git a/ipl/gprogs/histo.icn b/ipl/gprogs/histo.icn
new file mode 100644
index 0000000..3e94ae9
--- /dev/null
+++ b/ipl/gprogs/histo.icn
@@ -0,0 +1,99 @@
+############################################################################
+#
+#	File:     histo.icn
+#
+#	Subject:  Program to display simple histogram
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 21, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays a simple histogram based on numbers provided
+#  in standard input.
+#
+#  The following options are supported:
+#
+#	-s r	horizontal scale factors, default 1.0
+#	-w i	bar width in pixels, default 5
+#	-g i	gap between bars, default 1
+#	-m	minimal; set width to 1, gap to 0.
+#-	n s	name for image file, default "untitled"
+#
+#  Note: If there is too much input, there may not be resources to
+#  open a window, and even if there is, parts may be off-screen.
+#
+#  The histogram is written to <name>.gif
+#
+#  The window is dismissed by a user q event.
+#
+############################################################################
+#
+#  Requires:  Graphics
+#
+############################################################################
+#
+#  Links:  numbers, options, wopen
+#
+############################################################################
+
+link numbers
+link options
+link wopen
+
+procedure main(args)
+   local height, window_height, y, window_width, numbers, opts, scale
+   local number, gap, bar, name
+
+   opts := options(args, "s.w+g+m")
+
+   scale := \opts["s"] | 1
+   bar := \opts["w"] | 5
+   gap := \opts["g"] | 1
+   if \opts["m"] then {
+      bar := 1
+      gap := 0
+      }
+   name := \opts["n"] | "untitled"
+   
+   height := bar + gap
+
+   numbers := []
+
+   while number := read() do {
+      number := numeric(number) | stop("*** nonnumeric data")
+      number <:= 0		# clamp negative number to 0
+      put(numbers, number)
+      }
+
+   if *numbers = 0 then stop("*** no data")
+
+   window_height := *numbers * height + gap
+
+   window_width := integer(scale * (max ! numbers) + 10)
+
+   WOpen("canvas=hidden", "label=Histogram",
+      "size=" || window_width || "," || window_height) |
+         stop("*** cannot open window")
+
+   y := 0
+
+   while FillRectangle(0, y + gap, scale * get(numbers), height - gap) do
+      y +:= height
+
+   WAttrib("canvas=normal")
+
+   until WQuit()
+
+   WriteImage(name || ".gif")
+
+   WClose()
+
+   return
+
+end
diff --git a/ipl/gprogs/hsvpick.icn b/ipl/gprogs/hsvpick.icn
new file mode 100644
index 0000000..7b5b765
--- /dev/null
+++ b/ipl/gprogs/hsvpick.icn
@@ -0,0 +1,205 @@
+############################################################################
+#
+#	File:     hsvpick.icn
+#
+#	Subject:  Program to pick RGB or HSV colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      hsvpick is a simple HSV color picker.  The three sliders on the
+#   left control red, green, blue; the sliders on the right control
+#   hue, saturation, value.  The equivalent hexadecimal specification
+#   is displayed in the center.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, slider, evmux, graphics
+#
+############################################################################
+
+link button
+link slider
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+record valrec(r, g, b, h, s, v)
+global sl		# the six sliders
+global val		# the six values [0.0 - 1.0]
+
+global w, h, m, l	# geometry options
+global sw		# slider width
+global colr		# selected color
+
+procedure main(args)
+   local cwin, x, y, ww, hh
+
+   # create window
+   Window("size=420,300", args)
+   m := WindowMargin				# size of outside margins
+   w := w := WAttrib("width") - 2 * m		# usable width
+   h := WAttrib("height") - 2 * m		# usable height
+   l := WAttrib("leading")			# leading
+   sw := 20					# set slider width
+
+   # get mutable color to display the selected color
+   # use a new binding to avoid disturbing fg/bg of &window.
+   colr := NewColor(&window) | stop("can't allocate mutable color")
+   cwin := Clone(&window)
+   Bg(cwin, colr)
+
+   # draw the area showing the color itself
+   x := 4 * m + 3 * sw
+   y := m
+   ww := w - 6 * sw - 6 * m
+   hh := h - m - 3 * l
+   BevelRectangle(x, y, ww, hh, -BevelWidth)
+   EraseArea(cwin, x+BevelWidth, y+BevelWidth, ww-2*BevelWidth, hh-2*BevelWidth)
+
+   # set up sliders to control the colors
+   val := valrec(0.75, 0.625, 0.50, 0.0, 0.0, 0.0)	# initial values
+   sl := valrec(
+      slider(&window, setval, 1,              m, m, sw, h, 0.0, val.r, 1.0),
+      slider(&window, setval, 2,     sw + 2 * m, m, sw, h, 0.0, val.g, 1.0),
+      slider(&window, setval, 3, 2 * sw + 3 * m, m, sw, h, 0.0, val.b, 1.0),
+      slider(&window, setval, 4, w - m - 3 * sw, m, sw, h, 0.0, val.h, 1.0),
+      slider(&window, setval, 5, w     - 2 * sw, m, sw, h, 0.0, val.s, 1.0),
+      slider(&window, setval, 6,     w + m - sw, m, sw, h, 0.0, val.v, 1.0))
+   sethsv()						# set hsv from rgb
+   setcolor()						# download the colors
+
+   # set up sensors for quitting
+   quitsensor(&window)					# q or Q
+   button(&window, "QUIT", argless, exit, m + w / 2 - 30, m + h - 20, 60, 20)
+
+   # enter event loop
+   evmux(&window)
+end
+
+procedure setval(win, i, v)		# set color component i to value v
+   val[i] := v
+   if i < 4 then
+      sethsv()				# rgb slider moved; set hsv values
+   else
+      setrgb()				# hsv slider moved; set rgv values
+
+   setcolor()				# set color, update display
+   return
+end
+
+procedure sethsv()			# set hsv from rgb values
+					# based on Foley et al, 2/e, p.592
+   local min, max, d
+
+   min := val.r;  min >:= val.g;  min >:= val.b		# minimum
+   max := val.r;  max <:= val.g;  max <:= val.b		# maximum
+   d := max - min					# difference
+
+   val.v := max					# v is max of all values
+   if max > 0 then
+      val.s := d / max
+   else
+      val.s := 0				# sat is (max-min)/max
+
+   if val.s > 0 then {
+      if val.g = max then
+         val.h := 2 + (val.b - val.r) / d	# yellow through cyan
+      else if val.b = max then
+         val.h := 4 + (val.r - val.g) / d	# cyan through magenta
+      else if val.g < val.b then
+         val.h := 6 + (val.g - val.b) / d	# magenta through red
+      else
+         val.h := (val.g - val.b) / d		# red through yellow
+      }
+   val.h /:= 6					# scale to 0.0 - 1.0
+
+   # set sliders to reflect calculated values
+   slidervalue(sl.h, val.h)
+   slidervalue(sl.s, val.s)
+   slidervalue(sl.v, val.v)
+   return
+end
+
+procedure setrgb()			# set rgb from hsv values
+					# based on Foley et al, 2/e, p.593
+   local h, f, i, p, q, t, v
+
+   if val.s = 0.0 then
+      val.r := val.g := val.b := val.v	# achromatic
+   else {
+      h := val.h * 6.0			# hue [0.0 - 6.0)
+      if h >= 6.0 then
+         h := 0.0
+      i := integer(h)
+      f := h - i
+      v := val.v
+      p := val.v * (1.0 - val.s)
+      q := val.v * (1.0 - f * val.s)
+      t := val.v * (1.0 - (1.0 - f) * val.s)
+      case i of {
+         0: { val.r := v;  val.g := t;  val.b := p }	# red - yellow
+         1: { val.r := q;  val.g := v;  val.b := p }	# yellow - green
+         2: { val.r := p;  val.g := v;  val.b := t }	# green - cyan
+         3: { val.r := p;  val.g := q;  val.b := v }	# cyan - blue
+         4: { val.r := t;  val.g := p;  val.b := v }	# blue - magenta
+         5: { val.r := v;  val.g := p;  val.b := q }	# magenta - red
+         }
+      }
+
+   # set sliders to reflect calculated values
+   slidervalue(sl.r, val.r)
+   slidervalue(sl.g, val.g)
+   slidervalue(sl.b, val.b)
+   return
+end
+
+procedure setcolor()			# set the color in the color map
+   local s, x
+
+   # build and display hex color spec, and set color
+   s := "#" || hexv(val.r) || hexv(val.g) || hexv(val.b)
+   Color(colr, s)
+   GotoXY(m + w / 2 - TextWidth(s) / 2, m + h - 2 * l)
+   WWrites(s)
+
+   # display r, g, b values
+   x := 4 * m + 3 * sw
+   GotoXY(x, m + h - 2 * l)
+   WWrites("r: ", right(integer(65535 * val.r), 5))
+   GotoXY(x, m + h - l)
+   WWrites("g: ", right(integer(65535 * val.g), 5))
+   GotoXY(x, m + h)
+   WWrites("b: ", right(integer(65535 * val.b), 5))
+
+   # display h, s, v values
+   x := w - 2 * m - 3 * sw - TextWidth("h: 000")
+   GotoXY(x, m + h - 2 * l)
+   WWrites("h: ", right(integer(360 * val.h), 3))
+   GotoXY(x, m + h - l)
+   WWrites("s: ", right(integer(100 * val.s), 3))
+   GotoXY(x, m + h)
+   WWrites("v: ", right(integer(100 * val.v), 3))
+   return
+end
+
+procedure hexv(v)			# two-hex-digit specification of v
+   static hextab
+   initial {
+      every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
+      }
+   return hextab [integer(255 * v + 1.5)]
+end
diff --git a/ipl/gprogs/hvc.icn b/ipl/gprogs/hvc.icn
new file mode 100644
index 0000000..058d57d
--- /dev/null
+++ b/ipl/gprogs/hvc.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     hvc.icn
+#
+#	Subject:  Program to pick colors for Tek HVC space
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      hvc is a simple color picker using HVC space.  The three sliders
+#   control hue, value, and chroma from left to right.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics under X11R5
+#
+############################################################################
+#
+#  Links: button, slider, evmux, graphics
+#
+############################################################################
+
+link button
+link slider
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+record hvcrec(h, v, c)
+global settings, colr, sl, win
+global w, h, m
+
+procedure main(args)
+   local opts, cwin, ww, hh
+
+   win := Window("size=300,250", "font=Helvetica,bold,14", args)
+   w := WAttrib("width")
+   h := WAttrib("height")
+   m := WindowMargin
+
+   # a mutable color for displaying the selected color
+   # use a new binding to avoid disturbing fg/bg of win.
+   colr := NewColor(win) | stop("can't allocate mutable color")
+   cwin := Clone(win)
+   Bg(cwin, colr)
+   Color(win, colr, "TekHVC:0/0/0") |
+      stop("can't set HVC colors -- need X11R5")
+
+   ww := w - 3 * (m + 20) - 2 * m
+   hh := h - 30 - 4 * m
+   BevelRectangle(win, m, m, ww, hh, -BevelWidth)
+   EraseArea(cwin, m+BevelWidth, m+BevelWidth, ww-2*BevelWidth, hh-2*BevelWidth)
+
+   # set up sliders to control the colors
+   settings := hvcrec(0.50, 0.75, 0.25)			# initial positions
+   sl := hvcrec(
+      slider(win, sethvc, 1, w-3*m-60, m, 20, h-2*m, 0.0, settings.h, 1.0),
+      slider(win, sethvc, 2, w-2*m-40, m, 20, h-2*m, 0.0, settings.v, 1.0),
+      slider(win, sethvc, 3, w-m-20, m, 20, h-2*m, 0.0, settings.c, 1.0))
+   setcolor()						# download the colors
+
+   # set up sensors for quitting
+   quitsensor(win)					# q or Q
+   button(win, "QUIT", argless, exit, m, h - m - 20, 60, 20)
+
+   # enter event loop
+   evmux(win)
+end
+
+procedure sethvc(win, i, v)		# set color component i to value v
+   settings[i] := v
+   setcolor()
+end
+
+procedure setcolor()			# set the color in the color map
+   local hue, value, chroma, s
+   hue := integer(360 * settings.h + 0.5)
+   value := integer(100 * settings.v + 0.5)
+   chroma := integer(100 * settings.c + 0.5)
+   s := "TekHVC:" || hue || "/" || value || "/" || chroma
+   Color(win, colr, s)
+   GotoXY(win, m, h - 20 - 2 * m)
+   write(win, left(s, 20))
+   return
+end
diff --git a/ipl/gprogs/img.icn b/ipl/gprogs/img.icn
new file mode 100644
index 0000000..557c41b
--- /dev/null
+++ b/ipl/gprogs/img.icn
@@ -0,0 +1,358 @@
+############################################################################
+#
+#	File:     img.icn
+#
+#	Subject:  Program to create and edit tiny images
+#
+#	Authors:  Gregg M. Townsend and Nolan Clayton
+#
+#	Date:     April 9, 2004
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  img is a simple editor of Icon image strings and other tiny images.
+#  An image size of 64 x 64 pixels is around the practical maximum.
+#
+#  usage:  img [-cn | -gn] [filename | width [height]]
+#
+#  -c or -g specifies a palette; the default is -c1.
+#
+#  An input file may contain an image string or an image readable by Icon.
+#  If no filename is given, a new image (default size 16 x 16) is created.
+#
+#  img brings up a window within which:
+#
+#	-- clicking on the color palette sets the color of that mouse button
+#	-- clicking on the cell grid sets the color of a cell
+#	-- shift-clicking on the cell grid sets the button color from the cell
+#
+#	-- pressing "W" writes the image string to standard output
+#	-- pressing "Q" writes the image string and then exits
+#	-- pressing "Z" clears all cells to the color of the left mouse button
+#	-- pressing "O" or "L" toggles palette outlining or labeling
+#	-- pressing "T" sets the left mouse button to '~' the transparent color
+#	-- pressing "R" changes pixels matching the right button color
+#		to be the color of the left button
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor
+#
+############################################################################
+
+#  To Do:
+#  clearer display of transparent button & pixels
+#  add "save as" function to write GIF (or whatever) file
+#  use standard utils for row<->image translation
+
+
+link graphics, imscolor
+
+$define Border 16		# window border
+
+$define ColorW 12		# width of color indicator
+$define ColorH 24		# height of color indicator
+
+$define LMar 150		# left margin of cell area
+$define MaxCell 24		# maximum cell size
+
+
+global rows, imspec		# current image
+global palette			# color palette
+global palx, paly, palw, palh	# palette display area
+global palf			# palette display flags
+global buttons			# button colors
+
+
+#  main program
+
+procedure main(args)
+   local wwidth, wheight
+   local hcells, vcells, cellsize, x0, y0
+   local black, white
+   local i, j, x, y, k, e, c
+   local imgstr, imgtemp, L
+
+   Window(args)
+   wwidth := WAttrib("width")			# window width
+   wheight := WAttrib("height")			# window height
+
+   palette := "c1"
+   args[1] ? if ="-" then {
+      palette := tab(0)
+      get(args)
+      }
+
+   if *args > 0 & not integer(args[1]) then {	# if filename supplied
+      imgstr := readicon(args[1])
+      palette := imspalette(imgstr)
+      hcells := imswidth(imgstr)              	# cells horizontally
+      vcells := imsheight(imgstr)		# cells vertically
+      }
+   else {
+      hcells := integer(args[1]) | 16		# cells horizontally
+      vcells := integer(args[2]) | hcells	# cells vertically
+      c := PaletteKey(palette, "white")
+      imgstr := hcells || "," || palette || "," || repl(c, vcells * hcells)
+      }
+
+   cellsize := MaxCell				# cell size on window
+   cellsize >:= wheight / (vcells + 4)
+   cellsize >:= (wwidth - LMar) / (hcells + 4)
+   if cellsize < 2 then
+      stop("image is too large for this window")
+
+   palx := Border
+   paly := Border + vcells + Border
+   palw := LMar - 2 * Border
+   palh := wheight - Border - paly
+   palf := "u"
+   drawpalette(palette, palx, paly, palw, palh, palf)
+
+   x0 := wwidth / 2 - (cellsize * hcells) / 2 + LMar / 2  # UL corner of cells
+   y0 := wheight / 2 - (cellsize * vcells) / 2
+   Fg("gray")
+   every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+      every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+         DrawRectangle(x, y, cellsize, cellsize)
+
+   black := PaletteKey(palette, "black")
+   white := PaletteKey(palette, "white")
+   buttons := table()
+   setbutton(&lpress, black)
+   setbutton(&mpress, black)
+   setbutton(&rpress, white)
+
+   imgtemp := imgstr[find(imspalette(imgstr), imgstr) : 0]
+   imgtemp := imgtemp[find(',', imgtemp) + 1 : 0]
+
+   rows := []			# list of row values
+   L := ""
+
+   every y := 1 to vcells do {
+      every x := 1 to hcells do {
+         k := imgtemp[((y - 1) * hcells) + x]
+         L ||:= k
+         Fg(PaletteColor(palette, k))
+         FillRectangle(x0 + ((x - 1) * cellsize),
+            y0 + ((y - 1) * cellsize), cellsize, cellsize)
+         }
+      put(rows, L)
+      L :=""
+      }
+
+   Fg("gray")
+   every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+      every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+         DrawRectangle(x, y, cellsize, cellsize)
+
+   newimage()
+
+   repeat case e := Event() of {
+
+      &lpress | &mpress | &rpress | &ldrag | &mdrag | &rdrag: {
+
+         # mouse on palette: set color
+         if k := pickpalette(palette, &x - palx, &y - paly, palw, palh) then {
+            case e of {
+               &lpress | &ldrag:  setbutton(&lpress, k)
+               &mpress | &mdrag:  setbutton(&mpress, k)
+               &rpress | &rdrag:  setbutton(&rpress, k)
+               }
+            next
+            }
+
+         # mouse on cell: set color
+         j := (&x - x0) / cellsize
+         i := (&y - y0) / cellsize
+         if j < 0 | j >= hcells | i < 0 | i >= vcells then
+            next
+         x := x0 + j * cellsize + 1
+         y := y0 + i * cellsize + 1
+
+         # if shifted, pick color from grid 
+         if &shift then {
+            k := rows[i + 1, j + 1]
+            case e of {
+               &lpress | &ldrag:  setbutton(&lpress, k)
+               &mpress | &mdrag:  setbutton(&mpress, k)
+               &rpress | &rdrag:  setbutton(&rpress, k)
+               }
+            next
+            }
+
+         case e of {
+            &lpress | &ldrag:  k := buttons[&lpress]
+            &mpress | &mdrag:  k := buttons[&mpress]
+            &rpress | &rdrag:  k := buttons[&rpress]
+            }
+         Fg(PaletteColor(palette, k))
+         FillRectangle(x, y, cellsize - 1, cellsize - 1)
+         rows[i + 1, j + 1] := k
+         newimage()
+         }
+
+      !"oOlL": {			# O or L: toggle outlining / labeling
+         e := map(e)
+         if palf ? find(e) then
+            palf := string(palf -- e)
+         else
+            palf ||:= e
+         drawpalette(palette, palx, paly, palw, palh, palf)
+         }
+      QuitEvents(): {			# Q (etc): quit
+         imswrite(, imspec)
+         exit()
+         }
+      !"wW": {				# W: write pattern to stdout
+         imswrite(, imspec)
+         }
+
+      !"tT": {				# T: set left mouse button transparent
+         setbutton(&lpress, '~')
+         }
+
+      !"rR": {				# R: replace colors
+         colorreplace(buttons[&rpress], buttons[&lpress])
+
+         every y := 1 to vcells do {
+            every x := 1 to hcells do {
+               k := rows[y][x]
+               Fg(PaletteColor(palette, k))
+               FillRectangle(x0 + ((x - 1) * cellsize),
+                  y0 + ((y - 1) * cellsize), cellsize, cellsize)
+               }
+            }
+
+         Fg("gray")
+         every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+            every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+               DrawRectangle(x, y, cellsize, cellsize)
+         }
+
+
+      !"zZ": {				# Z: clear pattern
+
+         k := buttons[&lpress]
+         Fg(PaletteColor(palette, k))
+         rows := list(vcells, repl(k, hcells))
+
+         FillRectangle(x0, y0, hcells * cellsize, vcells * cellsize)
+         Fg("gray")
+         every x := x0 to x0 + (hcells - 1) * cellsize by cellsize do
+            every y := y0 to y0 + (vcells - 1) * cellsize by cellsize do
+               DrawRectangle(x, y, cellsize, cellsize)
+
+         newimage()
+
+         }
+      }
+end
+
+
+#  setbutton(event, key) -- set the color of a button
+
+procedure setbutton(e, k)
+   local i, x, y
+
+   buttons[e] := k
+   i := case e of {
+      &lpress: 2
+      &mpress: 1
+      &rpress: 0
+      }
+   x := palx + palw - ColorW - i * (ColorW * 3 / 2)
+   y := (paly - ColorH) / 2
+   Fg(PaletteColor(palette, k))
+   FillArc(x, y, ColorW, ColorH)
+   Fg("black")
+   DrawArc(x, y, ColorW, ColorH)
+end
+
+
+#  newimage() -- update image (in memory and onscreen) from rows
+
+procedure newimage()
+   imspec := rowstoims(palette, rows)
+   DrawImage(Border, Border, imspec)
+   return
+end
+
+
+#  rowstoims(pal, rows) -- convert array of rows into image string
+
+procedure rowstoims(pal, rows)
+   local w, s, im
+
+   w := *rows[1] | fail
+   im := w || "," || pal || ","
+   every s := !rows do {
+      if *s ~= w then fail
+      im ||:= s
+      }
+   return im
+end
+
+
+# replacecolor(color1, color2) -- replace color1 with color2
+
+procedure colorreplace(color1, color2)
+   local i, j
+
+   every i := 1 to *rows do
+      while j := find(color1, rows[i]) do
+         rows[i][j] := color2
+
+   newimage()
+
+end
+
+
+#  readicon(fname) -- read image, returning image string
+
+procedure readicon(fname)
+   local res, f, x
+
+   f := open(fname) | stop("cannot open " || fname)
+
+   res := ""
+
+   while x := read(f) do {
+      x ? {
+         if ="#" then
+            next
+
+         ="\""
+         res ||:= tab(0)
+         }
+
+      if res[-1] == "_" then
+            res[-1] := ""
+      else
+         break
+      }
+   close(f)
+
+   #
+   # Check for reasonably valid image
+   #
+   if imsheight(res) then
+      return res
+   else {
+      if f := open(fname, "g", "image=" || fname, "canvas=hidden") then {
+         res := Capture(f, palette)
+         close(f)
+         if imsheight(res) then return res
+         }
+      stop("invalid image: " || fname)
+      }
+
+end
diff --git a/ipl/gprogs/img2grid.icn b/ipl/gprogs/img2grid.icn
new file mode 100644
index 0000000..83952fd
--- /dev/null
+++ b/ipl/gprogs/img2grid.icn
@@ -0,0 +1,65 @@
+############################################################################
+#
+#	File:     img2grid.icn
+#
+#	Subject:  Program to convert images to grids
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 29, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts an image to a grid of cells.
+#
+#  The options supported are:
+#
+#	-s i	size of grid cell; default 4
+#	-p s	save image of grid with file prefix s; default "img2grid"
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cells, options, wopen
+#
+############################################################################
+
+link cells
+link options
+link wopen
+
+procedure main(args)
+   local x, y, width, height, c, panel, opts, cellsize, prefix
+
+   opts := options(args, "s+p:")
+
+   cellsize := \opts["s"] | 4
+   prefix := \opts["p"] | "img2grid"
+
+   WOpen("image=" || args[1], "canvas=hidden") | stop("*** cannot open image")
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   panel := makepanel(width, height, cellsize)
+
+   WAttrib(panel.window, "canvas=normal")
+
+   every y := 0 to height - 1 do {
+      x := 0
+      every c := Pixel(0, y, width, 1) do {
+         colorcell(panel, x + 1, y + 1, c)
+         x +:= 1
+         }
+      }
+
+   WriteImage(panel.window, prefix || ".gif")
+
+end
diff --git a/ipl/gprogs/imgcolrs.icn b/ipl/gprogs/imgcolrs.icn
new file mode 100644
index 0000000..90b10b3
--- /dev/null
+++ b/ipl/gprogs/imgcolrs.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     imgcolrs.icn
+#
+#	Subject:  Program to list colors in images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes images whose names are given on the command line
+#  and produces a file with the lists of colors used in each.  The entries
+#  are given in the order of most to least frequent color.  The color
+#  files have the base name of the image file and the extension ".clr".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, imgcolor, wopen
+#
+############################################################################
+
+link imgcolor
+link basename
+link wopen
+
+procedure main(args)
+   local file, colors, output, name
+
+   every file := !args do {
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open image file ", file)
+         next
+         }
+     colors := imgcolor()
+     WClose()
+     name := basename(file, ".gif")
+     output := open(name || ".clr", "w") | {
+        write("*** cannot open ", name, ".clr")
+        next
+        }
+      colors := sort(colors, 4)
+      while pull(colors) do
+         write(output, pull(colors))
+      close(output)
+      &window := &null
+      }
+
+end
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
diff --git a/ipl/gprogs/imgtolst.icn b/ipl/gprogs/imgtolst.icn
new file mode 100644
index 0000000..49a4981
--- /dev/null
+++ b/ipl/gprogs/imgtolst.icn
@@ -0,0 +1,57 @@
+############################################################################
+#
+#	File:     imgtolst.icn
+#
+#	Subject:  Program to convert image to list of pixel colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts images to lists of pixel values.  The
+#  first line of output gives the dimensions of the image.
+#
+#  The extension of the image file is replaced by .lst in the list
+#  file.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wattrib, wopen
+#
+############################################################################
+
+link basename
+link wattrib
+link wopen
+
+procedure main(args)
+   local file, name, output
+
+   every file := !args do {
+      name := basename(file, ".gif")
+      output := open(name || ".lst", "w") | {
+         write(&errout, "*** cannot open ", name, ".lst")
+         next
+         }
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      write(output, "width=", Width(), " height=", Height())
+      every write(output, Pixel())
+      WClose()
+      &window := &null
+      close(output)
+      }
+
+end
diff --git a/ipl/gprogs/imlreduc.icn b/ipl/gprogs/imlreduc.icn
new file mode 100644
index 0000000..1231129
--- /dev/null
+++ b/ipl/gprogs/imlreduc.icn
@@ -0,0 +1,66 @@
+############################################################################
+#
+#	File:     imlreduc.icn
+#
+#	Subject:  Program to reduce bi-level image strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reduces bi-level image strings to their lowest equivalent
+#  form.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imxform, imscanon
+#
+############################################################################
+
+link imxform
+link imscanon
+
+procedure main()
+   local ims, imx, sorter1, sorter2
+
+   sorter1 := set()
+   sorter2 := set()
+
+   while ims := readims() do {
+      imx := imstoimx(ims)			# combine later
+      imx := imxreduce(imx)
+      ims := imxtoims(imx)
+      insert(sorter1, ims)
+      }
+
+   every ims := !sorter1 do {
+      imx := imstoimx(ims)
+      imx := imxrotate(imx, "cw")
+      ims := imxtoims(imx)
+      ims := imscanon(ims)
+      insert(sorter2, ims)
+      }
+
+   sorter1 := set()
+
+   every ims := !sorter2 do {
+      imx := imstoimx(ims)
+      imx := imxrotate(imx, "ccw")
+      ims := imxtoims(imx)
+      ims := imscanon(ims)
+      insert(sorter1, ims)
+      }
+
+   every write(!sorter1)
+      
+end
diff --git a/ipl/gprogs/imltogif.icn b/ipl/gprogs/imltogif.icn
new file mode 100644
index 0000000..4fa2bfe
--- /dev/null
+++ b/ipl/gprogs/imltogif.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     imltogif.icn
+#
+#	Subject:  Program to convert image strings to GIF files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts a list of image strings given in standard input
+#  to corresponding GIF images.
+#
+############################################################################
+#
+#  The options supported are:
+#
+#	-n s	sets prefix for image file names to s, default "image"
+#	-c i	number of columns for serial numbers in file names;
+#		  default 4
+#	-f i	first number, default 1
+#	-p	treats image string as a pattern and fills a square
+#		   window of its maximum dimension
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imageseq, imutils, numbers, options, wopen
+#
+############################################################################
+
+link imageseq
+link imutils
+link numbers
+link options
+link wopen
+
+procedure main(args)
+   local count, ims, image, w, h, s, opts, pattern, prefix
+
+   count := 0
+
+   opts := options(args, "n:c+f+p")
+   /opts["c"] := 4
+
+   seq_init(opts)
+   pattern := opts["p"]
+
+   while ims := read() do {
+      count +:= 1
+      w := imswidth(ims)
+      h := imsheight(ims)
+      if (w | h) = 0 then {
+         write(&errout, "line ", count, ": bad image string")
+         next
+         }
+      if \pattern then w := h := max(w,h)
+      image := WOpen("canvas=hidden", "size=" || w || "," || h) | {
+         write(&errout, "line ", count, ": cannot open window")
+         next
+         }
+      if \pattern then {
+         WAttrib(image, "fillstyle=opaquepatterned")
+         Pattern(image, ims)
+         FillRectangle(image)
+         }
+      else DrawImage(image, 0, 0, ims) | {
+         write(&errout, "line ", count, ":  cannot draw image")
+         WClose(image)
+         next
+         }
+      save_image(image)
+      WClose(image)
+      }
+
+end
diff --git a/ipl/gprogs/ims2pat.icn b/ipl/gprogs/ims2pat.icn
new file mode 100644
index 0000000..599ae3e
--- /dev/null
+++ b/ipl/gprogs/ims2pat.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     ims2pat.icn
+#
+#	Subject:  Program to convert image string to bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 20, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#  This program converts an image string with the g2 palette to a
+#  bi-level pattern.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imrutils, imsutils, wopen
+#
+############################################################################
+
+link imrutils
+link imsutils
+link wopen
+
+procedure main()
+   local imr
+
+   imr := imstoimr(read())
+
+   imropen(imr)
+
+   write(pix2pat(&window, 0, 0, WAttrib("width"), WAttrib("height")))
+
+end
diff --git a/ipl/gprogs/imstogif.icn b/ipl/gprogs/imstogif.icn
new file mode 100644
index 0000000..92f9521
--- /dev/null
+++ b/ipl/gprogs/imstogif.icn
@@ -0,0 +1,66 @@
+############################################################################
+#
+#	File:     imstogif.icn
+#
+#	Subject:  Program to convert image strings to GIF files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts image strings whose names are given on the command
+#  line to GIF files.  Image files are expected to have the suffix .ims.
+#
+#  The GIF files are written to files with the basenames of the image string
+#  files and the suffix "gif".
+#
+#  The following option is supported:
+#
+#	-l	read Icon literal instead of plain string
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, graphics, imrutils, options, strings
+#
+############################################################################
+
+link basename
+link graphics
+link imrutils
+link options
+link strings
+
+procedure main(args)
+   local file, opts, name, imr, input, literal
+
+   opts := options(args, "l")
+
+   literal := opts["l"]			# NOT YET IMPLEMENTED
+
+   every file := !args do {
+      name := basename(file, ".ims") || ".gif"
+      input := open(file) | {
+         write(&errout, "*** can't open ", file)
+         next
+         }
+      imr := imstoimr(read(input)) | {
+          write(&errout, "*** bad image file: ", file)
+          next
+          }
+      imropen(imr) | stop("*** bad image file: ", file)
+      close(input)
+      WriteImage(name)
+      WClose()
+      }
+
+end
diff --git a/ipl/gprogs/ipicker.icn b/ipl/gprogs/ipicker.icn
new file mode 100644
index 0000000..4ba61ae
--- /dev/null
+++ b/ipl/gprogs/ipicker.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     ipicker.icn
+#
+#	Subject:  Program to print name of selected images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays images listed on the command line and waits for
+#  user input typed into the wnodw.  If the input is the letter "y",
+#  the name of the image file is written to standard output.  If the
+#  input is "q", the program terminates.  Other input is ignored.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local name
+
+   every name := !args do {
+      WClose(\&window)
+      WOpen("image=" || name) | {
+         write(&errout, "Can't open image ", image(name))
+         next
+         }
+      case WReads(, 1) of {
+         "y":  write(name)
+         "q":  exit()
+         }
+      }
+
+end
diff --git a/ipl/gprogs/isd2disd.icn b/ipl/gprogs/isd2disd.icn
new file mode 100644
index 0000000..9a27a89
--- /dev/null
+++ b/ipl/gprogs/isd2disd.icn
@@ -0,0 +1,41 @@
+############################################################################
+#
+#	File:     isd2disd.icn
+#
+#	Subject:  Program to show convert ISD draft to drawdown form
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 1, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts an ISD to an ISD with drawdown colors.
+#
+############################################################################
+#
+#  Links:  weavutil, xcode
+#
+############################################################################
+
+link weavutil
+link xcode
+
+procedure main()
+   local draft
+
+   isd				# fly a kite, linker
+
+   draft := xdecode(&input)
+
+   draft.warp_colors := list(*draft.threading, 1)	# black
+   draft.weft_colors := list(*draft.treadling, 2)	# white
+   draft.color_list := [ColorValue("black"), ColorValue("white")]
+
+   xencode(draft, &output)
+
+end
diff --git a/ipl/gprogs/isd2gif.icn b/ipl/gprogs/isd2gif.icn
new file mode 100644
index 0000000..6df330c
--- /dev/null
+++ b/ipl/gprogs/isd2gif.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     isd2gif.icn
+#
+#	Subject:  Program to create woven image from ISD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads a internal structure draft and creates a GIF image of
+#  the corresponding weave.  The command-line option
+#
+#	-n s
+#
+#  allows the basename for the GIF file to be specified.  Otherwise, it
+#  is take from the name field of the ISD. If other command-line arguments
+#  are given, they are used as attributes for the window in which the
+#  woven image is created.
+#
+############################################################################
+#
+#  Links:  options, weavegif, weavutil, xcode
+#
+############################################################################
+
+link options
+link weavegif
+link weavutil
+link xcode
+
+procedure main(args)
+   local draft, width, spacing, bg, opts
+
+   isd			# Hands off, linker.
+
+   opts := options(args, "n:")
+
+   width := 5
+   spacing := 0
+   bg := "black"
+
+   push(args, "canvas=hidden")
+
+   draft := xdecode(&input) | stop("*** cannot decode isd")
+
+   draft.name := \opts["n"]		# override if given
+
+   if /draft.name then draft.name := "untitled"
+   /draft.width := *draft.threading
+   /draft.height := *draft.treadling
+
+   WriteImage(weavegif(draft, args),
+      draft.name || ".gif")
+
+end
diff --git a/ipl/gprogs/isd2grid.icn b/ipl/gprogs/isd2grid.icn
new file mode 100644
index 0000000..6563622
--- /dev/null
+++ b/ipl/gprogs/isd2grid.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     isd2grid.icn
+#
+#	Subject:  Program to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 25, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
+#  uses a different method than the others.  One way or another, the
+#  methods should be made consonant.
+#
+#  The option -n s allows a basename to be specified for the image file.
+#  It defaults to the name in the ISD.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  isdplot, options, wopen, xcode
+#
+############################################################################
+#
+#  Note:  The include file may contain link declarations.
+#
+############################################################################
+
+link isdplot
+link options
+link wopen
+link xcode
+
+procedure main(args)
+   local draft, win, opts
+
+   opts := options(args, "n:")
+
+   isd			# hands off, linker!
+
+   draft := xdecode(&input) | stop("*** cannot decode draft")
+
+   draft.name := \opts["n"]
+
+   win := plot(draft) | stop("*** plot() failed")
+
+   WAttrib(win, "canvas=normal")
+
+   repeat case Event(win) of {		# process low-level user events
+      !"qQ" :  exit()
+      "s"   :  WriteImage(win, draft.name || "_d.gif")
+      }
+end
diff --git a/ipl/gprogs/isd2ill.icn b/ipl/gprogs/isd2ill.icn
new file mode 100644
index 0000000..0bc9532
--- /dev/null
+++ b/ipl/gprogs/isd2ill.icn
@@ -0,0 +1,321 @@
+############################################################################
+#
+#	File:     isd2ill.icn
+#
+#	Subject:  Program to create images from ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 23, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program creates Encapsulated PostScript and GIF image files from
+#  ISDs.
+#
+#  The following options are supported:
+#
+#	-g	draw grid lines on drawdown
+#	-h	hold windows open in visible (-v) mode
+#       -p	add showpage for printing
+#	-s i	cell size, default 6
+#	-v	show images during creation; default, don't
+#
+#  Other options to be added include the control of layout and orientation.
+#
+#  Names of ISDs are taken from the command line.  For each, six Encap-
+#  PostScript files are created:
+#
+#	<base name>_tieup.eps (if given)
+#	<base name>_liftplan.eps (if given)
+#	<base name>_threading.eps
+#	<base name>_treadling.eps
+#	<base name>_drawdown.eps
+#	<base name>_pattern.eps (colored "drawdown")
+#
+#  Corresponding GIFs also are produced.
+#
+#  Future plans call for handling "shaftplans" specifying what diagrams
+#  are wanted.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, interact, options, psrecord, weavutil, xcode
+#
+############################################################################
+
+link basename
+link interact
+link options
+link psrecord
+link weavutil
+link xcode
+
+global canvas
+global cellsize
+global gridlines
+global hold
+global name
+global printing
+global draft
+
+$define CellSize 6
+
+procedure main(args)
+   local opts, input, file
+
+   isd
+
+   opts := options(args, "ghps+v")
+
+   if /opts["p"] then printing := 1
+   if \opts["v"] then {
+       canvas := "canvas=normal"
+       hold := opts["h"]		# only if images are visible
+       }
+   else canvas := "canvas=hidden"
+
+   gridlines := opts["g"]
+
+   cellsize := \opts["s"] | CellSize
+
+   while file := get(args) do {
+      input := open(file) | {
+         Notice("Cannot open " || file)
+         next
+         }
+   name := basename(file, ".isd")
+   draft := xdecode(input)
+
+   draw_panes()
+   close(input)
+   }
+
+end
+
+procedure clear_pane(win, n, m, size)
+   local x, y, width, height, save_fg
+
+   width := n * size + 1
+   height := m * size + 1
+
+   save_fg := Fg(win)
+
+   Fg(win, "black")
+
+   every x := 0 to width by size do
+      DrawLine(win, x, 0, x, height)
+
+   every y := 0 to height by size do
+      DrawLine(win, 0, y, width, y)
+
+   Fg(win, save_fg)
+
+   return
+
+end
+
+procedure draw_panes()
+   local i, j, x, y, treadle, k, treadle_list, c, color
+   local tieup_win, threading_win, treadling_win, liftplan_win
+   local drawdown_win, pattern_win
+
+   if \draft.tieup then {
+
+      tieup_win := WOpen(canvas, "width=" || (cellsize * draft.treadles + 1),
+         "height=" || (cellsize * draft.shafts + 1))
+
+      PSStart(tieup_win, name || "_tieup.eps")
+
+      clear_pane(tieup_win, draft.treadles, draft.shafts, cellsize)
+
+      every i := 1 to draft.shafts do
+         every j := 1 to draft.treadles do {
+            if draft.tieup[j, i] == "1" then 
+               fillcell(tieup_win, j, i, "black") 
+            }
+
+      PSDone(printing)
+
+      WriteImage(tieup_win, name || "_tieup.gif")
+
+      }
+
+   if *\draft.liftplan > 0 then {
+
+      liftplan_win := WOpen(canvas, "width=" || (cellsize * draft.shafts + 1),
+         "height=" || (cellsize * *draft.treadling + 1))
+
+      PSStart(liftplan_win, name || "_liftplan.eps")
+
+      clear_pane(liftplan_win, draft.shafts, *draft.treadling, cellsize)
+
+      every i := 1 to *draft.treadling do
+         every j := 1 to draft.treadles do {
+            if draft.liftplan[i, j] == "1" then 
+               fillcell(liftplan_win, j, i, "black") 
+            }
+
+      PSDone(printing)
+
+      WriteImage(liftplan_win, name || "_liftplan.gif")
+
+      }
+
+   threading_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
+      "height=" || (cellsize * draft.shafts) + 1)
+
+   PSStart(threading_win, name || "_threading.eps")
+
+   clear_pane(threading_win, *draft.threading, draft.shafts + 1, cellsize)
+
+   every i := 1 to *draft.threading do
+      fillcell(threading_win, i, draft.threading[i], "black")
+
+   PSDone(printing)
+
+   WriteImage(threading_win, name || "_threading.gif")
+
+   treadling_win := WOpen(canvas, "height=" || (cellsize * *draft.treadling + 1),
+      "width=" || (cellsize * draft.treadles + 1))
+
+   PSStart(treadling_win, name || "_treadling.eps")
+
+   clear_pane(treadling_win, draft.treadles + 1, *draft.treadling, cellsize)
+   every i := 1 to *draft.treadling do
+      fillcell(treadling_win, draft.treadling[i], i, "black")
+
+   PSDone(printing)
+
+   WriteImage(treadling_win, name || "_treadling.gif")
+
+   pattern_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
+      "height=" || (cellsize * *draft.treadling + 1))
+
+   PSStart(pattern_win, name || "_pattern.eps")
+
+   clear_pane(pattern_win, draft.shafts, draft.treadles, cellsize)
+
+   if *cset(draft.warp_colors) = 1 then {		# warp solid black
+      Fg(pattern_win, draft.color_list[draft.warp_colors[1]])
+      FillRectangle(pattern_win, 0, 0, *draft.threading * cellsize,
+         *draft.treadling * cellsize)
+      }
+   else {
+      every i := 0 to *draft.threading - 1 do {	# warp striped
+         Fg(pattern_win, draft.color_list[draft.warp_colors[i]])
+         FillRectangle(pattern_win, i * cellsize, 0, cellsize - 1,
+            *draft.treadling * cellsize)
+         }
+      }
+
+   Fg(pattern_win, "black")
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.treadles do
+      every j := 1 to draft.shafts do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *draft.treadling do {
+      treadle := draft.treadling[y]
+      color := draft.color_list[draft.weft_colors[y]]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         fillcell(pattern_win, treadle_list[treadle][i], y, color)
+      }
+
+   Fg(pattern_win, "black")
+
+   if \gridlines then {
+      every x := 0 to WAttrib(pattern_win, "width") by cellsize do
+         DrawLine(pattern_win, x, 0, x, WAttrib(pattern_win, "height"))
+      every y := 0 to WAttrib(pattern_win, "height") by cellsize do
+         DrawLine(pattern_win, 0, y, WAttrib(pattern_win, "width"), y)
+      }
+
+   PSDone(printing)
+
+   WriteImage(pattern_win, name || "_pattern.gif")
+
+   drawdown_win := WOpen(canvas, "width=" || (cellsize * *draft.threading + 1),
+      "height=" || (cellsize * *draft.treadling + 1))
+
+   PSStart(drawdown_win, name || "_drawdown.eps")
+
+   clear_pane(drawdown_win, draft.shafts, draft.treadles, cellsize)
+
+   Fg(drawdown_win, "white")
+
+   FillRectangle(drawdown_win, 0, 0, *draft.threading * cellsize,
+      *draft.treadling * cellsize)
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.treadles do
+      every j := 1 to draft.shafts do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == j then
+                  put(treadle_list[i], k, 0)
+
+   every y := 1 to *draft.treadling do {
+      treadle := draft.treadling[y]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *treadle_list[treadle] by 2 do
+         fillcell(drawdown_win, treadle_list[treadle][i], y, "black")
+      }
+
+   Fg(drawdown_win, "black")
+
+   if \gridlines then {
+      every x := 0 to WAttrib(drawdown_win, "width") by cellsize do
+         DrawLine(drawdown_win, x, 0, x, WAttrib(drawdown_win, "height"))
+      every y := 0 to WAttrib(drawdown_win, "height") by cellsize do
+         DrawLine(drawdown_win, 0, y, WAttrib(drawdown_win, "width"), y)
+      }
+
+   PSDone(printing)
+
+   WriteImage(drawdown_win, name || "_drawdown.gif")
+
+   if \hold then {
+      repeat {
+         if Event(Active()) === "q" then break
+         }
+      }
+
+   every WClose(tieup_win | \liftplan_win | threading_win | treadling_win |
+      pattern_win, drawdown_win)
+
+   return
+
+end
+
+procedure fillcell(win, n, m, color)
+   local  save_fg
+
+   save_fg := Fg(win)
+   Fg(win, color)
+
+   FillRectangle(win, (n - 1) * cellsize, (m - 1) * cellsize, cellsize,
+      cellsize)
+
+   Fg(win, save_fg)
+
+   return
+
+end
diff --git a/ipl/gprogs/isd2wif.icn b/ipl/gprogs/isd2wif.icn
new file mode 100644
index 0000000..874998c
--- /dev/null
+++ b/ipl/gprogs/isd2wif.icn
@@ -0,0 +1,134 @@
+############################################################################
+#
+#	File:     isd2wif.icn
+#
+#	Subject:  Program to produce WIF from ISD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 14, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces a WIF from an ISD.
+#
+############################################################################
+#
+#  Links:  patxform, weavutil, xcode
+#
+############################################################################
+
+link patxform
+link weavutil
+link xcode
+
+procedure main()
+   local draft, i, lift_table, line
+
+   isd				# protect from linker
+
+   draft := xdecode(&input) | stop("*** cannot decode ISD")
+
+   write("[WIF]")
+   write("Version=1.1")
+   write("Date=" || &dateline)
+   write("Developers=ralph@cs.arizona.edu")
+   write("Source Program=seqdraft.icn")
+
+   write("[CONTENTS]")
+   write("Color Palette=yes")
+   write("Text=yes")
+   write("Notes=yes")
+   write("Weaving=yes")
+   write("Tieup=yes")
+   write("Color Table=yes")
+   write("Threading=yes")
+   write("Treadling=yes")
+   write("Warp colors=yes")
+   write("Weft colors=yes")
+   write("Warp=yes")
+   write("Weft=yes")
+
+   write("[COLOR PALETTE]")
+   write("Entries=", *draft.color_list)
+   write("Form=RGB")
+   write("Range=0," || 2 ^ 16 - 1)
+
+   write("[TEXT]")
+   write("Title=", draft.name)
+   write("Author=Ralph E. Griswold")
+   write("Address=5302 E. 4th St., Tucson, AZ 85711-2304")
+   write("EMail=ralph@cs.arizona.edu")
+   write("Telephone=520-881-1470")
+   write("FAX=520-325-3948")
+
+   write("[NOTES]")
+   write("1=")
+
+
+   write("[WEAVING]")
+   write("Shafts=", draft.shafts)
+   write("Treadles=", draft.treadles)
+   write("Rising shed=yes")
+
+   write("[WARP]")
+   write("Threads=", *draft.threading)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   write("[WEFT]")
+   write("Threads=", *draft.treadling)
+   write("Units=Decipoints")
+   write("Thickness=10")
+
+   #  These are provided to produce better initial configurations when
+   #  WIFs are imported to some weaving programs.
+
+   write("[WARP THICKNESS]")
+   write("[WEFT THICKNESS]")
+
+   write("[COLOR TABLE]")
+
+   every i := 1 to *draft.color_list do
+      write(i, "=", ColorValue(draft.color_list[i]))
+
+   write("[THREADING]")
+   every i := 1 to *draft.threading do
+      write(i, "=", draft.threading[i])
+
+   write("[TREADLING]")
+   every i := 1 to *draft.treadling do
+      write(i, "=", draft.treadling[i])
+
+   write("[WARP COLORS]")
+   every i := 1 to *draft.warp_colors do
+      write(i, "=", draft.warp_colors[i])
+
+   write("[WEFT COLORS]")
+   every i := 1 to *draft.weft_colors do
+      write(i, "=", draft.weft_colors[i])
+
+   draft.tieup := protate(draft.tieup)
+
+   write("[TIEUP]")
+   every i := 1 to *draft.tieup do
+      write(i, "=", tromp(draft.tieup[i]))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
diff --git a/ipl/gprogs/isd2xgrid.icn b/ipl/gprogs/isd2xgrid.icn
new file mode 100644
index 0000000..01f8cb2
--- /dev/null
+++ b/ipl/gprogs/isd2xgrid.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     isd2xgrid.icn
+#
+#	Subject:  Program to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 4, 2002
+#
+############################################################################
+#
+#  NOTE:  The drawdown code is patched in from code in pfd2ill.icn and
+#  uses a different method than the others.  One way or another, the
+#  methods should be made consonant.
+#
+#  The option -n s allows a basename to be specified for the image file.
+#  It defaults to the name in the ISD.
+#
+#  This version is for ISDs without explicit thread-color information.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  isdxplot, options, wopen, xcode
+#
+############################################################################
+#
+#  Note:  The include file may contain link declarations.
+#
+############################################################################
+
+link isdxplot
+link options
+link wopen
+link xcode
+
+procedure main(args)
+   local draft, win, opts
+
+   opts := options(args, "n:")
+
+   isd			# hands off, linker!
+
+   draft := xdecode(&input) | stop("*** cannot decode draft")
+
+   draft.name := \opts["n"]
+
+   &dump := 1
+   win := plot(draft, "clip") | stop("*** plot() failed")
+   &dump := 0
+
+   WriteImage(win, draft.name || "_d.gif")
+
+end
diff --git a/ipl/gprogs/iview.icn b/ipl/gprogs/iview.icn
new file mode 100644
index 0000000..de6ddaa
--- /dev/null
+++ b/ipl/gprogs/iview.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     iview.icn
+#
+#	Subject:  Program to display image files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 22, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is modeled after the Unix xview(1) utility.  It takes
+#  a list of image files on the command line and displays them in
+#  order.  The character "n" typed when the mouse cursor is in the
+#  image window goes to the next image.  The character "q" terminates
+#  the display.
+#
+#  This program can, of course, only display image types that Icon
+#  understands.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local name, posx, posy
+
+   posx := posy := 20
+
+   every name := !args do {
+      WOpen("image=" || name, "posx=" || posx, "posy=" || posy) | {
+         write(&errout, "*** cannot open image: ", name)
+         next
+         }
+      repeat {
+         case Event() of {
+            "n":  {
+               posx := WAttrib("posx")
+               posy := WAttrib("posy")
+               WClose()
+               break
+               }
+            "q":  exit()
+            }
+         }
+      }
+
+end
+            
+
diff --git a/ipl/gprogs/julia1.icn b/ipl/gprogs/julia1.icn
new file mode 100644
index 0000000..5ff91d8
--- /dev/null
+++ b/ipl/gprogs/julia1.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:     julia1.icn
+#
+#	Subject:  Program to display the Julia set
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Julia set.  It
+#  has deliberately been left simple and free of options so that the
+#  basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+#  The point in the complex plane for which the Julia set is computed
+#  is given on the command line, as in
+#
+#	julia1 .360284 .100376
+#
+#  which displays the Julia set for the complex number .360284 + .100376i.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(argl)
+   local c1, c2, extent, half, quarter, m, n, x0, y0, x, y
+   local x1, y1, i, z
+
+   c1 := real(argl[1]) | -1.0		# default is -1.0 + 0.0i
+   c2 := real(argl[2]) | 0.0
+
+   extent := 200
+   half := 200 / 2
+   quarter := real(extent) / 4
+
+   WOpen("label=julia", "height=" || extent, "width=" || extent) |
+      stop("*** cannot open window")
+
+   every m := 0 to extent do {
+      x0 := -2 + m / quarter
+      every n := 0 to half do {
+         y0 := 2 - n / quarter
+         x := x0
+         y := y0
+         every i := 1 to 20 do {	# compute orbit
+            x1 := x ^ 2 - y ^ 2 + c1
+            y1 := 2 * x * y + c2
+            x := x1
+            y := y1
+            z := x ^ 2 + y ^ 2
+            if z > 4 then break next	# if escaping, forget it
+            }
+         DrawPoint(m, n)
+         DrawPoint(extent - m, extent - n)
+         }
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/kaleid.icn b/ipl/gprogs/kaleid.icn
new file mode 100644
index 0000000..11b3ed9
--- /dev/null
+++ b/ipl/gprogs/kaleid.icn
@@ -0,0 +1,381 @@
+############################################################################
+#
+#	File:     kaleid.icn
+#
+#	Subject:  Program to produce kaleidoscope
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    Lots of options, most easily set by with the interface after
+#    startup.  The only one that isn't set that way is -wn where 'n' is
+#    the size of the kaleidoscope window (default is 600 square).
+#
+#    Terminology (and options):
+#
+#	Window_size (-wN): How big of a display window to use.
+#	    At the current time, this can only be set via a
+#	    command line argument.
+#
+#	Density (-dN): How many circles per octant to keep on display
+#	    at any one time.  There is NO LIMIT to the density.
+#
+#       Duration (-lN): How long to keep drawing circles (measured in
+#	    in circles) once the density is reached.  There is NO LIMIT
+#	    to the duration.
+#
+#	MaxRadius (-MN): Maximum radius of any circle.
+#
+#	MinRadius (-mN): Preferred minimum radius.  Circles with centers
+#	    near the edge have their radii forced down to fit entirely
+#	    on the display
+#
+#       MaxOffset (-XN): Maximum offset from center of display (may wrap).
+#
+#	MinOffset (-xN): Minimum offset
+#
+#	Skew (-sN): Shift probability of placing a circle at a 'typical'
+#	    offset.
+#
+#	Fill (-F): Turns off filling the circles.
+#
+#	Clear (-C): After the duration, reduces density back to 0 before
+#	    quitting.
+#
+#	Random Seed: (-rN): Sets the random number seed.
+#
+# Thanks to Jon Lipp for help on using vidgets, and to Mary Camaron
+#   for her Interface Builder.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vidgets, vslider, vtext, vbuttons, vradio, wopen, xcompat
+#
+############################################################################
+
+link vidgets
+link vslider
+link vtext
+link vbuttons
+link vradio
+link wopen
+link xcompat
+
+global Clear, fill, duration, density, maxoff, minoff
+global maxradius, minradius, r_seed, skew, win_size, mid_win
+global root, check1, mainwin, use_dialog
+global draw_circle
+
+global du_v, de_v, rs_v, sk_v
+
+procedure main (args)
+
+   draw_circle := DrawCircle
+
+   init_globs()
+   process_args(args)
+
+   if \use_dialog then {	# have vidgets, so use them for args.
+      mainwin := WOpen("label=Kaleidoscope", "width=404", "height=313", 
+                       "font=6x12") |
+                 stop ("bad mainwin")
+      root := ui (mainwin)
+      GetEvents (root, quit)
+      }
+   else {			# just rely on command line arguments
+      kaleidoscope(r_seed)
+      }
+
+end
+
+procedure init_globs()
+
+   duration := 500                    # set default characteristics
+   density := 30
+   win_size := 600
+   minoff := 1
+   maxradius := 150
+   minradius := 1
+   skew := 1
+   fill := "On"
+   draw_circle := FillCircle
+   Clear := "Off"
+   r_seed := map("HhMmYy", "Hh:Mm:Yy", &clock)
+   # See if the Vidget library is available or not
+   if \VSet then use_dialog := "yes"
+            else use_dialog := &null
+
+end
+
+procedure process_args(args)
+   local arg
+
+   # really only needed if you don't use the dialog box
+   every arg := !args do case arg[1+:2] of {
+      "-w" : win_size := integer(arg[3:0])	 # window size
+      "-d" : density := integer(arg[3:0])        # density of circles
+      "-l" : duration := integer(arg[3:0])       # duration
+      "-M" : maxradius := integer(arg[3:0])      # maximum radius
+      "-m" : minradius := integer(arg[3:0])      # minimum radius
+      "-X" : maxoff := integer(arg[3:0])         # maximum offset
+      "-x" : minoff := integer(arg[3:0])         # minimum offset
+      "-s" : skew := numeric(arg[3:0])           # set skewedness
+      "-F" : fill := &null                       # turn off fill
+      "-C" : Clear := "yes"                      # turn on clear mode
+      "-r" : r_seed := integer(arg[3:0])         # random seed
+      "-h" : stop("usage: kal [-wn] [-dn] [-ln] [-Mn] [-mn] [-Xn] [-xn] _
+                     [-sn] [-F] [-C] [-rn]")
+      }
+   # adjust parameters that depend on the window size...
+   mid_win := win_size/2
+   maxoff := win_size-1
+end
+
+# Lorraine Callahan's kaleidoscope program, translated into icon.
+#  (some of the things she did were too sophisticated for me
+#   to spend time to figure out, so the output is square instead of
+#   round), and I use 'xor' to draw instead of writing to separate
+#   bit planes.
+
+global putcircle, clrcircle
+
+procedure kaleidoscope(r)
+   local colors
+
+   # What colors to use?  This can be changed to whatever!
+   colors := ["red","green","blue","cyan","magenta","yellow"]
+
+   &window := WOpen("label=Kaleidoscope: 'q' quits", "width="||win_size,
+                                  "height="||win_size, "bg=black")
+   WAttrib("drawop=xor")
+
+   # Create two *indentical* sequences of circles, one to use when
+   #   when drawing, one for erasing.  (Since 'xor' is used to
+   #   place them, these both just draw the circles!)
+
+   putcircle := create {                # draws sequence of circles
+      &random :=: r
+      |{
+       Fg(?colors)
+       outcircle()
+       &random <-> r
+       }
+      }
+
+   clrcircle := create {                # erases sequence of circles
+      &random :=: r
+      |{
+       Fg(?colors)
+       outcircle()
+       &random <-> r
+       }
+      }
+
+   every 1 to density do @putcircle	# fill screen to density
+
+   every 1 to duration do {		# maintain steady state
+      @putcircle
+      @clrcircle
+      if *Pending(&window) > 0 then break
+      }
+
+   every (Clear == "On") & 1 to density do @clrcircle
+
+   close(&window)
+end
+
+
+procedure outcircle()                   # select a circle at random,
+local radius, xoff, yoff                #  draw it in kaleidoscopic form
+
+	# get a random center point and radius
+   xoff := (?(maxoff - minoff) + minoff) % mid_win
+   yoff := (?(maxoff - minoff) + minoff) % mid_win
+   radius := ?0 ^ skew
+	# force radius to 'fit'
+   radius := ((maxradius-minradius) * radius + minradius) %
+             (mid_win - ((xoff < yoff)|xoff))
+
+	# put into all 8 octants
+   draw_circle(mid_win+xoff, mid_win+yoff, radius)
+   draw_circle(mid_win+xoff, mid_win-yoff, radius)
+   draw_circle(mid_win-xoff, mid_win+yoff, radius)
+   draw_circle(mid_win-xoff, mid_win-yoff, radius)
+
+   draw_circle(mid_win+yoff, mid_win+xoff, radius)
+   draw_circle(mid_win+yoff, mid_win-xoff, radius)
+   draw_circle(mid_win-yoff, mid_win+xoff, radius)
+   draw_circle(mid_win-yoff, mid_win-xoff, radius)
+
+   return
+end
+
+
+############################################################################
+#
+#   Vidget-based user interface -- developed originally using Mary
+#	Camaron's XIB program.  Don't expect this to be very readable -
+#	you should have to play with it!
+#
+############################################################################
+procedure ui (win)
+   local cv1, cv2, cv3, cv4
+   local 
+         radio_button2, 
+         radio_button1, 
+         text_input6, 
+         text_input5, 
+         slider4, 
+         slider3, 
+         text_input4, 
+         text_input3, 
+         slider2, 
+         slider1 
+
+   /win := WOpen("label=ui", "width=404", "height=313", "font=6x12") | 
+           stop ("bad win")
+   root := Vroot_frame (win)
+
+   VInsert (root, Vmessage(win, win_size/2), 168, 98)
+   VInsert (root, Vmessage(win, "1"), 108, 97)
+
+   VInsert (root, sk_v := Vtext(win,"Skew:\\=1",get_skew,,6), 280, 39)
+
+   VInsert (root, du_v := Vtext(win, "Duration:\\="||duration, get_duration,,9),
+                237, 15)
+
+   VInsert (root, Vmessage(win, "Clear at end?"), 232, 145)
+   VInsert (root, Vmessage(win, "Fill?"), 105, 142)
+   VInsert (root, Vmessage(win,"Quit?"), 267, 259)
+   VInsert (root, Vmessage(win,"Display it?"), 26, 260)
+
+   VInsert (root, Vcheckbox(win, do_quit, "check2",20), 305, 255, 20, 20)
+
+   VInsert (root, check1:=Vcheckbox(win, do_display, "check1",20),
+                106, 258, 20, 20)
+
+   radio_button2 := Vradio_buttons (win, ["On", "Off"], get_clear, , V_CIRCLE)
+   VSet(radio_button2,Clear)
+   VInsert (root, radio_button2, 253, 165)
+
+   radio_button1 := Vradio_buttons (win, ["On", "Off"], get_fill, , V_CIRCLE)
+   VSet(radio_button1,fill)
+   VInsert (root, radio_button1, 99, 165)
+
+   cv1 := Vcoupler()
+   VAddClient(cv1, get_max_offset)
+   text_input6 := Vtext (win, "Max Offset:\\="||(win_size-1), cv1, , 3)
+   VAddClient(cv1, text_input6)
+   slider4 := Vhoriz_slider (win, cv1, "slider4", 70, 12, 0,
+                         win_size-1, win_size-1, )
+   VAddClient(cv1, slider4)
+   VInsert (root, text_input6, 196, 103)
+   VInsert (root, slider4, 306, 106)
+
+   cv2 := Vcoupler()
+   VAddClient(cv2, get_min_offset)
+   text_input5 := Vtext (win, "Min Offset\\=1", cv2, , 3)
+   VAddClient(cv2, text_input5)
+   slider3 := Vhoriz_slider (win, cv2, "slider3", 70, 12, 1, win_size-1, 1, )
+   VAddClient(cv2, slider3)
+   VInsert (root, text_input5, 201, 80)
+   VInsert (root, slider3, 307, 82)
+
+   cv3 := Vcoupler()
+   VAddClient(cv3, get_max_radius)
+   text_input4 := Vtext (win, "Max Radius\\="||(win_size/4), cv3, , 3)
+   VAddClient(cv3, text_input4)
+   slider2 := Vhoriz_slider (win, cv3, "slider2", 70, 12, 1, win_size/2,
+         win_size/4, )
+   VAddClient(cv3, slider2)
+   VInsert (root, text_input4, 10, 104)
+   VInsert (root, slider2, 110, 108)
+
+   cv4 := Vcoupler()
+   VAddClient(cv4, get_min_radius)
+   text_input3 := Vtext (win, "Min Radius\\=1", cv4, , 3)
+   VAddClient(cv4, text_input3)
+   slider1 := Vhoriz_slider (win, cv4, "slider1", 70, 12, 1, win_size/2, 1, )
+   VAddClient(cv4, slider1)
+   VInsert (root, text_input3, 10, 81)
+   VInsert (root, slider1, 110, 84)
+
+   VInsert (root, rs_v := Vtext(win,"Random Seed:\\="||r_seed, get_random,, 11),
+              30, 41)
+   VInsert (root, de_v := Vtext(win,"Density:\\="||density, get_density,,8),
+              71, 16)
+
+   VResize (root)
+   return root
+end
+
+procedure get_skew (wit, value)
+   skew := value
+end
+
+procedure get_duration (wit, value)
+   duration := value
+end
+
+procedure do_quit (wit, value)
+   stop()
+end
+
+procedure do_display (wit, value)
+   r_seed   := numeric(rs_v.data)
+   duration := integer(du_v.data)
+   density  := integer(de_v.data)
+   skew     := integer(sk_v.data)
+   kaleidoscope(r_seed)
+   wit.callback.value := &null
+   VDraw(check1)
+end
+
+procedure get_clear (wit, value)
+   Clear := value
+end
+
+procedure get_fill (wit, value)
+   fill := value
+   if fill == "Off" then draw_circle := DrawCircle
+   else draw_circle := FillCircle
+end
+
+procedure get_max_offset (wit, value)
+   maxoff := value
+end
+
+procedure get_min_offset (wit, value)
+   minoff := value
+end
+
+procedure get_max_radius (wit, value)
+   maxradius := value
+end
+
+procedure get_min_radius (wit, value)
+   minradius := value
+end
+
+procedure get_random (wit, value)
+   r_seed := integer(value)
+end
+
+procedure get_density (wit, value)
+   density := integer(value)
+end
+
+procedure quit(e)
+   if e === "q" then stop ("Exiting Kaleidoscope")
+end
diff --git a/ipl/gprogs/kaleido.icn b/ipl/gprogs/kaleido.icn
new file mode 100644
index 0000000..48f1364
--- /dev/null
+++ b/ipl/gprogs/kaleido.icn
@@ -0,0 +1,337 @@
+############################################################################
+#
+#	File:     kaleido.icn
+#
+#	Subject:  Program to produce kaleidoscopic display
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 16, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays kaleidoscopic images.  The controls on the
+#  user interface are relatively intuitive -- trying them will give
+#  a better idea of what's possible than a prose description here.
+#
+#  This program is based on an earlier one by Steve Wampler, which in
+#  turn was based on a C program by Lorraine Callahan.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, random, vsetup
+#
+############################################################################
+
+link interact
+link random
+link vsetup
+
+#  Interface globals
+
+global vidgets				# table of vidgets
+global root				# root vidget
+global pause				# pause vidget
+global size				# size of view area (width & height)
+global half				# half size of view area
+global pane				# graphics context for viewing
+global colors				# list of colors
+
+#  Parameters that can be set from the interface
+
+global delay				# delay between drawing circles
+global density				# number of circles in steady state
+global draw_proc			# drawing procedure
+global max_off				# maximum offset of circle
+global min_off				# minimum offset of circle
+global max_radius			# maximum radius of circle
+global min_radius			# minimum radius of circle
+global scale_radius			# radius scale factor
+
+#  State information
+
+global draw_list			# list of pending drawing parameters
+global reset				# nonnull when view area needs resetting
+
+#  Record for circle data
+
+record circle(off1, off2, radius, color)
+
+$define DelayFactor	200
+$define DensityMax	100
+
+$define SliderMax	10.0		# shared knowledge
+$define SliderMin	1.0
+
+procedure main()
+
+   init()
+
+   kaleidoscope()
+
+end
+
+procedure init()
+   local s
+
+   randomize()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+   size := vidgets["region"].uw
+   if vidgets["region"].uh ~= size then stop("*** improper interface layout")
+
+   delay := 0.5
+   density := DensityMax / 2.0
+   max_radius := SliderMax			# scaled later
+   min_radius := SliderMin
+   scale_radius := (size / 4) / SliderMax
+
+   draw_proc := FillCircle
+
+   colors := []
+   s := PaletteChars("c3") -- PaletteGrays("c3")
+   every put(colors, PaletteColor("c3", !s))
+
+   pause := vidgets["pause"]
+
+   VSetState(pause, 1)
+   VSetState(vidgets["density"], (density / DensityMax) * SliderMax)
+   VSetState(vidgets["delay"], delay)
+   VSetState(vidgets["min_radius"], min_radius * 2)
+   VSetState(vidgets["max_radius"], max_radius / 2)
+   VSetState(vidgets["shape"], "discs")
+
+#  Get graphics context for drawing.
+
+   half := size / 2
+
+   pane := Clone("bg=black", "dx=" || (vidgets["region"].ux + half),
+      "dy=" || (vidgets["region"].uy + half), "drawop=reverse")
+   Clip(pane, -half, -half, size, size)
+
+   return
+
+end
+
+procedure kaleidoscope()
+
+   #  Each time through this loop, the display is cleared and a
+   #  new drawing is started.
+
+   repeat {
+
+      EraseArea(pane, -half, -half, size, size)	# clear display
+      draw_list := []				# new drawing list
+      reset := &null
+
+      #  In this loop a new circle is drawn and an old one erased, once the
+      #  specified density has been reached.  This maintains a steady state.
+
+      repeat {
+         while (*Pending() > 0) | \VGetState(pause) do {
+            ProcessEvent(root, , shortcuts)
+            if \reset then break break next
+            }
+         putcircle()
+         WDelay(delay)
+
+         #  Don't start clearing circles until the specified density has
+         #  reached. (The drawing list has four elements for each circle.)
+
+         if *draw_list > density then clrcircle()
+         }
+      }
+
+end
+
+procedure putcircle()
+   local off1, off2, radius, color
+
+   # get a random center point and radius
+
+   off1 := ?size % half
+   off2 := ?size % half
+   radius := ((max_radius - min_radius) * ?0 + min_radius) * scale_radius
+   radius <:= 1			# don't let them vanish
+
+   color := ?colors
+   
+   put(draw_list, circle(off1, off2, radius, color))
+
+   outcircle(off1, off2, radius, color)
+
+   return
+
+end
+
+procedure clrcircle()
+   local circle
+
+   circle := get(draw_list)
+
+   outcircle(
+     circle.off1,
+     circle.off2,
+     circle.radius,
+     circle.color
+     )
+
+   return
+
+end
+
+procedure outcircle(off1, off2, radius, color)
+
+   Fg(pane, color)
+
+   # Draw in symmetric positions.
+
+   draw_proc(pane, off1, off2, radius)
+   draw_proc(pane, off1, -off2, radius)
+   draw_proc(pane, -off1, off2, radius)
+   draw_proc(pane, -off1,-off2, radius)
+   draw_proc(pane, off2, off1, radius)
+   draw_proc(pane, off2, -off1, radius)
+   draw_proc(pane, -off2, off1, radius)
+   draw_proc(pane, -off2,-off1, radius)
+
+   return
+
+end
+
+procedure density_cb(vidget, value)
+
+   density := (value / SliderMax) * DensityMax
+   density <:= 1
+
+   reset := 1
+
+end
+
+procedure delay_cb(vidget, value)
+
+   delay := value * DelayFactor
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot @S":  snapshot(pane, -half, -half, size, size)
+      "quit     @Q":  exit()
+      }
+
+   return
+
+end
+
+procedure max_radius_cb(vidget, value)
+
+   max_radius := value
+
+   if max_radius < min_radius then {	# if max < min lower min
+      min_radius := max_radius
+      VSetState(vidgets["min_radius"], min_radius)
+      }
+
+   reset := 1
+
+   return
+
+end
+
+procedure min_radius_cb(vidget, value)
+
+   min_radius := value
+
+   if min_radius > max_radius then {	# if min > max raise max
+      max_radius := min_radius
+      VSetState(vidgets["max_radius"], max_radius)
+      }
+
+   reset := 1
+
+   return
+
+end
+
+procedure reset_cb(vidget, value)
+
+   reset := 1
+
+   return
+
+end
+
+procedure shape_cb(vidget, value)
+
+   draw_proc := case value of {
+     "discs":  FillCircle
+     "rings":  DrawCircle
+     }
+
+   reset := 1
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {			# fold case
+         "q":	exit()
+         "s":	snapshot(pane, -half, -half, size, size)
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,455", "bg=pale gray", "label=kaleido"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,455:kaleido",],
+   ["delay:Slider:h:1:42,120,100,15:1.0,0.0,0.5",delay_cb],
+   ["density:Slider:h:1:42,180,100,15:0.0,10.0,10.0",density_cb],
+   ["file:Menu:pull::3,1,36,21:File",file_cb,
+      ["snapshot @S","quit     @Q"]],
+   ["label01:Label:::13,180,21,13:min",],
+   ["label02:Label:::152,180,21,13:max",],
+   ["label03:Label:::13,240,21,13:min",],
+   ["label04:Label:::152,240,21,13:max",],
+   ["label05:Label:::13,300,21,13:min",],
+   ["label06:Label:::152,300,21,13:max",],
+   ["label07:Label:::7,120,28,13:slow",],
+   ["label08:Label:::151,120,28,13:fast",],
+   ["lbl_density:Label:::67,160,49,13:density",],
+   ["lbl_max_radius:Label:::43,280,98,13:maximum radius",],
+   ["lbl_min_radius:Label:::44,220,98,13:minimum radius",],
+   ["lbl_speed:Label:::74,100,35,13:speed",],
+   ["line:Line:::0,22,600,22:",],
+   ["max_radius:Slider:h:1:42,300,100,15:0.0,10.0,10.0",max_radius_cb],
+   ["min_radius:Slider:h:1:42,240,100,15:0.0,10.0,1.0",min_radius_cb],
+   ["pause:Button:regular:1:33,55,45,20:pause",],
+   ["reset:Button:regular::111,55,45,20:reset",reset_cb],
+   ["shape:Choice::2:66,359,64,42:",shape_cb,
+      ["discs","rings"]],
+   ["region:Rect:raised::187,40,400,400:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/keypunch.icn b/ipl/gprogs/keypunch.icn
new file mode 100644
index 0000000..8eca136
--- /dev/null
+++ b/ipl/gprogs/keypunch.icn
@@ -0,0 +1,166 @@
+############################################################################
+#
+#	File:     keypunch.icn
+#
+#	Subject:  Program to simulate a keypunch
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     February 7, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     In the olden days, computer data was encoded by rectangular holes
+#  punched in thin pieces of cardboard about the size of an old dollar.
+#  This program simulates a "keypunch", a mechanical device for punching
+#  those holes.  (Keypunches themselves were programmable, but there's
+#  no way to program this one; tab stops are set permanently.)
+#
+#     A carriage return feeds a new card.  Illegal characters punch a
+#  lace column.  As with a real keypunch, you can backspace, but the
+#  holes don't go away.
+#
+#     The shift key turns "UIOJKLM<>" into "123456789".  The meta key
+#  serves (imperfectly) as the multipunch key.
+#
+#     The font was chosen on a Sun workstation and may not be portable.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, graphics
+#
+############################################################################
+
+
+link options
+link optwindw
+link graphics
+
+
+global hsiz, vsiz, hsep, vsep, tsep, bsep, lsep, rsep
+
+procedure main(args)
+   local win, col, card, c, s, opts
+
+   opts := options(args, winoptions())
+
+   s := ""
+   while s ||:= get(args) || " "
+
+   hsiz := 5
+   vsiz := 12
+   hsep := 3
+   vsep := 12
+   tsep := 20
+   bsep := 20
+   lsep := 20
+   rsep := 20
+
+   /opts["B"] := "pale moderate reddish yellow"
+   /opts["W"] := lsep + 80 * hsiz + 79 * hsep + rsep
+   /opts["H"] := tsep + 12 * vsiz + 11 * vsep + bsep
+   win := optwindow(opts)
+   card := WOpen("canvas=hidden", "width="||opts["W"], "height="||opts["H"])
+
+   Font(win, "-misc-fixed-medium-r-semi*--13-120-*")
+   initcard(win)
+   CopyArea(win, card)
+
+   col := 1
+   every c := !map(s, &lcase, &ucase) | keyevent(win) do {
+      if upto('\^c\^d\d', c) then
+         exit()
+      else if upto('\n\r\^u', c) then {
+         CopyArea(card, win)
+         col := 1
+         }
+      else if c == '\b' then {
+         if (col -:= 1) < 1 then
+            col := 1
+         key(win, col, " ")
+         }
+      else if c == '\t' then {
+         col := col + 10 - (col - 1) % 10
+         if col > 80 then
+            col := 80
+         }
+      else {
+         key(win, col, map(c, &lcase, &ucase))
+         if ((not &meta) & (col +:= 1)) > 80 then
+            col := 80
+         }
+      GotoXY(win, lsep + col * (hsiz + hsep), tsep / 2)
+      }
+end
+
+
+procedure keyevent(win)
+   local e
+   repeat {
+      e := Event(win)
+      if type(e) == "string" then {
+         if &shift | &meta then
+            suspend map(e, "uiojklm,.UIOJKLM<>", "123456789123456789")
+         else
+            suspend map(e, &lcase, &ucase)
+         }
+      }
+end
+
+
+procedure initcard(win)
+   local i, c
+
+   EraseArea(win)
+   GotoXY(win, lsep, tsep / 2)
+   every i := 12 to 3 by -1 do {
+      c := "  0123456789"[i]
+      every punch(win, 1 to 80, i, c)
+      }
+end
+
+
+procedure key(win, col, ch)
+   Fg(win, "black")
+   every punch(win, col, holes(ch))
+   punch(win, col, 0, ch)
+end
+
+
+procedure punch(win, col, row, ch)
+   local x, y, w, h
+   x := lsep + (col - 1) * (hsiz + hsep)
+   if row = 0 then
+      y := 0
+   else
+      y := tsep + (row - 1) * (vsiz + vsep)
+   if \ch then
+      DrawString(win, x, y + vsiz - 3, ch)
+   else
+      FillRectangle(win, x, y, hsiz, vsiz)
+end
+
+
+# Hole codes from CDC SCOPE 3.4 SPRM, Rev. A, 10-15-71, page A-4 (026 encoding).
+
+procedure holes(c)
+   static s0, s1, s2, s3, n
+   initial {
+      s0 := " 0123456789+ABCDEFGHI-JKLMNOPQR/STUVWXYZ:=@%'[.)^;]$*@?>!,(_#&\"\\"
+      s1 := "           AAAAAAAAAABBBBBBBBBB000000000     AAAAABBBBBB000000 A"
+      s2 := " 0123456789 123456789 123456789123456789235672346723456723456745"
+      s3 := "                                        888888888888888888888888"
+      }
+   if n := find(c, s0) then
+      suspend find((s1 | s2 | s3)[n], "AB0123456789")
+   else
+      suspend 1 to 12
+end
diff --git a/ipl/gprogs/koch.icn b/ipl/gprogs/koch.icn
new file mode 100644
index 0000000..535073f
--- /dev/null
+++ b/ipl/gprogs/koch.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#       File:     koch.icn
+#
+#	Subject:  Program to demonstrate Koch curves
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     October 14, 1992
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program shows how Koch curves work.
+#
+#	See the procedure 'helpmsg' for command line options
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links: glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local arg, nextarg
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       }
+
+    win := WOpen("label=Koch Snowflake", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+
+#    koch_line(Window, point(0.25,0.25), point(0.75,0.25), 5)
+#    koch_line(Window, point(0.75,0.25), point(0.50,0.67), 5)
+#    koch_line(Window, point(0.50,0.67), point(0.25,0.25), 5)
+
+    koch_line(Window, point(0.00,0.67), point(0.50,0.67), 5)
+    koch_line(Window, point(0.50,0.67), point(0.25,0.25), 5)
+    koch_line(Window, point(0.25,0.25), point(0.00,0.67), 5)
+
+    koch_line(Window, point(0.25,0.25), point(0.50,0.67), 5)
+    koch_line(Window, point(0.50,0.67), point(0.75,0.25), 5)
+    koch_line(Window, point(0.75,0.25), point(0.25,0.25), 5)
+
+    koch_line(Window, point(0.50,0.67), point(1.00,0.67), 5)
+    koch_line(Window, point(1.00,0.67), point(0.75,0.25), 5)
+    koch_line(Window, point(0.75,0.25), point(0.50,0.67), 5)
+
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Koch")
+   return
+end
diff --git a/ipl/gprogs/lindcomp.icn b/ipl/gprogs/lindcomp.icn
new file mode 100644
index 0000000..67891f9
--- /dev/null
+++ b/ipl/gprogs/lindcomp.icn
@@ -0,0 +1,117 @@
+############################################################################
+#
+#	File:     lindcomp.icn
+#
+#	Subject:  Program to compile 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 13, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts a 0L-system to an Icon program, which when
+#  executed, produces the corresponding drawing.
+#
+############################################################################
+#
+#  See also:  linden.icn
+#
+############################################################################
+
+global procs
+
+procedure main()
+   local line, sym, new, keyword, value, axiom, gener, angle, length
+   local replace
+
+   procs := table()			# table of procedures to generate
+
+   gener := 4				# defaults
+   length := 5
+   angle := 90.0
+
+   while line := read() do
+      line ? {
+         if sym := tab(find("->")) then {
+            move(2)
+            replace := tab(0)
+            procs[sym] := replace
+            }
+         else if keyword := tab(find(":")) then {
+            move(1)
+            value := tab(0)
+            case keyword of {
+               "axiom":   axiom := value
+               "gener":   gener := integer(value) |
+                     stop("*** invalid generation specification")
+               "angle":   angle := real(value) |
+                     stop("*** invalid angle: ", line)
+               "length": length := integer(value) |
+                     stop("*** invalid length: ", line)
+               "name":    &null			# ignore name
+               default:   stop("*** invalid keyword: ", line)
+               }
+            }
+         else stop("*** invalid specification: ", line)
+         }
+
+   # Write heading and main procedure
+
+   write("link turtle")
+   write()
+   write("$define Generations ", gener)
+   write("$define Angle ", angle)
+   write("$define Length ", length)
+   write()
+   write("procedure main()")
+   gencode(axiom, "Generations")
+   write("end")
+   write()
+
+   # Produce drawing procedures.
+
+   every sym := key(procs) do
+      genproc(sym, procs[sym])
+
+end
+
+procedure gencode(replace, arg)
+   local sym
+
+   every sym := !replace do {
+      case sym of {
+         "+":   write("      TRight(Angle)	# +")
+         "-":   write("      TLeft(Angle)	# -")
+         "[":   write("      TSave()		# [")
+         "]":   write("      TRestore()	# ]")
+         default:   if \procs[sym]
+            then write("      ", sym, "(", arg, ")	# ", sym)
+         }
+      }
+
+   return
+
+end
+
+procedure genproc(name, replace)
+
+   write("procedure ", name, "(gener)")
+   write("   if gener > 0 then {")
+   gencode(replace, "gener - 1")
+   write("      }")
+   case name of {
+      "F":   write("   else TDraw(Length)	# F")
+      "f":   write("   else TSkip(Length)	# f")
+      }
+   write("   return")
+   write("end")
+   write()
+
+   return
+
+end
diff --git a/ipl/gprogs/linden.icn b/ipl/gprogs/linden.icn
new file mode 100644
index 0000000..c805949
--- /dev/null
+++ b/ipl/gprogs/linden.icn
@@ -0,0 +1,213 @@
+############################################################################
+#
+#	File:     linden.icn
+#
+#	Subject:  Program to generate sentences in 0L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads in a 0L-system (Lindenmayer system) consisting of
+#  rewriting rules in which a string is rewritten with every character
+#  replaced simultaneously (conceptually) by a specified string of
+#  symbols.
+#
+#  Rules have the form
+#
+#	S->SSS...
+#
+#  where S is a character.
+#
+#  In addition to rules, there are keywords that describe the system and how
+#  to draw it.  These include the "axiom" on which rewriting is started and
+#  optionally the angle in degrees between successive lines (default 90).
+#  Other keywords may be present, but are ignored.
+#
+#  Keywords are followed by a colon.
+#
+#    An example 0L-system is:
+#
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	-->-
+#	+->+
+#	axiom:FX
+#	angle:45.0
+#	xorg:100
+#	yorg:100
+#
+#  Here, the initial string is "FX" and angular increment is 45 degrees.
+#  Note that "-" is a legal character in a 0L-system -- context determines
+#  whether it's 0L character or part of the "->" that stands for "is
+#  replaced by".
+#
+#  If no rule is provided for a character, the character is not changed
+#  by rewriting. Thus, the example above can be expressed more concisely
+#  as
+#
+#	X->-FX++FY-
+#	Y->+FX--FY+
+#	F->
+#	axiom:FX
+#	angle:45.0
+#
+#  The recognized keywords are:
+#
+#	axiom	axiom for generation
+#	angle	angular increment for turns
+#	length	segment length
+#	xorg	x origin
+#	yorg	y origin
+#	comment	comment; ignored
+#
+#  Distances increase from left to right in the x direction and from top
+#  to bottom in the y direction.
+#
+#  As pure-production systems, the characters are symbolic and have no
+#  meaning.  When interpreted for drawing, the characters have the
+#  following meaning:
+#
+#	F	move forward by length
+#	f	move backward by length
+#	+	turn right by angle
+#	-	turn left by angle
+#	[	save current state
+#	]	restore current state
+#
+#  The file containing the 0L-systems is read from standard input.
+#
+#  The command-line options are:
+#
+#	-g i	number of generations, default 3
+#	-l i	length of line segments, default 5
+#	-a i	angular increment in degrees (overrides angle given in
+#		  the grammar)
+#	-w i	window width
+#	-h i	window height
+#	-x i	initial x position, default mid-window
+#	-y i	initial y position, default mid-window
+#	-W	write out string instead of drawing
+#	-s	take snapshot of image.
+#	-d i	delay in milliseconds between symbol interpretations;
+#		  default 0
+#
+#  NOTE:  The name option that supported multiple L-Systems in
+#         one file has been eliminated on the grounds that it
+#         introduced too much complexity in use.
+#
+############################################################################
+#
+#  References:
+#
+#     Formal Languages, Arto Salomaa, Academic Press, 1973. pp. 234-252.
+#
+#     The Algorithmic Beauty of Plants, Przemyslaw Prusinkiewicz and
+#     Aristid Lindenmayer, Springer Verlag, 1990.
+#
+#     Lindenmayer Systems, Fractals, and Plants, Przemyslaw Prusinkiewicz and
+#     James Hanan, Springer Verlag, 1989.
+#
+############################################################################
+#
+#  See linden.dat for an example of input data.
+#
+############################################################################
+#
+#  Requires:  graphics if drawing
+#
+############################################################################
+#
+#  Links: linddraw, options, wopen
+#
+############################################################################
+
+link linddraw
+link options
+link wopen
+
+procedure main(args)
+   local line, gener, axiom, angle, opts, i, s, c, symbol, rewrite
+   local allchars, rhs, value, spec, x, y, length, w, h, delay, name
+
+   rewrite := table()
+   allchars := ''			# cset of all rhs characters
+ 
+   opts := options(args,"g+l+a+w+h+x+y+Wsd+")
+
+   rhs := ''
+
+   while line := read() do
+      line ? {
+         if symbol := move(1) & ="->" then {
+            rhs := tab(0)
+            rewrite[symbol] := rhs
+            allchars ++:= rhs			# keep track of all characters
+            }
+         else if spec := tab(upto(':')) then {
+            move(1)
+            value := tab(0)
+            case spec of {
+               "axiom":    {
+                  axiom := value
+                  allchars ++:= rhs		# axiom might have strays
+                  }
+               "angle":    angle := value
+               "xorg":     x := value
+               "yorg":     y := value
+               "comment":  &null		# ignore comments
+               "length":   length := value   
+               "gener":    gener := value   
+               "name":     name := value
+               }				# ignore others
+            }
+         else write(&errout, "malformed input: ", tab(0))
+         }
+
+#  At this point, we have the table to map characters, but it may lack
+#  mappings for characters that "go into themselves" by default.  For
+#  efficiency in rewriting, these mappings are added.
+
+   every c := !allchars do
+     /rewrite[c] := c
+
+   h := \opts["h"] | 400
+   w := \opts["w"] | 400
+
+   angle := \opts["a"]			# command-line overrides
+   length := \opts["l"]
+   gener := \opts["g"]
+   x := \opts["x"]
+   y := \opts["y"]
+   delay := \opts["d"]
+
+   /angle := 90				# defaults
+   /length := 5
+   /gener := 3
+   /x := 0
+   /y := 0
+   /delay := 0
+   /name := "intitled"
+
+   if /axiom then stop("*** no axiom")
+
+   if /opts["W"] then {
+      WOpen("size=" || w || "," || h, "dx=" || (w / 2),
+      "dy=" || (h / 2)) | stop("*** cannot open window")
+      linddraw(x, y, axiom, rewrite, length, angle, gener, delay)
+      if \opts["s"] then WriteImage(name || ".gif")
+      WDone()
+      }
+   else {
+      every writes(lindgen(!axiom, rewrite, gener))
+      write()
+      }
+
+end
diff --git a/ipl/gprogs/lorenz.icn b/ipl/gprogs/lorenz.icn
new file mode 100644
index 0000000..d52c239
--- /dev/null
+++ b/ipl/gprogs/lorenz.icn
@@ -0,0 +1,118 @@
+############################################################################
+#
+#	File:     lorenz.icn
+#
+#	Subject:  Program to display Lorenz strange attractor
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Lorenz strange
+#  attractor.  It has deliberately been left simple and free of options so
+#  that the basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Fractal, Programming in
+#  Turbo Pascal", Roger T. Stevens, M&T Books, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, wopen
+#
+############################################################################
+
+link numbers
+link wopen
+
+procedure main()
+   local col, color, colorlist, cx, cy, cz, d0_x, d0_y, d0_z, d1_x
+   local d1_y, d1_z, d2_x, d2_y, d2_z, d3_x, d3_y, d3_z, dt, dt2
+   local i, old_col, old_row, old_y, row, sx, sy, sz, x, x_angle
+   local xt, y, y_angle, yt, z, z_angle, zt
+
+   x_angle  :=  rtod(45)
+   sx  :=  sin(x_angle)
+   cx  :=  cos(x_angle)
+   y_angle  :=  rtod(0)
+   sy  :=  sin(y_angle)
+   cy  :=  cos(y_angle)
+   z_angle  :=  rtod(90)
+   sz  :=  sin(z_angle)
+   cz  :=  cos(z_angle)
+
+   WOpen("label=Lorenz", "width=640", "height=350",
+      "fg=white", "bg=black") | stop("*** cannot open window")
+
+   colorlist := ["red", "blue", "green", "magenta", "cyan", "yellow"]
+
+   color := colorlist[1]
+
+   x  :=  0.0
+   y  :=  1.0
+   z  :=  0.0
+   old_col  :=  round(y * 9 + 320)
+   old_row  :=  round(350 - 6.56 * z)
+   dt  :=  0.01
+   dt2  :=  dt / 2
+   every i := 0 to 8000 do {
+      d0_x  :=  10 * (y-x) * dt2
+      d0_y  :=  (-x * z + 28 * x - y) * dt2
+      d0_z   :=  (x * y - 8 * z / 3) * dt2
+      xt  :=  x + d0_x
+      yt  :=  y + d0_y
+      zt  :=  z + d0_z
+      d1_x  :=  (10 * (yt-xt)) * dt2
+      d1_y  :=  (-xt * zt + 28 * xt - yt) * dt2
+      d1_z   := (xt * yt - 8 * zt / 3) * dt2
+      xt  :=  x + d1_x
+      yt  :=  y + d1_y
+      zt  :=  z + d1_z
+      d2_x  :=  (10 * (yt-xt)) * dt
+      d2_y  :=  (-xt * zt + 28 * xt - yt) * dt
+      d2_z   := (xt * yt - 8 * zt / 3) * dt
+      xt  :=  x + d2_x
+      yt  :=  y + d2_y
+      zt  :=  z + d2_z
+      d3_x  :=  (10 * (yt - xt)) * dt2
+      d3_y  :=  (-xt * zt + 28 * xt - yt) * dt2
+      d3_z  :=  (xt * yt - 8 * zt / 3) * dt2
+                     old_y  :=  y
+      x  :=  x + (d0_x + d1_x + d1_x + d2_x + d3_x) * 0.333333333
+      y  :=  y + (d0_y + d1_y + d1_y + d2_y + d3_y) * 0.333333333
+      z  :=  z +  (d0_z + d1_z + d1_z + d2_z + d3_z) * 0.333333333
+
+      col  :=  round(y * 9 + 320)
+      row  :=  round(350 - 6.56 * z)
+
+      if col < 320 then
+         if old_col >= 320 then {
+            color := get(colorlist)
+            put(colorlist, color)
+            }
+      else if col > 320 then
+         if old_col <= 320 then {
+            color := get(colorlist)
+            put(colorlist, color)
+            }
+
+      Fg(color)
+      DrawLine(old_col, old_row, col, row)
+      old_row := row
+      old_col := col
+ 
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/lsys.icn b/ipl/gprogs/lsys.icn
new file mode 100644
index 0000000..3f18c3a
--- /dev/null
+++ b/ipl/gprogs/lsys.icn
@@ -0,0 +1,151 @@
+############################################################################
+#
+#       File:     lsys.icn
+#
+#	Subject:  Program to experiment with Lindenmayer systems
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program display Lindenmayer systems using
+#	turtle graphics.  There are some built-in L-systems,
+#       but users can easily modify these and construct new
+#	systems.
+#
+#	See the procedure 'helpmsg' for command line options
+#	(or run as 'lsys -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+#
+#	Links: glib, lsystem, wopen
+#
+############################################################################
+
+
+link glib		# need the turtle graphics stuff
+link lsystem		# ...and the L-System stuff
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+global pre_defs
+
+procedure main (args)
+    local ls, arg, t
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 700.0
+   
+
+    init_pre_defs()			# table of predefined L-systems
+
+    ls := pre_defs["koch_island"]
+
+    while arg := get(args) do {
+       case arg of {
+          "-help"|"-h" : helpmsg()
+          "-order"|"-o": ls.order := integer(get(args))
+          "-dist" |"-d": ls.dist  := numeric(get(args))
+          "-delta"     : ls.delta := numeric(get(args))
+          "-axiom"|"-a": ls.axiom := get(args)
+          "-map"       : ls.rewrite[get(args)] := get(args)
+          "-file"|"-f" : ls := read_Lsystem(open(get(args)))
+          "-name"|"-n" : ls := \pre_defs[get(args)]
+          "-describe"  : {
+                         write_Lsystem(ls := \(pre_defs[write(get(args))]))
+                         write()
+                         }
+          }
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       }
+
+    win := WOpen("label=L-System", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    t := turtle(Window, point(w/2, h/2), 0, create |"red")
+
+    eval_lsys(t,ls)
+# These two commands are behaviorally equivalent to the above line,
+#   but trade numerous recursive calls (above) for a *long* command
+#   string...
+#    s := build_cmd(ls)
+#    eval_cmd(t, s, ls.dist, ls.delta)
+
+    # sit and wait for an event on the window.
+    Event(win)
+    close(win)
+end
+
+procedure helpmsg()
+   write("Usage: Lsys [[-o n] [-d r] [-delta r] [-axiom s] [-map c s]... ]")
+   write("        [-f file] [-n name] [-describe name]")
+   write("   where")
+   write("     -o n		-- order of system")
+   write("     -d r		-- line length")
+   write("     -delta r		-- angle for turns")
+   write("     -axiom s		-- initial axiom")
+   write("     -map c S		-- rewrite rule mapping c into s")
+   write("     -f file		-- read Lsystem from file")
+   write("     -n name		-- use predefined Lsystem 'name'")
+   write("     -describe name	-- describe (and use) predefined Lsystem 'name'")
+   write(" ")
+   write("   Options are processed in order from left to right, e.g.")
+   write(" ")
+   write("     Lsys -n koch_island -o 3")
+   write(" ")
+   write("   displays an order 3 koch_island.")
+   write(" ")
+   write("   Available predefined Lsystems are:\n")
+   every write("     ",key(pre_defs))
+   stop()
+end
+
+procedure init_pre_defs()
+
+   pre_defs := table()
+
+   pre_defs["koch_island"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","F-F+F+FF-F-F+F"]]))
+   pre_defs["box_swirls"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","FF-F-F-F-F-F+F"]]))
+   pre_defs["squares"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","FF-F-F-F-FF"]]))
+   pre_defs["soot"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","FF-F--F-F"]]))
+   pre_defs["box_flake"] := Lsys(1,10,90,"F-F-F-F",
+                                   mk_map([["F","F-FF--F-F"]]))
+   pre_defs["dragon"] := Lsys(1,10,90,"L",
+                                   mk_map([["L","L+R+"],["R","-L-R"]]))
+   pre_defs["triangle"] := Lsys(1,10,60,"R",
+                                   mk_map([["L","R+L+R"],["R","L-R-L"]]))
+   pre_defs["flake"] := Lsys(1,10,60,"L",
+                                   mk_map([["L","L+R++R-L--LL-R+"],
+                                           ["R","-L+RR++R+L--L-R"]]))
+   pre_defs["near_hilbert"] := Lsys(1,10,90,"-R",
+        mk_map([["L","LL-R-R+L+L-R-RL+R+LLR-L+R+LL+R-LR-R-L+L+RR-"],
+               ["R","+LL-R-R+L+LR+L-RR-L-R+LRR-L-RL+L+R-R-L+L+RR"]]))
+
+end
diff --git a/ipl/gprogs/mandala.icn b/ipl/gprogs/mandala.icn
new file mode 100644
index 0000000..4ccbb37
--- /dev/null
+++ b/ipl/gprogs/mandala.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     mandala.icn
+#
+#	Subject:  Program to draw mandala design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 13, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws "mandala" patterns.
+#
+#  The following options are supported:
+#
+#	-g	run continuously; ignore user events; default: process user
+#		  events
+#	-l i	limit on number of iterations, default 2 ^ 10
+#	-n i	maximum number of points, default 50
+#	-s i	size of window (width/height); default 256
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  gobject, interact, joinpair, options, wopen
+#
+############################################################################
+
+link gobject
+link interact
+link joinpair
+link options
+link wopen
+
+procedure main(args)
+   local i, j, k, angle, incr, xpoint, ypoint, size, radius, opts
+   local extent, max, limit, run, points
+
+   opts := options(args, "gl+n+s+")
+
+   extent := \opts["s"] | 256
+   limit := \opts["l"] | (2 ^ 10)
+   max := \opts["n"] | 50
+   run := opts["g"]
+
+   radius := extent / 2
+
+   WOpen("label=mandala", "width=" || extent, "height=" || extent,
+      "bg=light gray", "dx=" || (extent / 2), "dy=" || (extent / 2)) |
+         ExitNotice("Cannot open window.")
+
+   every 1 to limit do {
+      i := ?max
+      if i < 4 then i+:= 3 +  ?10		# too few doesn't work well ...
+      points := list(i)
+      angle := 0.0
+      incr := 2 * &pi / i
+      every j := 1 to i do {
+         points[j] := Point(radius * cos(angle), radius * sin(angle))
+         angle +:= incr
+         }
+      joinpair(points, points)
+      if /run then repeat case Event() of {
+         "q":   exit()
+         "s":   snapshot()
+         "n":   break
+         }
+      WDelay(1000)
+      EraseArea()
+      }
+   
+end
diff --git a/ipl/gprogs/mandel1.icn b/ipl/gprogs/mandel1.icn
new file mode 100644
index 0000000..fb41d77
--- /dev/null
+++ b/ipl/gprogs/mandel1.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     mandel1.icn
+#
+#	Subject:  Program to display the Mandelbrot set
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Mandelbrot set.  It
+#  has deliberately been left simple and free of options so that the
+#  basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local size, real_size, i, j, c1, c2, x, y, n, x1, y1, limit, extent
+
+   size := 300
+   extent := 4.0 / size
+
+   limit := 30
+
+   WOpen("label=mandel", "height=" || size, "width=" || size) |
+      stop("*** cannot open window")
+
+   every i := 1 to size do {
+      every j := 1 to size / 2 do {
+         c1 := -2 + i * extent
+         c2 := 2 - j * extent
+         x := c1
+         y := c2
+         every 1 to limit do {		# see what the orbit is
+            x1 := x ^ 2 - y ^ 2 + c1
+            y1 := 2 * x * y + c2
+            if (x1 ^ 2 + y1 ^ 2) > 4 then break next
+            x := x1
+            y := y1
+            }
+         DrawPoint(i, j, i, size - j)
+         }
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/mandel2.icn b/ipl/gprogs/mandel2.icn
new file mode 100644
index 0000000..e9a5371
--- /dev/null
+++ b/ipl/gprogs/mandel2.icn
@@ -0,0 +1,162 @@
+############################################################################
+#
+#	File:     mandel2.icn
+#
+#	Subject:  Program to draw the Mandelbrot set
+#
+#	Author:   Roger Hare
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# This program draws portions of the Mandelbrot set according to the values
+# input # on the command line. The method is that described in the articles by
+# Dewdney # in the Computer Recreations column of Scientific American in August
+# '85, # October '87 and February '89.
+#
+# I have problems with colours (not enough of 'em!), so I have used alternated
+# black and white. Those with decent X-terminals will be able to do far
+# better than me.
+#
+# The program certainly doesn't display images as striking as those seen 
+# in publications. Perhaps the scaling of the value of k needs to be
+# different? All suggestions gratefully received.
+#
+# It is possible to speed things up by displaying the points row by row
+# rather than randomly, but as the program is resident in the 100 cycle
+# iteration most of the time, this is only ~5% speed-up. Not really
+# worth it.
+#
+# One of Dewdney's articles mentions other methods to speed things up - I 
+# will search out the algorithms one of these days...
+#
+# Usage is - xmand startr startc size n &
+#
+# where:
+#
+# startr, startc are the co-ordinates of the lower left hand corner of the
+#  area of the complex plane to be displayed
+# size is the size of the (square) area of the complex plane to be displayed
+# n is the number of pixels into which size is to be divided for display
+#  purposes
+#
+# For example - xmand -1.5 -1.25 2.5 400 &
+# 
+# will display the Mandelbrot set in the 2.5x2.5 region of the complex plane
+# whose s-w corner is -1.5-i1.25. The display will be 400x400 pixels.
+#
+# The program has been tested on a Sun 4 using the Icon compiler, and 
+# on a Sequent Symmetry running Version 5 Unix using both the
+# compiler and translator.
+#
+############################################################################
+#
+#  Links:  random, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link random
+link wopen
+
+procedure main(args)
+   local a, b, c, colours, coords, events, gap, i, k, n, r, size
+   local startc, startr, t, x, xmand, y
+
+# check the number of arguments - if it's not 4, select 4 arbitrary values
+if *args == 4
+then {startr:=args[1]
+      startc:=args[2]
+      size:=args[3]
+      n:=args[4]
+      n:=integer(n)}
+else {startr:=-1.5
+      startc:=-1.25
+      size:=2.5
+      n:=200}
+
+# set max size to 400
+if (n>400) then n:=400
+
+# calculate 'size' of each pixel
+gap:=size/n
+
+# open window
+xmand:=WOpen("label=xmand", "height="||n+40,
+   "width="||n+40) | stop("Can't open xmand")
+
+# set colours to be 5 cycles of alternating black & white - this for the
+# benefit of those with monochrome screens, or (like me!), a crummy palette.
+colours:=["black","white"]
+colours:=colours|||colours|||colours|||colours|||colours
+
+# write image info in window
+GotoXY(xmand,20,35+n)
+writes(xmand,startr," ",startc," ",size," ",n)
+
+# this bit coupled with counting y *downwards* later, effectively means that
+# the image in the X-window is 'right way up' for those who live in a 
+# cartesian world.
+startc+:=size
+
+# set up co-ordinates, one for every point in the display and randomize
+coords:=list(n*n,0)
+every i:=1 to n*n
+do coords[i]:=i-1
+randomize()
+every !coords:=:?coords
+
+# main loop
+every i := 1 to n*n
+do {t:=get(coords)
+
+# compute random x,y value from co-ordinate
+    x:=(t/n)
+    y:=(t%n)
+
+# compute value of this x,y point in complex plane - count downwards in
+# y direction to get image 'right way up'
+    r:=startr+x*gap
+    c:=startc-y*gap
+    a:=0
+    b:=0
+
+# and calculate if point is in set or not
+    every k:=1 to 100
+    do {t:=a*a-b*b+r
+        b:=2*a*b+c
+        a:=t
+        if (a*a+b*b) > 4.0 then break}
+
+# scale final value of k to one of range of colours
+# subtract 1 to put in range 0->99; divide by 10 to put in range 0->9
+# add 1 to put in range 1->10 - I have 10 'colours' selected
+# this scaling gives fairly unexciting displays, is there a better scaling
+# (eg: logarithmic, square root, w.h.y)?
+    k-:=1
+    k/:=10
+    k+:=1
+
+# and display
+    Fg(xmand,colours[k])
+    DrawPoint(xmand,(x+20),(y+20))
+
+# this bit bales out of loop if left button is pressed
+    if (events:=Pending(xmand)) & (*events > 0)
+    then if Event(xmand)==&lpress
+            then break}
+WFlush(xmand)
+
+# just close the window and exit when it is finished
+Event(xmand)
+
+end
+
diff --git a/ipl/gprogs/mercator.icn b/ipl/gprogs/mercator.icn
new file mode 100644
index 0000000..00542f4
--- /dev/null
+++ b/ipl/gprogs/mercator.icn
@@ -0,0 +1,79 @@
+############################################################################
+#
+#	File:     mercator.icn
+#
+#	Subject:  Program to display surface of HLS color cones
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 23, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   Usage:  mercator [window options] [palette]
+#
+#      Mercator displays the surface of the HLS color space (hue,
+#   lightness, saturation) in something approximating a Mercator
+#   projection.   The white pole is at the top, the black pole is
+#   at the bottom, and the fully saturated colors run along the
+#   central equator.
+#
+#      Colors are usually quantized to one of Icon's color palettes,
+#   with the "c1" palette being the default.  Specifying a palette
+#   of "none" inhibits quantization, generally leading to poor results
+#   due to color allocation failure.
+#   
+############################################################################
+#
+#      Calling this a mercator projection is not exactly correct.
+#   The first problem is that HLS space is a double cone, not a
+#   sphere, but that can be disregarded by mapping hue to longitude
+#   and lightness to latitude.  Even so, the projection is not truly
+#   a Mercator projection, but rather another member of the cylindrical
+#   family:  a rectangular, or equidistant cylindrical, projection.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+
+link graphics
+
+$define Palette "c1"			# default palette
+$define Size "500,300"			# default size
+
+procedure main(args)
+   local ww, wh, p, x, y, h, l, dh, dl, hls, c
+
+   Window("size=" || Size, args)
+   ww := WAttrib("width")		# actual window width
+   wh := WAttrib("height")		# actual window height
+   dh := 360.0 / (ww - 1)		# change in hue per pixel
+   dl := 100.0 / (wh - 1)		# change in lightness per pixel
+
+   p := args[1] | Palette
+   if p == "none" then p := &null
+
+   every x := 0 to ww - 1 do {
+      h := integer(x * dh) || ":"
+      every y := 0 to wh - 1 do {
+         l := 100 - integer(y * dl)
+         hls := h || l || ":100"
+         c := HLSValue(hls)
+         c := PaletteColor(p, PaletteKey(\p, c))
+         Fg(c)
+         DrawPoint(x, y)
+         }
+      }
+
+   ZDone()
+end
diff --git a/ipl/gprogs/mirroror.icn b/ipl/gprogs/mirroror.icn
new file mode 100644
index 0000000..ccf7437
--- /dev/null
+++ b/ipl/gprogs/mirroror.icn
@@ -0,0 +1,55 @@
+############################################################################
+#
+#	File:     mirroror.icn
+#
+#	Subject:  Program to mirror images given on command line
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 2, 1999
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  To get from one image to another, type "n"; to quit, type "q". "s"
+#  produces a snapshot and "w" writes the name of the file.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  interact, mirror, wopen
+#
+############################################################################
+
+link interact
+link mirror
+link wopen
+
+procedure main(args)
+   local name, win
+
+   every name := !args do {
+      WOpen("image=" || name, "canvas=hidden") | {
+         write(&errout, "*** cannot open ", image(name))
+         next
+         }
+      win := mirror(&window)
+      WAttrib(win, "canvas=normal", "label=" || name)
+      repeat case Event(win) of {
+         "n":  break
+         "s":  snapshot(win)
+         "q":  exit()
+         "w":  write(name)		# write out file name
+         }
+      WClose(&window)
+      WClose(win)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/moire.icn b/ipl/gprogs/moire.icn
new file mode 100644
index 0000000..ee42d10
--- /dev/null
+++ b/ipl/gprogs/moire.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     moire.icn
+#
+#	Subject:  Program to display Moire patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays moire patterns.
+#
+#  The following options are supported:
+#
+#	-g	run continuously; ignore user events; default: process user
+#		  events
+#	-i i	initial size, default 50
+#	-k i	increment, default 1
+#	-l i	limit on number of iterations, default 2 ^ 10
+#	-p s	palette, default "c2"
+#	-s i	size of window (width/height); default 256
+#
+#  This program is based on material given in "FractalVision",
+#  Dick Oliver, Sams Publishing, 1992, pp. 185-190.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colrlist, interact, options, wopen
+#
+############################################################################
+
+link colrlist
+link interact
+link options
+link wopen
+
+procedure main(args)
+   local extent, size, colors, ncolors, k, x, i, y, j, c, palette
+   local opts, init, incr, limit, run
+
+   opts := options(args, "gs+p:i+k+l+")
+
+   palette := \opts["p"] | "c2"
+   extent := \opts["s"] | 256
+   init := \opts["i"] | 50
+   incr := \opts["k"] | 1
+   limit := \opts["l"] | (2 ^ 10)
+   run := opts["g"]
+
+   size := extent / 2
+
+   WOpen("label=moire", "height=" || extent, "width=" || extent,
+      "dx=" ||  size, "dy=" || size, "bg=light gray") |
+         ExitNotice("Cannot open window.")
+
+   colors := colrplte(palette) | ExitNotice("Invalid palette.")
+   ncolors := *colors
+
+   every k := seq(init, incr) \ limit do {
+      x := k
+      every i := 0 to size do {
+         y := x
+         every j := i to size do {
+            c := colors[?ncolors]
+            Fg(c)
+            DrawPoint(
+               i, j,
+               j, i,
+               j, -i,
+               i, -j,
+               -i, -j,
+               -j, -i,
+               -j, i,
+               -i, j
+               )
+            y +:= k
+            }
+         x +:= k
+         }
+      Fg("black")
+      if /run then repeat case Event() of {
+         "q":   exit()
+         "s":   snapshot()
+         "n":   break
+         }
+      }
+
+end
diff --git a/ipl/gprogs/mover.icn b/ipl/gprogs/mover.icn
new file mode 100644
index 0000000..545e233
--- /dev/null
+++ b/ipl/gprogs/mover.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     mover.icn
+#
+#	Subject:  Program to move files from one name to another
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 29, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Program to allow interactive moving (renaming) of files.
+#
+############################################################################
+#
+#  Requires:  UNIX
+#
+############################################################################
+#
+#  Links:  io, vsetup
+#
+############################################################################
+
+link io
+link vsetup
+
+global names
+global root
+global vidgets
+
+procedure main()
+
+   init()
+
+   GetEvents(root, , shortcuts)
+
+end
+
+procedure init()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   names := vidgets["names"]
+   VSetItems(names, filelist())
+
+end
+
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "quit  @Q":  exit()
+      }
+
+end
+
+procedure names_cb(vidget, value, x) 
+
+   if /value then return		# ignore unselect
+
+   if OpenDialog("Rename:", value) == "Cancel" then fail
+   if system("mv " || value || " " || dialog_value ||
+      " >/dev/null 2>/dev/null") ~= 0 then {
+         Notice("Renaming failed.")
+         fail
+         }
+   VSetItems(names, filelist())
+
+   return
+
+end
+
+procedure shortcuts()
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=600,400", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,600,400:",],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["move  @M","quit  @Q"]],
+   ["line1:Line:::1,26,598,26:",],
+   ["names:List:w::26,48,557,335:",names_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/offtiler.icn b/ipl/gprogs/offtiler.icn
new file mode 100644
index 0000000..9b81a4d
--- /dev/null
+++ b/ipl/gprogs/offtiler.icn
@@ -0,0 +1,241 @@
+############################################################################
+#
+#	File:     offtiler.icn
+#
+#	Subject:  Program to tile images with offset
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces drop repeats and brick patterns.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  io, vsetup
+#
+############################################################################
+
+link io
+link vsetup
+
+global direction
+global factor
+global height
+global subject
+global target
+global vidgets
+global width
+
+procedure main()
+
+   vidgets := ui()
+
+   direction := "vertical"
+   factor := 1
+
+   GetEvents(vidgets["root"], , shortcuts)
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O"  :  open_image()
+      "save  @S"  :  save_tile()
+      "quit  @Q"  :  exit()
+      }
+
+   return
+
+end
+
+procedure parameter_cb(vidget, value)
+
+   case value[1] of {
+      "direction  @D"  :  set_direction()
+      "factor     @F"  :  set_factor()
+      }
+
+   return
+
+end
+
+procedure tile_cb()
+   local incr, i, j, offset
+
+   if /subject then {
+      Notice("No subject image.")
+      fail
+      }
+      
+   WClose(\target)
+
+   target := WOpen("label=offset tile", "size=" || (width * factor) || "," ||
+      (height * factor)) | {
+         Notice("Cannot open target window.")
+         fail
+         }
+
+   Raise()
+
+   case direction of {
+      "vertical"    :  {
+         incr := height / factor
+         every i := -1 to factor do {		# columns
+            offset := i * incr
+            every j := -1 to factor do {	# rows
+               CopyArea(subject, target, 0, 0, width, height, i * width,
+                  j * height + offset)
+               }
+            }
+         }
+      "horizontal"  :  {
+         incr := width / factor
+         every i := -1 to factor do {		# rows
+            offset := i * incr
+            every j := -1 to factor do {	# columns
+               CopyArea(subject, target, 0, 0, width, height,
+                  j * width + offset, i * height)
+               }
+            }
+         }
+      }
+
+   return
+
+end
+
+procedure set_direction()
+
+   repeat {
+      if SelectDialog("Direction", ["vertical", "horizontal"], direction) ==
+         "Cancel" then fail
+      direction := dialog_value
+      check_parameters() | next
+      return
+      }
+
+end
+
+procedure set_factor()
+
+   repeat {
+      if TextDialog("Offset factor", , factor) == "Cancel" then fail
+      factor := (0 < integer(dialog_value[1])) | {
+         Notice("Invalid factor specification.")
+         next
+         }
+      check_parameters() | next
+      return
+      }
+
+end
+
+procedure check_parameters()
+
+   case direction of {
+      "vertical"    :  {
+         if (height % factor) ~= 0 then {
+            Notice("Factor does not evenly divide height.")
+            fail
+            }
+         if factor >= height then {
+            Notice("Factor too large.")
+            fail
+            }
+         }
+      "horizontal"  :  {
+         if (width % factor) ~= 0 then {
+            Notice("Factor does not evenly divide width.")
+            fail
+            }
+         if factor >= width then {
+            Notice("Factor too large.")
+            fail
+            }
+         }
+      }
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "d"  :  set_direction()
+      "f"  :  set_factor()
+      "o"  :  open_image()
+      "q"  :  exit()
+      "s"  :  save_tile()
+      "t"  :  tile_cb()
+      }
+
+   return
+
+end
+
+procedure open_image()
+
+   repeat {
+      if OpenDialog("Open image:") == "Cancel" then fail
+      WClose(\subject)
+      subject := WOpen("label=" || dialog_value, "image=" || dialog_value) | {
+         Notice("Cannot open image.") 
+         next
+         }
+      width := WAttrib(subject, "width")
+      height := WAttrib(subject, "height")
+      factor := 1
+      Raise()
+      return
+      }
+
+end
+
+procedure save_tile()
+   local file
+
+   repeat {
+      if SaveDialog("Save tile:") ~== "Yes" then fail
+      file := dialog_value
+      if exists(file) then {
+         if TextDialog("Overwrite existing file?") == "Cancel" then next
+         }
+      WriteImage(target, file) | {
+         Notice("Cannot write image.")
+         next
+         }
+      return
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=200,165", "bg=pale gray"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,200,165:",],
+   ["file:Menu:pull::0,0,36,21:File",file_cb,
+      ["open  @O","save  @S","quit  @Q"]],
+   ["line1:Line:::0,23,200,23:",],
+   ["parameters:Menu:pull::37,0,78,21:Parameters",parameter_cb,
+      ["direction  @D","factor     @F"]],
+   ["tile:Button:regular::12,36,35,20:tile",tile_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/orbit.icn b/ipl/gprogs/orbit.icn
new file mode 100644
index 0000000..3f09ee9
--- /dev/null
+++ b/ipl/gprogs/orbit.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     orbit.icn
+#
+#	Subject:  Program to display quadratic orbit
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the orbit of a quadratic
+#  equation.  It has deliberately been left simple and free of options so
+#  that the basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local extent, c, i, j, m, x
+
+   extent := 360
+
+   WOpen("label=orbit", "height=" || extent, "width=" || extent) |
+      stop("*** cannot open window")
+
+   every i := -320 to 40 do {
+      x := 0.0
+      c := i / 160.0
+      m := 160 * (c + 2)
+      every j := 0 to extent do {
+         x := x ^ 2 + c
+         if j < 50 then next		# wait for things to take hold
+         DrawPoint(m,  75 * (2 - x))
+         }
+      }
+    
+   Event()
+
+end
diff --git a/ipl/gprogs/painterc.icn b/ipl/gprogs/painterc.icn
new file mode 100644
index 0000000..e443a7f
--- /dev/null
+++ b/ipl/gprogs/painterc.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     painterc.icn
+#
+#	Subject:  Program to convert Painter color sets to Icon colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts color sets from Painter 3 to lists of Icon
+#  colors.
+#
+#  The lists are saved in files with the base name of the color set and
+#  the suffix ".clr".
+#
+############################################################################
+#
+#  Links:  basename
+#
+############################################################################
+
+link basename
+
+procedure main(args)
+   local line, file, name, input, output
+
+   every file := !args do {
+      input := open(file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      name := basename(file, ".txt")
+      output := open(name || ".clr", "w") | {
+         write(&errout, "*** cannot open ", name, ".clr")
+         close(input)
+         next
+         }
+      while line := map(read(input)) do {
+         line ? {
+            ="r:" | next
+            tab(upto(&digits))
+            writes(output, 256 * tab(many(&digits)), ",")
+            tab(find("g:") + 2) | {
+               write(&errout, "*** invalid data in ", file)
+               write(&errout, line)
+               next
+               }
+            tab(upto(&digits))
+            writes(output, 256 * tab(many(&digits)), ",")
+            tab(find("b:") + 2) | {
+               write(&errout, "*** invalid data in ", file)
+               write(&errout, line)
+               next
+               }
+            tab(upto(&digits))
+            writes(output, 256 * tab(many(&digits)))
+            tab(many(' \t'))
+            if not pos(0) then write(output, "\t", tab(0))
+            else write(output)
+            }
+         }
+     close(input)
+     close(output)
+     }
+
+end
diff --git a/ipl/gprogs/palcheck.icn b/ipl/gprogs/palcheck.icn
new file mode 100644
index 0000000..be8fbbb
--- /dev/null
+++ b/ipl/gprogs/palcheck.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     palcheck.icn
+#
+#	Subject:  Program to check palindromic sentences
+#
+#	Authors:  K'vin D'vries and Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads lines from standard input.  If a line is a
+#  palindromic sentence (see The Icon Programming Language, 2nd edition,
+#  p. 58), it is ignored.  If it is not a palindromic sentence, it is
+#  written to a window with the outermost characters that don't match
+#  highlighted.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+
+procedure main()
+   local normal, highlight, line, s1, s2, i1, i2
+
+   normal := WOpen("label=palindrome check", "lines=20", "columns=80",
+      "leading=18") | stop("*** cannot open window")
+
+   highlight := XBind(normal, , "reverse=on")
+
+   while line := read() do {
+       s1 := map(line)
+       s2 := reverse(s1)
+
+       i1 := i2 := 1
+
+       while i1 < *line do {
+           (i1 := upto(&lcase, s1, i1) & i2 := upto(&lcase, s2, i2)) | break
+           if s1[i1] ~== s2[i2] then {
+               line ? {
+                  writes(normal, tab(i1))
+                  writes(highlight, move(1))
+                  writes(normal, tab(*line - i2 + 1)) 
+                  writes(highlight, move(1))
+                  write(normal, tab(0))
+                  }
+               break
+           }
+           i1 +:= 1
+           i2 +:= 1
+       }
+   }
+
+   Event(normal)
+
+end
diff --git a/ipl/gprogs/palette.icn b/ipl/gprogs/palette.icn
new file mode 100644
index 0000000..fe9ef1e
--- /dev/null
+++ b/ipl/gprogs/palette.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     palette.icn
+#
+#	Subject:  Program to display an Icon image palette
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  palette [name]
+#
+#  Palette displays each color available in an image palette along with its
+#  index character.  The default palette is "c1".
+#
+#  Typing a digit (1 to 6) in the window switches the display to the
+#  corresponding color palette.  Typing a "g" selects the "g16" palette.
+#
+#  Typing "l", "o", or "u" toggles the respective drawpalette() flag.
+#
+#  The window can be resized.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor
+#
+############################################################################
+
+link graphics, imscolor
+
+global flags
+
+procedure main(args)
+   local p, nw, nh, w, h, e
+
+   flags := "l"
+   if args[-1] ? any(&letters) then
+      p := args[-1]
+   else
+      p := "c1"
+
+   PaletteChars(p) | stop(&progname, ": palette ", p, " not found")
+
+   Window("width=125", "height=250", "font=lucidasans-bold-12",
+      "label=" || p, args)
+
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   draw(p)
+   while e := Event() do case e of {
+      QuitEvents():	break
+      !"123456":	draw(p := "c" || e)
+      "g":		draw(p := "g16")
+      &lpress | &ldrag:	writes(pickpalette(p, &x, &y) | "~") & flush(&output)
+      &resize:		draw(p)
+      !"lou": {
+         if flags ? find(e) then
+            flags := string(flags -- e)
+         else
+            flags ||:= e
+         draw(p)
+         }
+      }
+end
+
+
+procedure draw(p)		# draw palette, etc.
+   WAttrib("label=" || p)
+   EraseArea()
+   drawpalette(p, , , , , flags) |
+      write(&errout, "  could not get all colors of ", p, " palette")
+   return
+end
diff --git a/ipl/gprogs/pat2gif.icn b/ipl/gprogs/pat2gif.icn
new file mode 100644
index 0000000..46a1402
--- /dev/null
+++ b/ipl/gprogs/pat2gif.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     pat2gif.icn
+#
+#	Subject:  Program to convert bi-level pattern to GIF
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Names ofs BLP are given on the command line.  The GIFs have a
+#  corresponding basename.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, patutils, wopen
+#
+############################################################################
+
+link basename
+link patutils
+link wopen
+
+procedure main(args)
+   local matrix, ims, input, file
+
+   while file := get(args) do {
+      input := open(file) | stop("cannot open ", file)
+      ims := read(input) | stop("empty BLP")
+      matrix := pat2rows(ims) | stop("*** invalid pattern")
+      WOpen("size=" || *matrix[1] || "," || *matrix, "canvas=hidden") |
+         stop("*** cannot open window")
+      DrawImage(0, 0, ims)
+      WriteImage(basename(file, ".blp") || ".gif") 
+      close(input)
+      }
+
+end
diff --git a/ipl/gprogs/patfetch.icn b/ipl/gprogs/patfetch.icn
new file mode 100644
index 0000000..2c32f51
--- /dev/null
+++ b/ipl/gprogs/patfetch.icn
@@ -0,0 +1,85 @@
+############################################################################
+#
+#	File:     patfetch.icn
+#
+#	Subject:  Program to extract patterns from a file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 22, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program accepts a list of integer specifications for patterns
+#  as the appear in order in a file of patterns.  The selected patterns
+#  are written to standard output, but not until the end of the input
+#  specifications.  The name of the pattern file is specified on the
+#  command line.
+#
+#  Each line of input can be a comma-separated string of either integers
+#  or integer ranges.  Blanks after commas are tolerated.  An example of
+#  input is:
+#
+#	1-3, 5
+#	10
+#	13-17
+#	8
+#
+#  which specifies the patterns 1, 2, 3, 5, 8, 10, 13, 14, 15, 16, and 17.
+#
+#  Note that the integers need not be in order, although within a range,
+#  the lower bound must precede the upper bound.
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure main(args)
+   local file, input, i, hitlist, patlist, spec, lo, hi, subspec
+
+   file := args[1] | stop("*** no pattern list specified")
+
+   input := open(file) | stop(" *** cannot open input file")
+ 
+   hitlist := set()			# construct set of indices to remove
+
+   while spec := read() do {
+      spec ? {
+         while subspec := tab(upto(',') | 0) do {
+            if insert(hitlist, integer(subspec)) then {		# integer
+               move(1) | break
+               tab(many(' '))
+               }
+            else {
+               subspec ? {
+                  lo := tab(many(&digits)) &
+                  ="-" &
+                  hi := tab(many(&digits)) &
+                  lo <= hi &
+                  pos(0) | write(&errout, "*** bad specification")
+                  every insert(hitlist, 0 < integer(lo to hi))
+                  }
+               move(1) | break
+               tab(many(' '))
+               }
+            }
+         }
+      }
+
+   patlist := []			# read in list of patterns
+
+   while put(patlist, readpatt(input))
+   
+   every i := !sort(hitlist) do {		# write out selected patterns
+      write(patlist[i]) | write(&errout, "*** ", i, " out of bounds")
+      }
+
+end
diff --git a/ipl/gprogs/penelope.icn b/ipl/gprogs/penelope.icn
new file mode 100644
index 0000000..55861e3
--- /dev/null
+++ b/ipl/gprogs/penelope.icn
@@ -0,0 +1,1256 @@
+############################################################################
+#
+#	File:     penelope.icn
+#
+#	Subject:  Program to edit graphic patterns
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     May 25, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This application provides a variety of facilities for creating and
+#  editing graphic pattern specifications.  For a complete description,
+#  see IPD234:
+#	http://www.cs.arizona.edu/icon/docs/ipd234.htm
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics with 32-column tiles
+#
+############################################################################
+#
+#  Links: sort, patxform, vdialog, vsetup, dialog, wopen, xcompat
+#
+############################################################################
+
+link sort
+link patxform
+link vdialog
+link vsetup
+link dialog
+link wopen
+link xcompat
+
+$define MaxCell   	24			# maximum size of grid cell
+
+$define GridSize	(32 * 8)		# size of area for edit grid
+$define GridXoff	(32 * 5)		# x offset of grid area
+$define GridYoff	(32 * 2 + 6)		# y offset of grid area
+
+$define PattXoff	(32 * 14)		# x offset of pattern area
+$define PattYoff	(32 * 2)		# y offset of pattern area
+$define PattWidth	(32 * 8)		# width of pattern area
+$define PattHeight	(32 * 8)		# heigth of pattern area
+
+$define IconSize	16			# size of button icons
+
+$define XformXoff	(16 * 2)		# x offset of xform area
+$define XformYoff	(16 * 4)		# y offset of xform area
+
+$define SymmetXoff	(16 * 10)		# x offset of symmetry area
+$define SymmetYoff	(16 * 23)		# y offset of symmetry area
+
+$define InfoLength	40			# length of lines in info box
+
+global allxform					# transform-all switch
+global hbits					# number of bits horizontally
+global vbits					# number of bits veritcally
+global rows					# row repesentation of tile
+global old_pat					# old pattern for undo
+global cellsize					# size of cell in edit grid
+global pattgc					# graphic context for pattern
+global bordergc					# border for tile/pattern
+global viewgc					# clipping area for viewing
+global mode					# pattern/tile display mode
+global zoom					# tile zoom factor
+global loadname					# name of loaded pattern file
+global plist					# pattern list
+global pindex					# index in pattern list
+global list_touched				# list modification switch
+global tile_touched				# tile modification switch
+global blank_pat				# 8x8 blank tile
+global response					# switch for save dialog
+global sym_state				# drawing state
+global sym_image_current			# current drawing images
+global sym_image_next				# next drawing images
+global symmetries				# general symmetry state
+
+global flip_right				# icon for right flip
+global flip_left				# icon for left flip
+global flip_vert				# icon for vertical flip
+global flip_horiz				# icon for horizontal flip
+global rotate_90				# icon for 90-degree rotation
+global rotate_m90				# icon for -90-degree rotation
+global rotate_180				# icon for 180-degree rotation
+global ident					# icon for identity
+global hi_ident					# highlighted icon for identity
+global hi_left					# highlighted icon for l-flip
+global hi_right					# highlighted icon for r-flip
+global hi_vert					# highlighted icon for v-flip
+global hi_horiz					# highlighted icon for h-flip
+global hi_rot_90				# highlighted icon for 90-rot
+global hi_rot_m90				# highlighted icon for -90 rot
+global hi_rot_180				# highlighted icon for 180 rot
+
+global MaxPatt					# maximum width for patterns
+
+record pattrec(tile, note)
+
+procedure main(args)
+   local vidgets, e, i, j, x, y, v, h, input, mdigits
+
+#  Initial state
+
+   mdigits := '-' ++ &digits
+   mode := 1					# initially pattern mode
+   zoom := 1					# initially 1:1
+   symmetries := 0				# initially no symmetries
+   allxform := &null				# initially not all xforms
+
+   sym_state := [				# initially no symmetries
+      [1, -1, -1, -1],
+      [-1, -1, -1, -1]
+      ]
+
+   blank_pat := "8,#0000000000000000"		# 8x8 blank tile
+
+   list_touched := &null			# pristine state
+   tile_touched := &null
+
+#  Conservative assumption that only X can handle tiles up to 32 wide
+
+   MaxPatt := if &features == "X Windows" then 32 else 8
+
+#  Set up initial pattern list
+
+   if loadname := args[1] then {
+      input := open(loadname) | stop("*** cannot open ", loadname)
+      if load_file(input) then old_pat := rows2pat(rows)
+      else stop("*** no patterns in ", loadname)
+      }
+   else {
+      loadname := "untitled.tle"
+      rows := pat2rows(blank_pat)
+      old_pat := rows2pat(rows)
+      plist := [pattrec(rows2pat(rows), "")]
+      pindex := 1
+      }
+
+#  Set up vidgets
+
+   vidgets := ui(, vecho)
+
+   WAttrib("label=" || loadname)
+
+#  Set up graphic contexts
+
+   pattgc := XBind(&window, "fillstyle=textured")	# for patterns
+   bordergc := XBind(&window, "fg=red")			# for border
+   viewgc := XBind(&window) 				# for tile view
+   Clip(viewgc, PattXoff, PattYoff, PattWidth, PattHeight)
+   Clip(bordergc, PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
+
+#  Assign and draw the icons
+
+   icons()
+
+#  Initial and toggled editing images
+
+   sym_image_next := [
+      [ident, hi_rot_90, hi_rot_m90, hi_rot_180],
+      [hi_right, hi_left, hi_vert, hi_horiz]
+      ]
+   sym_image_current := [
+      [hi_ident, rotate_90, rotate_m90, rotate_180],
+      [flip_right, flip_left, flip_vert, flip_horiz]
+      ]
+
+#  Initial setup of grid and view areas
+
+   setup() | stop("*** cannot set up pattern")
+
+#  Enter event loop
+
+   GetEvents(vidgets["root"], ,  shortcuts)
+   
+end
+
+############################################################################
+#
+#	Callback procedures
+#
+############################################################################
+
+#  file menu
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "load  @L"  :  load()
+      "save  @S"  :  save()
+      "save as"   :  save_as()
+      "read  @R"  :  read_tile()
+      "write @W"  :  write_tile()
+      "quit  @Q"  :  quit()
+      }
+
+   return
+
+end
+
+#  editing grid
+
+procedure grid_cb(vidget, e)
+   local x, y, i, j
+
+   if e === (&lpress | &rpress | &ldrag | &rdrag) then {
+      j := (&x - GridXoff) / cellsize
+      i := (&y - GridYoff) / cellsize
+      if j < 0 | j >= hbits | i < 0 | i >= vbits then return
+      if e === (&lpress | &ldrag) then setbit(i, j, "1")
+      else setbit(i, j, "0")
+      tile_touched := 1
+      }
+
+   return
+
+end
+
+#  list menu
+
+procedure list_cb(vidget, value)
+   local i
+
+   case value[1] of {
+      "clear"    :  {			# should request confirmation
+         plist := [pattrec(blank_pat, "")]
+         }
+      "reverse"  :  {
+         every i := 1 to *plist / 2 do
+            plist[i] :=: plist[-i]
+         }
+      "sort"     :  {
+         refresh_tile()
+         plist := isort(plist, case value[2] of {
+            "by size":    tile_size
+            "by bits":    tile_bits
+            "by notes":   tile_note
+            })
+         }
+      }
+
+   pindex := 1
+
+   rows := pat2rows(plist[1].tile)
+   old_pat := rows2pat(rows)
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  Penelope logo
+
+procedure logo_cb(vidgets, event)
+
+   if event === (&lpress | &mpress | &rpress) then
+      Notice("Penelope", "Version 1.1",
+         "Ralph E. Griswold and Gregg M. Townsend")
+
+   return
+
+end
+
+#  note menu
+
+procedure note_cb(vidget, value)
+   local result, note, i
+
+   case value[1] of {
+      "edit @E"  :  edit_tile()
+      "find @F"  :  find_tile()
+      }
+
+   return
+
+end
+
+#  symmetry buttons
+
+procedure symmet_cb(vidget, e)
+   local col, row, symcount
+
+   if e === (&lpress | &rpress | &mpress) then {
+      col := (&x - SymmetXoff) / IconSize + 1
+      row := (&y - SymmetYoff) / IconSize + 1
+      sym_state[row, col] *:= -1
+      sym_image_current[row, col] :=: sym_image_next[row, col]
+      place(SymmetXoff, SymmetYoff, col - 1, row - 1,
+         sym_image_current[row, col])
+      symcount := 0
+      every symcount +:= !!sym_state
+      if symcount = -8 then
+         Notice("No drawing mode enabled; pattern cannot be edited")
+      else if (sym_state[1, 1] = 1) & (symcount = -6) then symmetries := 0
+      else symmetries := 1
+
+      return
+      }
+
+   fail
+
+end
+
+#  tile menu
+
+procedure tile_cb(vidget, value)
+   local result
+
+   case value[1] of {
+      "next     @N"  :  next_tile()
+      "previous @P"  :  previous_tile()
+      "goto     @G"  :  goto_tile()
+      "first"        :  {
+         refresh_tile()
+         pindex := 1
+         rows := pat2rows(plist[pindex].tile)
+         tile_touched := 1
+         return setup()
+         }
+      "last"         :  {
+         refresh_tile()
+         pindex := *plist
+         rows := pat2rows(plist[pindex].tile)
+         tile_touched := 1
+         return setup()
+         }
+      "copy     C"  :  copy_tile()
+      "revert"      :  {
+         rows := pat2rows(plist[pindex].tile)
+         return setup()
+         }
+      "delete   D"  :  delete_tile()
+      "new"         :  {
+         case Dialog("New:", ["width", "height"], [*rows[1], *rows], 3,
+            ["Okay", "Cancel"]) of {
+               "Cancel"  :  fail
+               "Okay"    :   {
+                  icheck(dialog_value) | fail
+                  refresh_tile()
+                  rows := list(dialog_value[2], repl("0", dialog_value[1]))
+                  put(plist, pattrec(rows2pat(rows), ""))
+                  pindex := *plist
+                  tile_touched := 1
+                  return setup()
+                  }
+            }
+         }
+      "info     I"  :  tile_info()
+      }
+
+   return
+
+end
+
+#  view menu
+
+procedure view_cb(vidget, value)
+   static old_mode, old_zoom
+
+   old_mode := mode
+   old_zoom := zoom
+
+   case value[1] of {
+      "pattern"    :  mode := 1
+      "tile"       :  mode := &null
+      "tile zoom"  :  {
+         mode := &null
+         case value[2] of {
+            "1:1"  :  zoom := 1
+            "2:1"  :  zoom := 2
+            "4:1"  :  zoom := 4
+            "8:1"  :  zoom := 8
+            }
+         }
+      }
+
+   if (mode ~=== old_mode) | (zoom ~=== old_zoom) then {
+      DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1,
+         PattWidth + 1, PattHeight + 1)
+      EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 1, PattHeight + 1)
+      return setup()
+      }
+
+   return
+
+end
+
+#  transformation buttons
+
+procedure xform_cb(vidget, e)
+   local col, row, save_pindex
+
+   if e === (&lpress | &rpress | &mpress) then {
+      old_pat := rows2pat(rows)
+      col := (&x - XformXoff) / IconSize
+      row := (&y - XformYoff) / IconSize
+
+      if &shift then {
+         refresh_tile()
+         save_pindex := pindex
+         every pindex := 1 to *plist do {
+            rows := pat2rows((plist[pindex]).tile)
+            rows := xform(col, row)  
+            (plist[pindex]).tile := rows2pat(rows)
+            allxform := 1				# all being done
+            }
+         allxform := &null				# one being done
+         list_touched := 1
+         pindex := save_pindex
+         rows := pat2rows(plist[pindex].tile)
+         }
+      else rows := xform(col, row) | fail
+
+      return setup()
+
+      }
+
+end
+
+############################################################################
+#
+#  Support procedures
+#
+############################################################################
+
+#  clear bits on current tile
+
+procedure clear_tile()
+
+   rows := list(vbits, repl("0", hbits))
+
+   grid()
+
+   drawpat()
+
+   return
+
+end
+
+#  copy current tile
+
+procedure copy_tile()
+
+   refresh_tile()
+   put(plist, pattrec(old_pat := rows2pat(rows), ""))
+   rows := pat2rows(old_pat)
+   pindex := *plist
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  delete current tile
+
+procedure delete_tile()
+						# should ask confirmation
+   if *plist = 1 then plist := [pattrec(blank_pat, "")]
+   else {
+      plist := plist[1 : pindex] ||| plist[pindex + 1 : 0]
+      if pindex > *plist then pindex := *plist
+      }
+
+   rows := pat2rows((plist[pindex]).tile)
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  draw view area
+
+procedure drawpat()
+
+   if \mode then {				# draw pattern
+      DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1,
+         PattWidth + 1, PattHeight + 1) 
+      Pattern(pattgc, rows2pat(rows))
+      FillRectangle(pattgc, PattXoff, PattYoff, PattWidth, PattHeight)
+      }
+   else {					# draw tile
+      EraseArea(PattXoff - 1, PattYoff - 1, PattWidth + 2, PattHeight + 2)
+      DrawRectangle(bordergc, PattXoff - 1, PattYoff - 1, 
+         (*rows[1] * zoom) + 1, (*rows * zoom) + 1)
+      DrawRows(viewgc, PattXoff, PattYoff, rows, zoom)
+      }
+   return
+
+end
+
+#  edit annotation on current tile
+
+procedure edit_tile()
+   local result
+
+   case Dialog("Edit:", "note", [plist[pindex].note], 80,
+      ["Okay", "Cancel"]) of {
+         "Cancel":  fail
+         "Okay":  {
+            plist[pindex].note := dialog_value[1] || " "
+            list_touched := 1
+            }
+      }
+
+   return
+
+end
+
+#  find tile with annotation
+
+procedure find_tile()
+   local note, i
+
+   case Dialog("Find:", "note",  "", 80, ["Okay", "Cancel"]) of {
+      "Cancel":  fail
+      "Okay":  {
+         note := dialog_value[1] || " "
+         every i := ((pindex + 1 to *plist) | (1 to *pindex)) do
+            plist[i].note ? {
+               if find(note) then {
+                  pindex := i
+                  rows := pat2rows(plist[pindex].tile)
+                  return setup()
+                  }
+           }
+         }
+      }
+
+   Notice("Not found")
+   
+   fail
+
+end
+
+#  go to specified tile
+
+procedure goto_tile()
+   local i
+
+   case Dialog("Go to:","#", 1, 5, ["Okay", "Cancel"]) of {
+      "Cancel":  fail
+      "Okay":    i := integer(dialog_value[1]) | {
+          Notice("Invalid specification")
+          fail
+          }
+      }
+   refresh_tile()
+   if i <= 0 then i +:= *plist + 1
+   if i <= i <= *plist + 1 then {
+      pindex := i
+      old_pat := rows2pat(rows)
+      rows := pat2rows(plist[pindex].tile)
+      return setup()
+      }
+   else {
+      Notice("Index out of bounds")
+      fail
+      }
+
+end
+
+#  draw editing grid
+
+procedure grid()
+   local x, y
+
+   EraseArea(GridXoff, GridYoff, GridSize - 15, GridSize - 15)
+
+   every x := 0 to hbits * cellsize by cellsize do
+      DrawLine(GridXoff + x, GridYoff, GridXoff + x,
+         GridYoff + vbits * cellsize)
+   every y := 0 to vbits * cellsize by cellsize do
+      DrawLine(GridXoff, GridYoff + y, GridXoff + hbits * cellsize,
+         y + GridYoff)
+
+   return
+
+end
+
+#  check for valid integers
+
+procedure icheck(values)
+   local i
+
+   every i := !values do
+      if not(integer(i)) | (i < 0) then {
+         Notice("Invalid value")
+         fail
+         }
+
+   return
+
+end
+
+#  assign and draw icons
+
+procedure icons()
+   local shift_up, shift_left, shift_right, shift_down, pixmap
+   local clear, invert, scramble, trim, enlarge, resize, crop
+
+   pixmap := XBind(, , "width=32", "height=32", "fillstyle=masked")
+
+   Pattern(pixmap, "32,#7fffffff421f843f421f843f421f843f421f843f7fffff_
+      ff421084214210842142108421421084217fffffff4210fc21_
+      4210fc214210fc214210fc217fffffff421087e1421087e142_
+      1087e1421087e17fffffff7e10fc217e10fc217e10fc217e10_
+      fc217fffffff7e10843f7e10843f7e10843f7e10843f7fffff_
+      ff00000000")					# Penelope logo
+
+   FillRectangle(pixmap, 0, 0, 32, 32)
+
+   CopyArea(pixmap, &window, 0, 0, 32, 32, 26, 373)
+
+   Uncouple(pixmap)
+
+   shift_up := "16,#3ffe6003408141c143e140814081408140814081408140_
+      81408160033ffe0000"
+   shift_left := "16,#3ffe6003400140014001401140195ffd40194011400140_
+      01400160033ffe0000"
+   shift_right := "16,#3ffe600340014001400144014c015ffd4c014401400140_
+      01400160033ffe0000"
+   shift_down := "16,#3ffe60034081408140814081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_left := "16,#3ffe600340014079403940394049408149014e014e014f_
+      01400160033ffe0000"
+   flip_right := "16,#3ffe600340014f014e014e014901408140494039403940_
+      79400160033ffe0000"
+   flip_vert := "16,#3ffe6003408141c143e14081408140814081408143e141_
+      c1408160033ffe0000"
+   flip_horiz := "16,#3ffe600340014001400144114c195ffd4c194411400140_
+      01400160033ffe0000"
+   rotate_90 := "16,#3ffe6003400140f141014201420142014f814701420140_
+      01400160033ffe0000"
+   rotate_m90 := "16,#3ffe600340014781404140214021402140f94071402140_
+      01400160033ffe0000"
+   rotate_180 := "16,#3ffe6003400141c140214011401140114111432147c143_
+      01410160033ffe0000"
+   clear := "16,#3ffe600340014001400140014001400140014001400140_
+      01400160033ffe0000"
+   invert := "16,#3ffe60ff40ff40ff40ff40ff40ff7fff7f817f817f817f_
+      817f817f833ffe0000"
+   scramble := "16,#3ffe60034c014c0d418d41814001403159b1598140194c_
+      194c0160033ffe0000"
+   trim := "16,#3ffe60134011407d40394011400140fd48854c857e854c_
+      8548fd60033ffe0000"
+   enlarge := "16,#3ffe6083418143fd418148815c017efd48854885488548_
+      8548fd60033ffe0000"
+   resize := "16,#3ffe6093419943fd419948915c017efd488548857e855c_
+      8548fd60033ffe0000"
+   crop := "16,#3ffe60034011401147fd441144114411441144115ff144_
+      01440160033ffe0000"
+
+   ident := "16,#3ffe6003400140014001400141c141c141c14001400140_
+      01400160033ffe0000"
+
+   hi_ident := "16,#00001ffc3ffe3ffe3ffe3ffe3e3e3e3e3e3e3ffe3ffe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_90 := "16,#00001ffc3ffe3f0e3efe3dfe3dfe3dfe307e38fe3dfe3f_
+      fe3ffe1ffc00000000"
+   hi_rot_m90 := "16,#00001ffc3ffe387e3fbe3fde3fde3fde3f063f8e3fde3f_
+      fe3ffe1ffc00000000"
+   hi_rot_180 := "16,#00001ffc3ffe3e3e3fde3fee3fee3fee3eee3cde383e3c_
+      fe3efe1ffc00000000"
+   hi_right := "16,#00001ffc3ffe30fe31fe31fe36fe3f7e3fb63fc63fc63f_
+      863ffe1ffc00000000"
+   hi_left := "16,#00001ffc3ffe3f863fc63fc63fb63f7e36fe31fe31fe30_
+      fe3ffe1ffc00000000"
+   hi_vert := "16,#00001ffc3f7e3e3e3c1e3f7e3f7e3f7e3f7e3f7e3c1e3e_
+      3e3f7e1ffc00000000"
+   hi_horiz := "16,#00001ffc3ffe3ffe3ffe3bee33e6200233e63bee3ffe3f_
+      fe3ffe1ffc00000000"
+
+#  now place the images
+
+   place(XformXoff, XformYoff, 1, 0, shift_up)
+   place(XformXoff, XformYoff, 0, 1, shift_left)
+   place(XformXoff, XformYoff, 2, 1, shift_right)
+   place(XformXoff, XformYoff, 1, 2, shift_down)
+   place(XformXoff, XformYoff, 0, 4, flip_right)
+   place(XformXoff, XformYoff, 0, 5, flip_left)
+   place(XformXoff, XformYoff, 1, 4, flip_vert)
+   place(XformXoff, XformYoff, 1, 5, flip_horiz)
+   place(XformXoff, XformYoff, 0, 7, rotate_90)
+   place(XformXoff, XformYoff, 0, 8, rotate_m90)
+   place(XformXoff, XformYoff, 1, 7, rotate_180)
+   place(XformXoff, XformYoff, 0, 10, clear)
+   place(XformXoff, XformYoff, 1, 10, invert)
+   place(XformXoff, XformYoff, 2, 10, scramble)
+   place(XformXoff, XformYoff, 0, 12, trim)
+   place(XformXoff, XformYoff, 1, 12, enlarge)
+   place(XformXoff, XformYoff, 2, 12, resize)
+   place(XformXoff, XformYoff, 0, 14, crop)
+
+   place(SymmetXoff, SymmetYoff, 0, 0, hi_ident)
+   place(SymmetXoff, SymmetYoff, 1, 0, rotate_90)
+   place(SymmetXoff, SymmetYoff, 2, 0, rotate_m90)
+   place(SymmetXoff, SymmetYoff, 3, 0, rotate_180)
+   place(SymmetXoff, SymmetYoff, 0, 1, flip_right)
+   place(SymmetXoff, SymmetYoff, 1, 1, flip_left)
+   place(SymmetXoff, SymmetYoff, 2, 1, flip_vert)
+   place(SymmetXoff, SymmetYoff, 3, 1, flip_horiz)
+
+   return
+
+end
+
+#  invert bits on current pattern
+
+procedure invert()
+
+   rows := pinvert(rows)
+
+   return
+
+end
+
+#  load tile list
+
+procedure load()
+   local input
+
+   refresh_tile()
+
+   if \list_touched then {		# check to see if list should be saved
+      case SaveDialog(, loadname) of {
+          "Yes": {
+             loadname := dialog_value
+             save()
+             }
+         }
+      }
+
+   repeat {
+      case OpenDialog("Load: ") of {
+         "Okay":  {
+            loadname := dialog_value
+            if input := open(loadname) then break
+            else {
+               Notice("Can't open " || loadname)
+               next
+               }
+            }
+         "Cancel":  fail
+         }
+      }
+   load_file(input) | {
+      Notice("No patterns in file")
+      fail
+      }
+   WAttrib("label=" || loadname)
+   list_touched := &null
+
+   return setup()
+
+end
+
+#  load from file
+
+procedure load_file(input)
+   local line
+
+   plist := []
+   while put(plist, read_pattern(input))
+   close(input)
+   pindex := 1
+   rows := pat2rows(plist[pindex].tile) | fail
+
+   return
+
+end
+
+#  go to next tile
+
+procedure next_tile()
+
+   refresh_tile()
+   rows := pat2rows(plist[pindex + 1].tile) | {
+      Notice("No next tile")
+      fail
+      }
+
+   pindex +:= 1
+
+   return setup()
+
+end
+
+#  place icon
+
+procedure place(xoff, yoff, col, row, pattern)
+
+   Pattern(pattgc, pattern)
+   FillRectangle(pattgc, xoff + col * IconSize, 
+     yoff + row * IconSize, IconSize, IconSize)
+
+   return
+
+end
+
+#  go to previous tile
+
+procedure previous_tile()
+
+   rows := pat2rows(plist[pindex - 1].tile) | {
+      Notice("No previous tile")
+      fail
+      }
+
+   refresh_tile()
+   pindex -:= 1
+
+   return setup()
+
+end
+
+#  terminate session
+
+procedure quit()
+   local result
+
+   refresh_tile()
+
+   if \list_touched then {
+      case SaveDialog() of {
+         "Cancel":  fail
+         "No":      exit()
+         "Yes": {
+            loadname := dialog_value
+            save()
+            }
+         }
+      }
+
+   exit()
+
+end
+
+#  read pattern specification
+
+procedure read_pattern(file)
+   local line
+
+   line := readpattline(file) | fail
+
+   return pattrec(legaltile(getpatt(line)), getpattnote(line))
+
+end
+
+#  read and add tile to tile list
+
+procedure read_tile()
+
+   refresh_tile()
+   put(plist, read_pattern(&input)) | fail
+   pindex := *plist
+   rows := pat2rows((plist[pindex]).tile)
+
+   list_touched := 1
+
+   return setup()
+
+end
+
+#  refresh tile in list
+
+procedure refresh_tile()
+
+   if \tile_touched := &null then {
+      plist[pindex].tile := rows2pat(rows)
+      list_touched := 1
+      }
+
+   return
+
+end
+
+#  save tile list
+
+procedure save()			# should ask if file is to be saved
+   local output
+
+   refresh_tile()
+
+   if \list_touched then {
+      output := open(loadname, "w") | {
+         Notice("Can't open " || loadname)
+         fail
+         }
+      every write_pattern(output, !plist)
+      close(output)
+      list_touched := &null
+      }
+
+   return
+
+end
+
+#  save tile list in new file
+
+procedure save_as()
+   local output
+
+   refresh_tile()
+
+   repeat {
+      case OpenDialog("Save as:") of {
+         "Okay": {
+            if output := open(dialog_value, "w") then break else
+               Notice("Can't open " || dialog_value)
+            }
+         "Cancel":  fail
+         }
+      }
+   every write_pattern(output, !plist)
+   close(output)
+
+   loadname := dialog_value
+   WAttrib("label=" || loadname)
+
+   list_touched := &null
+
+   return
+
+end
+
+#  scramble bits of current tile
+
+procedure bscramble()
+
+   rows := pscramble(rows, "b")
+
+   return
+
+end
+
+#  set bits of tile
+
+procedure setbit(i, j, c)
+   local x, y, xu, yu, xv, yv, xt, yt, action
+
+   if (symmetries = 0) & (rows[i + 1, j + 1] == c) then return	# optimization
+
+   x := GridXoff + j * cellsize + 1		# the selected cell itself
+   y := GridYoff + i * cellsize + 1
+   xt := GridXoff + i * cellsize + 1
+   yt := GridYoff + j * cellsize + 1
+
+   i +:= 1					# for computational convenience
+   j +:= 1
+
+   xu := GridXoff + (hbits - j) * cellsize + 1	# opposite cells
+   yu := GridYoff + (vbits - i) * cellsize + 1
+   xv := GridXoff + (hbits - i) * cellsize + 1
+   yv := GridYoff + (vbits - j) * cellsize + 1
+
+   action := if c = 1 then FillRectangle else EraseArea
+
+   if sym_state[1, 1] = 1 then {		# cell itself
+      rows[i, j] := c
+      action(x, y, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 2] = 1 then {		# 90 degrees
+      if rows[j, -i] := c then			# may be out of bounds
+         action(xv, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 3] = 1 then {		# -90 degrees
+      if rows[-j, i] := c then			# may be out of bounds
+         action(xt, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 4] = 1 then {		# 180 degrees
+      rows[-i, -j] := c
+      action(xu, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 1] = 1 then {		# left diagonal
+      if rows[j, i] := c then			# may be out of bounds
+      action(xt, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 2] = 1 then {		# right diagonal
+      if rows[-j, -i] := c then			# may be out of bounds
+      action(xv, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 3] = 1 then {		# vertical
+      rows[-i, j] := c
+      action(x, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 4] = 1 then {		# horizontal
+      rows[i, -j] := c
+      action(xu, y, cellsize - 1, cellsize - 1)
+      }
+
+   drawpat()
+
+   return
+
+end
+
+#  set up editing grid and view area
+
+procedure setup()
+   local i, j
+
+   hbits := *rows[1]
+   vbits := *rows
+
+   if (hbits | vbits) > 80 then {		# based on cell size >= 3
+      Notice("Dimensions too large")
+      fail
+      }
+   if hbits > MaxPatt then mode := &null	# too large for pattern
+
+   cellsize := MaxCell				# cell size on window
+   cellsize >:= GridSize / (vbits + 4)
+   cellsize >:= GridSize / (hbits + 4)
+
+   grid()
+
+   every i := 1 to hbits do
+      every j := 1 to vbits do
+         if rows[j, i] == "1" then
+            FillRectangle(GridXoff + (i - 1) * cellsize,
+               GridYoff + (j - 1) * cellsize, cellsize, cellsize)
+
+   drawpat()
+
+   return
+
+end
+
+#  keyboard shortcuts
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "c"  :  copy_tile()
+      "d"  :  delete_tile()
+      "e"  :  edit_tile()
+      "f"  :  find_tile()
+      "g"  :  goto_tile()
+      "i"  :  tile_info()
+      "l"  :  load()
+      "n"  :  next_tile()
+      "p"  :  previous_tile()
+      "q"  :  return quit()
+      "r"  :  read_tile()
+      "s"  :  save()
+      "u"  :  undo_xform()
+      "w"  :  write_tile()
+      }
+
+   return
+
+end
+
+#  return number of bits set in tile for sorting
+
+procedure tile_bits(x)
+
+   return tilebits(pat2rows(x.tile))
+
+end
+
+#  show information about tile
+
+procedure tile_info()
+   local line1, line2, line3, line4, pattern, bits, density
+
+   pattern := rows2pat(rows)
+   bits := tilebits(rows)
+   density := left(bits / real(*rows[1] * *rows), 6)
+
+   line1 := left(loadname ||" " ||  pindex || " of " || *plist, InfoLength)
+   line2 := left(*rows[1] || "x" || *rows || " b=" || bits || " d=" ||
+      density, InfoLength)
+   line3 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] ||
+      "..." else left(pattern, InfoLength)
+   line4 := left(plist[pindex].note, InfoLength)
+
+   Notice(line1, line2, line3, line4)
+
+   return
+
+end
+
+#  return annotation of tile for sorting
+
+procedure tile_note(x)
+
+   return x.note
+
+end
+
+#  return tile size for sorting
+
+procedure tile_size(x)
+   local dims
+
+   dims := tiledim(x.tile)
+
+   return dims.w * dims.h
+
+end
+
+#  undo transformation
+
+procedure undo_xform()
+
+   rows := pat2rows(old_pat)
+
+   return setup()
+
+end
+
+#  write pattern
+
+procedure write_pattern(file, pattern)
+
+   if *pattern.note = 0 then write(file, pattern.tile)
+   else write(file, pattern.tile, "\t# ", pattern.note)
+
+   return
+
+end
+
+#  write tile
+
+procedure write_tile()
+
+   write_pattern(&output, pattrec(rows2pat(rows), (plist[pindex]).note))
+
+   return
+
+end
+
+#  handle transformation
+
+procedure xform(col, row)
+   local result
+   static params
+
+   tile_touched := 1
+
+   return case col of {
+      0:   case row of {
+         1:   pshift(rows, -1, "h")
+         4:   pflip(rows, "r")
+         5:   pflip(rows, "l")
+         7:   protate(rows, 90)
+         8:   protate(rows, -90)
+         10:  list(vbits, repl("0", hbits))
+         12:  ptrim(rows)
+         14:  {
+              if /allxform then {
+                 case Dialog("Crop:", ["left", "right", "top", "bottom"],
+                    0, 3, ["Okay", "Cancel"]) of {
+                       "Cancel":   fail
+                        "Okay": {
+                           icheck(dialog_value) | fail
+                           result := copy(params := dialog_value)
+                           push(result, rows)
+                           pcrop ! result
+                           }
+                    }
+                 }
+            }
+         default:   fail
+         }
+      1: case row of {
+         0:   pshift(rows, -1, "v")
+         2:   pshift(rows, 1, "v")
+         4:   pflip(rows, "v")
+         5:   pflip(rows, "h")
+         7:   protate(rows, 180)
+         10:  pinvert(rows)
+         12:  {
+              if /allxform then {
+                 case Dialog("Enlarge:", ["left", "right", "top", "bottom"],
+                    0, 3, ["Okay", "Cancel"]) of {
+                       "Cancel":  fail
+                       "Okay":  {
+                           icheck(dialog_value) | fail
+                           result := copy(params := dialog_value)
+                           push(result, rows)
+                           pborder ! result
+                           }
+                       }
+                    }
+                 }
+         default:   fail
+         }
+      2: case row of {
+         1:   pshift(rows, 1, "h")
+         10:  pscramble(rows, "b")
+         12:  {
+              if /allxform then {
+                 case Dialog("Center:", ["width", "height"], [*rows[1], *rows], 
+                    3, ["Okay", "Cancel"]) of {
+                    "Cancel":  fail
+                    "Okay": {
+                       icheck(dialog_value) | fail
+                       result := copy(params := dialog_value)
+                       push(result, rows)
+                       pcenter ! result
+                       }
+                    }
+                 }
+              }
+         default:   fail
+         }
+      default:   fail
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=730,420", "bg=pale gray", "label=Penelope"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,730,420:Penelope",],
+   ["file:Menu:pull::0,1,36,21:file",file_cb,
+      ["load  @L","save  @S","save as","read  @R","write @W",
+      "quit  @Q"]],
+   ["line1:Line:::1,22,729,22:",],
+   ["line2:Line:::133,32,133,420:",],
+   ["line3:Line:::427,22,427,419:",],
+   ["list:Menu:pull::73,1,36,21:list",list_cb,
+      ["clear","reverse","delete range","sort",
+         ["by size","by bits","by notes"]]],
+   ["note:Menu:pull::145,1,36,21:note",note_cb,
+      ["edit @E","find @F"]],
+   ["symmetries:Label:::156,338,70,13:symmetries",],
+   ["tile:Menu:pull::37,1,36,21:tile",tile_cb,
+      ["next     @N","previous @P","first","last","goto     @G",
+      "delete   @D","revert","copy     @C","new","info     @I"]],
+   ["transformations:Label:::8,32,105,13:transformations",],
+   ["view:Menu:pull::110,1,36,21:view",view_cb,
+      ["pattern","tile","tile zoom",
+         ["1:1","2:1","4:1","8:1"]]],
+   ["logo:Rect:invisible::26,373,32,32:",logo_cb],
+   ["symmet:Rect:grooved::155,363,74,42:",symmet_cb],
+   ["xform:Rect:grooved::26,57,58,256:",xform_cb],
+   ["grid:Rect:grooved::153,64,251,256:",grid_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/pextract.icn b/ipl/gprogs/pextract.icn
new file mode 100644
index 0000000..60f96d7
--- /dev/null
+++ b/ipl/gprogs/pextract.icn
@@ -0,0 +1,101 @@
+############################################################################
+#
+#	File:     pextract.icn
+#
+#	Subject:  Program to separate good and bad patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 1, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the name of a file containing tile specifications
+#  on the command line.   Tiles to be extracted are entered from standard
+#  input.  Extracted tiles are written to standard output.
+#
+#  Options:
+#
+#	-b		replace selected tiles by blank tiles
+#	-d		delete selected tiles from specification file
+#	-c		copy selected tiles, do not blank or delete
+#			  them.  This is the default; -c overrides
+#			  -b and -d.
+#
+############################################################################
+#
+#  Links:  options, patutils
+#
+############################################################################
+
+link options
+link patutils
+
+procedure main(args)
+   local file, input, i, hitlist, patlist, spec, lo, hi, output
+   local subspec, opts
+
+   opts := options(args, "cbd")
+   if \opts["c"] then opts["b"] := opts["d"] := &null
+   if \opts["d"] then opts["b"] := 1
+
+   file := args[1] | stop("*** no pattern list specified")
+
+   input := open(file) | stop(" *** cannot open input file")
+ 
+   hitlist := set()			# construct set of indices to remove
+
+   while spec := read() do {
+      spec ? {
+         while subspec := tab(upto(',') | 0) do {
+            if insert(hitlist, integer(subspec)) then {		# integer
+               move(1) | break
+               tab(many(' '))
+               }
+            else {
+               subspec ? {
+                  lo := tab(many(&digits)) &
+                  ="-" &
+                  hi := tab(many(&digits)) &
+                  lo <= hi &
+                  pos(0) | {
+                     write(&errout, "*** bad specification")
+                     next
+                     }
+                  if not(integer(hi) & integer(lo)) then {
+                     write(&errout, "*** bad specification")
+                     next
+                     }
+                  every insert(hitlist, 0 < (lo to hi))
+                  }
+               move(1) | break
+               tab(many(' '))
+               }
+            }
+         }
+      }
+
+   patlist := []			# read in list of patterns
+
+   while put(patlist, readpatt(input))
+
+   close(input)
+
+   output := open(file, "w") |
+      stop("*** cannot reopen specified file for output")
+   
+   every i := !sort(hitlist) do {		# discard and "delete"
+      write(patlist[i]) | write(&errout, "*** ", i, " out of bounds")
+      if \opts["b"] then patlist[i] := "1,#0"
+      }
+
+   if \opts["d"] then
+      every write(output, "1,#0" ~== !patlist)
+   else
+      every write(output, !patlist)
+
+end
diff --git a/ipl/gprogs/pgmtoims.icn b/ipl/gprogs/pgmtoims.icn
new file mode 100644
index 0000000..c58813d
--- /dev/null
+++ b/ipl/gprogs/pgmtoims.icn
@@ -0,0 +1,111 @@
+############################################################################
+#
+#	File:     pgmtoims.icn
+#
+#	Subject:  Program to make an image from a PGM file
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  pgmtoims [-gn] [file]
+#
+#  Pgmtoims reads a PGM rawbits file and writes an Icon image string.
+#  The "-gn" option (2 <= n <= 64) selects the palette; g41 is the
+#  default.
+#
+#  Note that only rawbits-format PGM files can be read.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options
+#
+############################################################################
+
+link options
+
+procedure main(args)
+   local opts, g, cs, f, w, h, maxv, data, s, i, n, ln
+
+   # Process options.
+   opts := options(args, "g+")
+   g := \opts["g"] | 41
+   if g < 2 | g > 64 | *args > 1 then
+      stop("usage: ", &progname, " [-gn] [file]")
+
+   # Select the set of image characters according to the palette.
+   cs := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz{}"
+   cs := cs[1+:g]
+
+   # Open the file and read it into memory.
+   if *args = 1 then
+      f := open(args[1], "ru") | stop("can't open ", args[1])
+   else
+      f := &input
+   s := ""
+   while s ||:= reads(f, 1000)
+
+   # Crack the file header.
+   s ? {
+      ws()
+      if ="P" & any('1346') then
+         stop("input is not in PGM format; convert via \"ppmtopgm\"")
+      if ="P2" then
+         stop("input is not in *raw* PGM format")
+      if not ="P5" then
+         stop("input is not a PGM file")
+      ws()
+      w := tab(many(&digits))		# image width
+      ws()
+      h := tab(many(&digits))		# image height
+      ws()
+      maxv := tab(many(&digits))	# maximum byte value in input
+      tab(any(' \t\r\n'))
+      data := tab(0)			# image data
+      }
+
+   # Calculate the translation from input to output data bytes.
+   s := ""
+   every i := 0 to maxv do 
+      s ||:= cs[1 + (g * i) / (maxv + 1)]
+
+   # Figure out a reasonable line length for output,
+   # assuming not too many backslashes.
+   n := 79 > w / seq(1)
+   if w % n > 0 then
+      n +:= 1
+
+   # Translate the data a line at a time, and write.
+   map(data, &cset, s) ? {
+      write("\"", w, ",g", g, ",_")
+      while not pos(0) do wdata(move(w) | tab(0), n)
+      write("\"")
+      }
+end
+
+
+#  wdata(s, n) -- write one line of data with max linelength n
+
+procedure wdata(s, n)
+   s ? while not pos(0) do 
+      write(image(move(n) | tab(0)) [2:-1], "_")
+   return
+end
+
+
+#  ws() -- skip whitespace.
+
+procedure ws()
+   while tab(many(' \t\r\n')) | (="#" & tab(upto('\n')))
+   return
+end
diff --git a/ipl/gprogs/picktile.icn b/ipl/gprogs/picktile.icn
new file mode 100644
index 0000000..ece5971
--- /dev/null
+++ b/ipl/gprogs/picktile.icn
@@ -0,0 +1,164 @@
+############################################################################
+#
+#	File:     picktile.icn
+#
+#	Subject:  Program to pick a tile out of an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program provides an optionally magnified view of an image file.
+#  Clicking on a pixel produces a pattern specification for the tile
+#  with the selected upper-left corner.
+#
+#  Options are:
+#
+#	-z i	zoom factor, default 1 (no magnification)
+#	-f	use fixed size tiles rather than selection; default selection
+#	-w i	width of tile, default 32
+#	-h i	height of tile, default width
+#	-I	pick tiles to make icons; implies -z2, -f, -w38, -w38 (the
+#		  larger size leaves room for error and trimming)
+#	-R i	specs for ResEdit files; i = 32 or 16
+# 	-t	trim whitepace around tile
+#
+#  Typical usage is
+#
+#	picktile image.xbm >image.tle
+#
+#  The program terminates if "q" is pressed when in the image window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, patxform, win, xcompat
+#
+############################################################################
+
+link options
+link patxform
+link win
+link xcompat
+
+procedure main(args)
+   local pixmap, wix, hix, c, x, y, event, opts, base, magnif, cols, rows
+   local arglist, state, x0, x1, y0, y1, pattern
+
+   opts := options(args, "tz+w+h+If")
+   magnif := \opts["z"] | 1
+   cols := \opts["w"] | 32
+   rows := \opts["h"] | cols
+
+   if \opts["I"] then {
+      magnif := 2
+      cols := rows := 38
+      opts["f"] := 1
+      }
+
+   pixmap := XBind(, , ,"image=" || args[1]) |
+      stop("*** cannot open image file")
+
+   wix := WAttrib(pixmap, "width")
+   hix := WAttrib(pixmap, "height")
+
+   win(magnif * wix, magnif * hix)
+
+#  Build the magnified image.
+
+#  But if the magnification happens to be 1, don't do it the dumb way.
+
+   if magnif = 1 then
+      CopyArea(pixmap, &window)
+
+   else {
+      every y := 0 to hix - 1 do {
+         arglist := []
+
+         every x := 0 to wix - 1 do {
+            c := Pixel(pixmap, x, y, 1, 1)
+            if c == "0,0,0" then {
+               every put(arglist, (magnif * x) | (magnif * y) | magnif | magnif)
+               }
+            x +:= 1
+            }
+
+         if *arglist > 0 then FillRectangle ! arglist
+         }
+      }
+
+   if \opts["f"] then {				# let user pick corners
+      while event := Event() do {
+         case event of {
+            "q":   exit()
+            &lpress | &mpress | &rpress: {
+               pattern := pix2pat(pixmap, &x / magnif, &y / magnif, cols, rows)
+               if \opts["t"] then pattern := rows2pat(ptrim(pat2rows(pattern)))
+               write(pattern)
+               }
+            }
+         }
+      }
+
+
+   else {					# let user drag to select area
+      state := "pick"				# waiting for user to pick
+   
+      WAttrib("drawop=reverse")
+      WAttrib("linestyle=dashed")
+   
+      while event := Event() do {
+         if event === "q" then exit()
+         case state of {
+            "pick": {				# pick the upper-left corner
+               if event === &lpress then {
+                  x1 := x0 := &x		# initial coordinates
+                  y1 := y0 := &y
+                  DrawRectangle(x0, y0, 0, 0)	# start the selection rectangle
+                  state := "select"		# now select the rectangle
+                  }
+               }
+            "select": {				# select the rectangle
+               case event of {
+                  &ldrag: {			# searching ...
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # erase rectangle
+                     x1 := &x			# new lower-right
+                     y1 := &y
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # new rectangle
+                     }
+                  &lrelease: {			# got it!
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # erase rectangle
+                     x1 := &x			# new lower-right
+                     y1 := &y
+                     DrawRectangle(x0, y0, x1 - x0, y1 - y0) # new rectangle
+                     state := "decide"			# now decide
+                     }
+                  }
+               }
+            "decide": {				# is it wanted or not?
+               DrawRectangle(x0, y0, x1 - x0, y1 - y0) # erase rectangle
+               if event === &lpress then {
+                  if (x0 <= &x <= x1) & (y0 <= &y <= y1) then {
+                     pattern := pix2pat(pixmap, x0 / magnif, y0 / magnif,
+                        (x1 - x0) / magnif, (y1 - y0) / magnif)
+                     if \opts["t"] then
+                        pattern := rows2pat(ptrim(pat2rows(pattern)))
+                     write(pattern)
+                     }
+                  }
+               state := "pick"			# go for another
+               }
+            }
+         }
+      }
+
+end
diff --git a/ipl/gprogs/plat.icn b/ipl/gprogs/plat.icn
new file mode 100644
index 0000000..881a9b2
--- /dev/null
+++ b/ipl/gprogs/plat.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     plat.icn
+#
+#	Subject:  Program to create image file with specified colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces image files from color lists, in which the
+#  image file contains one pixel for each color.  The image files are
+#  16x16 pixels.  If a color list has less than 256 colors, the rest
+#  of the image is black.  If the color list has more than 256 colors
+#  only the first 256 are processed.
+#
+#  The image file names have the basename of the color list files followed
+#  by _p and the suffix .gif.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wopen
+#
+############################################################################
+
+link basename
+link wopen
+
+procedure main(args)
+   local line, file, name, input, i, j, color
+
+   WOpen("canvas=hidden", "size=16,16", "bg=black") |
+      stop("*** cannot open window")
+
+   every file := !args do {
+      input := open(file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      name := basename(file, ".clr")
+      EraseArea()
+      every i := 0 to 15 do
+         every j := 0 to 15 do {
+         color := read(input) | break
+         color ? {
+            Fg(tab(upto('\t') | 0)) |
+               write(&errout, "*** cannot set foreground")
+            }
+         DrawPoint(i, j)
+         }
+      WriteImage(name || "_p.gif")
+      close(input)
+      }
+
+end
+      
+  
diff --git a/ipl/gprogs/plotter.icn b/ipl/gprogs/plotter.icn
new file mode 100644
index 0000000..f13d337
--- /dev/null
+++ b/ipl/gprogs/plotter.icn
@@ -0,0 +1,199 @@
+############################################################################
+#
+#	File:     plotter.icn
+#
+#	Subject:  Program to display planes of 3-space coordinates
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 22, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program plots planes for coordinates in 3-space.
+#
+############################################################################
+#
+#  Requires: Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  interact, io, ptutils, vsetup
+#
+############################################################################
+
+link interact
+link io
+link ptutils
+link vsetup
+
+global coords
+global h_off
+global half
+global size
+global pane
+global plane
+global root
+global scale
+global size
+global v_off
+global vidgets
+
+procedure main()
+
+   vidgets := ui()
+   root := vidgets["root"]
+
+   VSetItems(vidgets["coords"], filelist("*.crd"))
+   VSetState(vidgets["plane"], "xy")
+
+   size := vidgets["pane"].uw
+   half := size / 2
+
+   pane := Clone("bg=white", "dx=" || (vidgets["pane"].ux + half),
+      "dy=" || (vidgets["pane"].uy + half))
+   Clip(pane, -half, -half, size, size)
+
+   EraseArea(pane, -half, -half, size, size)
+
+   scale := 10
+   h_off := 0
+   v_off := 0
+
+   GetEvents(root, , shortcuts)
+
+end
+
+procedure offset_cb()
+
+   repeat {
+      if TextDialog("Set offset:", ["horizontal", "vertical"],
+         [h_off, v_off], 5) == "Cancel" then fail
+      if h_off <- integer(dialog_value[1]) &
+         v_off <- integer(dialog_value[2]) then break
+      else {
+         Notice("Nonnumeric offset value.")
+         next
+         }
+      }
+
+   return
+
+end
+
+procedure scale_cb()
+
+   repeat {
+      if TextDialog("Set scale:", , scale, 5) == "Cancel" then fail
+      if scale := integer(dialog_value[1]) then break
+      else {
+         Notice("Nonnumeric scale value.")
+         next
+         }
+      }
+
+   return
+
+end
+
+procedure file_cb(vidgets, value)
+
+   case value[1] of {
+      "clear @C":     clear_cb()
+      "plot @P":      plot_cb()
+      "quit @Q":      exit()
+      "snapshot @S":  snapshot(pane, -half, -half, size, size)
+      }
+
+   return
+
+end
+
+procedure coord_cb(vidget, value)
+   local input
+
+   input := open(value) | {
+      Notice("Cannot open " || image(value) || ".")
+      fail
+      }
+
+   coords := []
+
+   every put(coords, coord2pt(!input))
+
+   close(input)
+
+   return
+
+end
+
+procedure plot_cb()
+   local p
+
+   every p := !coords do {
+      case plane of { 
+         "xy":  DrawPoint(pane, scale * p.x + h_off, scale * p.y + v_off)
+         "yz":  DrawPoint(pane, scale * p.y + h_off, scale * p.z + v_off)
+         "xz":  DrawPoint(pane, scale * p.x + h_off, scale * p.z + v_off)
+         }
+      }
+
+end
+
+procedure plane_cb(vidget, value)
+
+   plane := value
+
+   return
+
+end
+
+procedure clear_cb()
+
+   EraseArea(pane, -half, -half, size, size)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {			# fold case
+         "c":   clear_cb()
+         "p":   plot_cb()
+         "q":	exit()
+         "s":	snapshot(pane, -half, -half, size, size)
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=633,459", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,633,459:",],
+   ["clear:Button:regular::82,101,50,20:clear",clear_cb],
+   ["coords:List:w::13,198,190,244:",coord_cb],
+   ["file:Menu:pull::28,5,36,21:File",file_cb,
+      ["clear @C","plot @P","snapshot @S","quit @Q"]],
+   ["label1:Label:::28,45,35,13:plane",],
+   ["label2:Label:::50,174,105,13:coordinate file",],
+   ["line1:Line:::0,30,640,30:",],
+   ["offset:Button:regular::143,72,50,20:offset",offset_cb],
+   ["plane:Choice::3:25,68,43,63:",plane_cb,
+      ["xy","xz","yz"]],
+   ["plot:Button:regular::81,71,50,20:plot",plot_cb],
+   ["scale:Button:regular::144,101,50,20:scale",scale_cb],
+   ["pane:Rect:grooved::220,43,400,400:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/pme.icn b/ipl/gprogs/pme.icn
new file mode 100644
index 0000000..6a29253
--- /dev/null
+++ b/ipl/gprogs/pme.icn
@@ -0,0 +1,180 @@
+############################################################################
+# 
+#	File:     pme.icn
+# 
+#	Subject:  Program to edit pixmaps
+# 
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     April 30, 2001
+# 
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  2.0
+#
+############################################################################
+#
+#     A (color) pixmap editor.
+#
+#     Left, middle, and right buttons draw different colors.
+# Press q or ESC to quit; press s to save.  Capital "S" prompts for
+# and saves under a new filename.
+# Click on the little picture of the mouse to change one of the
+# button's colors.  Not very interesting on a monochrome server.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen, xcompat
+#
+############################################################################
+
+link wopen
+link xcompat
+global w, WIDTH, HEIGHT, XBM, LMARGIN
+global colors, colorbinds
+
+procedure main(argv)
+   local i, f, s, xpos, ypos, i8, j, j8, j8Plus, e, x, y
+   colors := [ "red", "green", "blue" ]
+   i := 1
+   XBM := ".xpm"
+   WIDTH  := 32
+   HEIGHT := 32
+   if *argv>0 & argv[1][1:5]=="-geo" then {
+      i +:= 1
+      if *argv>1 then argv[2] ? {
+	 WIDTH := integer(tab(many(&digits))) | stop("geo syntax")
+	 ="x" | stop("geo syntax")
+	 HEIGHT := integer(tab(0)) | stop("geo syntax")
+	 i +:= 1
+	 }
+      }
+   LMARGIN := WIDTH
+   if LMARGIN < 65 then LMARGIN := 65
+   if (*argv >= i) &
+      (f := open(s := (argv[i] | (argv[i]||(XBM|".xbm"))))) then {
+	close(f)
+	w := &window := WOpen("label=PixMap", "image="||s, "cursor=off") |
+	   stop("cannot open window")
+	WIDTH  <:= WAttrib(w, "width")
+	HEIGHT <:= WAttrib(w, "height")
+	LMARGIN := WIDTH
+	if LMARGIN < 65 then LMARGIN := 65
+	pos := WAttrib("pos")
+	pos ? {
+	   xpos := tab(many(&digits)) | stop(image(pos))
+	   =","
+	   ypos := tab(0)
+	   }
+	WAttrib(w, "posx="||xpos, "posy="||ypos,
+		"width="||(WIDTH*8+LMARGIN+5), "height="||(HEIGHT*8))
+	Event()
+	every i := 0 to HEIGHT-1 do {
+	   i8 := i*8
+	   every j := 0 to WIDTH-1 do {
+	      j8 := j*8
+	      j8Plus := j8 + LMARGIN + 5
+	      CopyArea(w, w, j, i, 1, 1, j8Plus,   i8)
+	      CopyArea(w, w, j, i, 1, 1, j8Plus+1, i8)
+	      CopyArea(w, w, j8Plus, i8, 2, 1, j8Plus+2,i8)
+	      CopyArea(w, w, j8Plus, i8, 4, 1, j8Plus+4, i8)
+	      CopyArea(w, w, j8Plus, i8, 8, 1, j8Plus, i8+1)
+	      CopyArea(w, w, j8Plus, i8, 8, 2, j8Plus, i8+2)
+	      CopyArea(w, w, j8Plus, i8, 8, 4, j8Plus, i8+4)
+	      }
+	   }
+	} else {
+	   w := &window := WOpen("label=PixMap", "cursor=off",
+				"width="||(LMARGIN+WIDTH*8+5),
+				"height="||(HEIGHT*8+5)) |
+             stop("cannot open window")
+	   }
+
+   colorbinds := [ XBind(w,"fg="||colors[1]),
+		  XBind(w,"fg="||colors[2]),
+		  XBind(w,"fg="||colors[3]) ]
+   every i := 1 to 3 do {
+      XDrawArc( 4+i*10, HEIGHT+68, 7, 22)
+      XFillArc(colorbinds[i], 5+i*10, HEIGHT+70, 5, 20)
+      }
+   DrawRectangle( 5, HEIGHT+55, 45, 60)
+   DrawRectangle( 25, HEIGHT+50, 5, 5)
+   DrawCurve(27, HEIGHT+50,
+	      27, HEIGHT+47,
+	      15, HEIGHT+39,
+	      40, HEIGHT+20,
+	      25, HEIGHT+5)
+
+   Fg( "black")
+   every i := 0 to HEIGHT-1 do
+      every j := 0 to WIDTH-1 do
+         DrawRectangle( j*8+LMARGIN+5, i*8, 8, 8)
+
+   DrawLine( 0, HEIGHT, WIDTH, HEIGHT, WIDTH, 0)
+
+  repeat {
+     case e := Event(w) of {
+	"q"|"\e": return
+	"s"|"S": {
+	   if /s | (e=="S") then s := getfilename()
+	   write("saving image ", s, " with width ", image(WIDTH),
+		 " height ", image(HEIGHT))
+	   WriteImage( s, 0, 0, WIDTH, HEIGHT)
+	   }
+	&lpress | &ldrag | &mpress | &mdrag | &rpress | &rdrag : {
+
+	   x := (&x - LMARGIN - 5) / 8
+	   y := &y / 8
+
+	   if (y < 0) | (y > HEIGHT-1) | (x > WIDTH) then next
+	   if (x < 0) then {
+	      if &x < 21 then getacolor(1, "left")
+	      else if &x < 31 then getacolor(2, "middle")
+	      else getacolor(3, "right")
+	      until Event(w) === (&mrelease | &lrelease | &rrelease)
+	      }
+	   else dot(x, y, (-e-1)%3)
+	   }
+	}
+     }
+end
+
+procedure getacolor(n, s)
+   local wtmp, theColor
+   wtmp := WOpen("label=" || image(s||" button: "), "lines=1") |
+      stop("can't open temp window")
+   writes(wtmp,"[",colors[n],"] ")
+   theColor := read(wtmp) | stop("read fails")
+   close(wtmp)
+   wtmp := colorbinds[n] | stop("colorbinds[n] fails")
+   Fg(wtmp, theColor) | write("XFG(", theColor, ") fails")
+   XFillArc(wtmp, 5+n*10, HEIGHT+70, 5, 20)
+   colors[n] := theColor
+end
+
+procedure dot(x, y, color)
+   if (x|y) < 0 then fail
+   FillRectangle(colorbinds[color+1], x*8+LMARGIN+5, y*8, 8, 8)
+   DrawPoint(colorbinds[color+1], x, y)
+   DrawRectangle( x*8+LMARGIN+5, y*8, 8, 8)
+end
+
+procedure getfilename()
+   local s, pos, wprompt, rv
+   pos := "pos="
+   every s := QueryPointer() do pos||:= (s-10)||","
+   wprompt := WOpen("label=Enter a filename to save the pixmap",
+		   "font=12x24", "lines=1", pos[1:-1]) | stop("can't xprompt")
+   rv := read(wprompt)
+   close(wprompt)
+   if not find(XBM, rv) then rv ||:= XBM
+   return rv
+end
diff --git a/ipl/gprogs/poller.icn b/ipl/gprogs/poller.icn
new file mode 100644
index 0000000..ad69592
--- /dev/null
+++ b/ipl/gprogs/poller.icn
@@ -0,0 +1,80 @@
+############################################################################
+#
+#	File:     poller.icn
+#
+#	Subject:  Program to record image as pixel coordinates
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 30, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program reads an image whose name is given on the command line and
+#  writes it out as an Icon list of pixels in the form of an include file.
+#  See the documentation below for details.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  lists, wopen
+#
+############################################################################
+
+link lists
+link wopen
+
+procedure main(args)
+   local colors, width, height, x, y, c
+
+   WOpen("image=" || args[1]) | stop("*** cannot open image")
+
+   colors := table()
+
+   width := WAttrib("width")
+   height := WAttrib("height")
+
+   x := y := 0
+
+   #  Build table of argument lists for colors
+
+   every c := Pixel() do {
+      x +:= 1
+      if x % width = 0 then {
+         x := 0
+         y +:= 1
+         }
+      /colors[c] := []			# new color
+      put(colors[c], x, y)
+      }
+
+   #  Write Icon code for an include file.  A list of argument lists
+   #  is assigned to "pixels".  Each argument list consists of the
+   #  color followed by the pixel coordinates at which that color
+   #  occurs
+   #
+   #  The last element of the list is a three-element list giving the
+   #  width, height, and number of colors in the image.  Note that this
+   #  is an easily accessible location and that it "solves" the problem
+   #  that all previous lines are termianted by commas, so without it
+   #  either there would be a trailing empty element in "pixels"
+   #  or some painful code would be necessary to avoid it.
+
+   write("pixels:=[")
+
+   every c := key(colors) do {
+      push(colors[c], c)
+      write(limage(colors[c]), ",")
+      }
+
+   write("[", width, ",", height, ",", *colors,  "]")
+   write("]")
+
+end
diff --git a/ipl/gprogs/procater.icn b/ipl/gprogs/procater.icn
new file mode 100644
index 0000000..721389f
--- /dev/null
+++ b/ipl/gprogs/procater.icn
@@ -0,0 +1,185 @@
+############################################################################
+#
+#	File:     procater.icn
+#
+#	Subject:  Program to display concatenation sizes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 18, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  In this version, input is piped in.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: interact, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+
+global vidgets
+global root
+global strip
+global state
+global gc_gray
+global gc_black
+global reset
+global scale
+
+global width
+global height
+
+procedure main(args)
+
+   init(args)
+
+   display()
+
+end
+
+procedure init(args)
+
+   WOpen ! ui_atts()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   state := &null
+   scale := 1
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone("dx=" || vidgets["strip"].ux, "dy=" || vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+   gc_gray := Clone(strip, "fg=gray")
+   gc_black := Clone(strip, "fg=black")
+
+end
+
+procedure display()
+   local n, gc
+
+   repeat {
+      repeat {
+         while (*Pending() > 0) | \state do
+            ProcessEvent(root, , shortcuts)
+         n := read() | {
+            Notice("End of data.")
+            fail
+            }
+         n ? {
+            if ="a" then {
+               n := tab(0)
+               gc := gc_gray
+               }
+            else gc := gc_black
+            }
+         n := scale * integer(n) | {
+            Notice("Nonnumeric data; terminating.")
+            break
+            }
+         n >:= height			# Motif bug avoidance
+         CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+         EraseArea(strip, width - 1, 0, width, height)
+         DrawLine(gc, width - 1, height - n, width - 1, height)
+         }
+   }
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot  @S":  return snapshot(strip, 0, 0, width, height)
+      "quit      @Q":  exit()
+      }
+   
+   fail
+
+end
+
+procedure configure_cb(vidget, value)
+
+   case value[1] of {
+      "scale":  {
+         repeat {
+            if TextDialog(, "scale", scale, 10) == "Okay" then {
+               scale := (0 < numeric(dialog_value[1])) | {
+                  Notice("Invalid scale value.")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      }
+
+   fail
+
+end
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure reset_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "q":  exit()
+         "s":  return snapshot(strip, 0, 0, width, height)
+         }
+   else fail
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=477,255", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,477,255:",],
+   ["configure:Menu:pull::36,0,71,21:Configure",configure_cb,
+      ["scale"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open      @O","snapshot  @S","quit      @q"]],
+   ["line1:Line:::0,22,477,22:",],
+   ["pause:Button:regular:1:11,43,42,20:pause",pause_cb],
+   ["reset:Button:regular::11,76,42,20:reset",reset_cb],
+   ["strip:Rect:grooved::63,37,400,200:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/profile.icn b/ipl/gprogs/profile.icn
new file mode 100644
index 0000000..8b89a2d
--- /dev/null
+++ b/ipl/gprogs/profile.icn
@@ -0,0 +1,305 @@
+############################################################################
+#
+#	File:     profile.icn
+#
+#	Subject:  Program to display scrolling histogram
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 21, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  If a line has a number followed by a blank and a string, the string
+#  is interpreted as a color.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, navitrix, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+
+global animate			# animation toggle
+global count			# frame count
+global height			# height of scrolling area
+global input			# input file
+global name			# input file name
+global offset			# base-line offset
+global pause			# pause vidget
+global prefix			# image file name prefix
+global rate			# sample rate
+global reset			# reset switch
+global scale			# vertical scale
+global state			# pause/run state
+global strip			# graphics context for display
+global width			# width of scrolling area
+global vidgets
+global root
+
+procedure main()
+   local value, n, color
+
+   init()
+
+   color := "black"		# default color
+
+   while value := read() do {
+      if (*Pending() > 0) | \state then
+         ProcessEvent(root, , shortcuts)
+      value ? {
+         n := tab(upto(' \t') | 0)
+         if tab(many(' \t')) then color := tab(0)
+         }
+      n := (scale * numeric(n)) | {
+         Fg("black")
+         Notice("Nonnumeric data; terminating.")
+         exit()
+         }
+      n >:= height			# clip to avoid window-manager bugs
+      CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+      EraseArea(strip, width - 1, 0, width, height)
+      Fg(strip, color) | stop("bad color: ", image(color))
+      DrawLine(strip, width - 1, height - n - offset, width - 1,
+         height - offset)
+      if \animate then
+         WriteImage(strip, prefix || right(count +:= 1, 4, "0") || ".gif",
+               0, 0, width, height)
+      }
+
+   Fg("black")
+
+   case TextDialog("End of stream.", , , , ["Quit", "Snapshot", "Hold"]) of {
+      "Quit"      :  exit()
+      "Snapshot"  :  snapshot(strip, 0, 0, width, height)
+      "Hold"      :  WDone()
+      }
+
+end
+
+procedure init()
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+   pause := vidgets["pause"]
+   VSetState(pause, 1)			# initially paused
+
+   name := ""
+   rate := 1
+   scale := 1
+   offset := 0
+
+   count := 0
+   prefix := "image"
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone("dx=" || vidgets["strip"].ux, "dy=" || vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+
+   return
+
+end
+
+procedure animation_cb(vidget, value)
+
+   case value[1] of {
+      "prefix"  :  set_prefix()
+      "rate"    :  set_frame_rate()
+      }
+
+end
+
+procedure set_prefix()
+
+   return
+
+end
+
+procedure set_frame_rate()
+
+   return
+
+end
+
+procedure animate_cb(vidget, value)
+
+   animate := value
+
+   return
+
+end
+
+procedure parameters_cb(vidget, value)
+
+   case value[1] of {
+      "scale  @V"  :  set_scale()
+      "offset @F"  :  set_offset()
+      "rate   @R"  :  set_rate()
+      }
+
+   fail
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "snapshot @S"  :  return snapshot(strip, 0, 0, width, height)
+      "quit     @Q"  :  exit()
+      }
+   
+end
+
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure clear_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure set_rate()
+
+   repeat {
+      if TextDialog(, "sample rate", rate, 10) == "Okay" then {
+         rate := (0 < numeric(dialog_value[1])) | {
+            Notice("Invalid sample rate.")
+            next
+            }
+         clear_cb()
+         return
+         }
+      else fail			# user canceled
+      }
+
+end
+
+procedure set_offset()
+
+   repeat {
+      if TextDialog(, "vertical offset", offset, 10) == "Okay" then {
+         offset := numeric(dialog_value[1]) | {
+            Notice("Invalid offset.")
+            next
+            }
+         clear_cb()
+         return
+         }
+      else fail			# user canceled
+      }
+
+end
+
+procedure set_scale()
+
+   repeat {
+      if TextDialog(, "vertical scale", scale, 10) == "Okay" then {
+         scale := (0 < numeric(dialog_value[1])) | {
+            Notice("Invalid scale value.")
+            next
+            }
+         clear_cb()
+         return
+         }
+      else fail			# user canceled
+      }
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "c"  :  clear_cb()
+         "f"  :  set_offset()
+         "p"  :  if \state then VSetState(pause) else VSetState(pause, 1)
+         "q"  :  exit()
+         "r"  :  set_rate()
+         "s"  :  snapshot(strip, 0, 0, width, height)
+         "v"  :  set_scale()
+         }
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=651,305", "bg=pale gray", "label=Scrolling Histogram"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,651,305:Scrolling Histogram",],
+   ["animate:Button:regular:1:21,189,56,20:movie",animate_cb],
+   ["animation:Menu:pull::113,1,71,21:Animation",animation_cb,
+      ["prefix","rate","clear"]],
+   ["clear:Button:regular::21,88,56,20:clear",clear_cb],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["snapshot @S","quit     @q"]],
+   ["label1:Label:::619,144,21,13:100",],
+   ["label10:Label:::90,269,21,13:500",],
+   ["label11:Label:::584,269,21,13:  0",],
+   ["label2:Label:::619,195,21,13: 50",],
+   ["label3:Label:::619,94,21,13:150",],
+   ["label4:Label:::619,45,21,13:200",],
+   ["label5:Label:::619,247,21,13:  0",],
+   ["label6:Label:::489,269,21,13:100",],
+   ["label7:Label:::388,269,21,13:200",],
+   ["label8:Label:::287,269,21,13:300",],
+   ["label9:Label:::188,269,21,13:400",],
+   ["line10:Line:::501,253,501,262:",],
+   ["line11:Line:::200,255,200,264:",],
+   ["line12:Line:::500,40,500,49:",],
+   ["line13:Line:::200,40,200,49:",],
+   ["line14:Line:::615,51,604,51:",],
+   ["line15:Line:::615,253,604,253:",],
+   ["line16:Line:::603,256,603,265:",],
+   ["line17:Line:::101,255,101,264:",],
+   ["line18:Line:::101,253,90,253:",],
+   ["line19:Line:::100,51,89,51:",],
+   ["line2:Line:::90,151,99,151:",],
+   ["line20:Line:::603,40,603,49:",],
+   ["line21:Line:::101,40,101,49:",],
+   ["line22:Line:::400,255,400,264:",],
+   ["line23:Line:::400,40,400,49:",],
+   ["line3:Line:::90,200,99,200:",],
+   ["line4:Line:::90,100,99,100:",],
+   ["line5:Line:::615,100,604,100:",],
+   ["line6:Line:::615,151,604,151:",],
+   ["line7:Line:::615,201,604,201:",],
+   ["line8:Line:::300,255,300,264:",],
+   ["line9:Line:::300,40,300,49:",],
+   ["menu line:Line:::0,23,655,23:",],
+   ["parameters:Menu:pull::35,1,78,21:Parameters",parameters_cb,
+      ["scale  @V","offset @F","rate   @R"]],
+   ["pause:Button:regular:1:21,41,56,20:pause",pause_cb],
+   ["strip:Rect:grooved::100,50,504,204:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/profiler.icn b/ipl/gprogs/profiler.icn
new file mode 100644
index 0000000..666a154
--- /dev/null
+++ b/ipl/gprogs/profiler.icn
@@ -0,0 +1,206 @@
+############################################################################
+#
+#	File:     profiler.icn
+#
+#	Subject:  Program to display number magnitudes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays successive numbers by lines of corresponding
+#  height.  When the display area is full, it scrolls from right to
+#  left.
+#
+#  If the -p option is given, data is taken from standard input; this
+#  is useful when input is piped into the program.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: interact, vsetup
+#
+############################################################################
+
+link interact
+link vsetup
+
+global vidgets
+global root
+global strip
+global state
+global reset
+global input
+global scale
+global fnc
+
+global width
+global height
+
+procedure main(args)
+
+   init(args)
+
+   display()
+
+end
+
+procedure init(args)
+
+   vidgets := ui()
+
+   root := vidgets["root"]
+
+   state := &null
+   scale := 1
+   fnc := 1			# linear scaling  :-)
+   if args[1] == "-p" then input := &input
+
+   width :=  vidgets["strip"].uw
+   height :=  vidgets["strip"].uh
+
+   strip := Clone("dx=" || vidgets["strip"].ux, "dy=" || vidgets["strip"].uy)
+   Clip(strip, 0, 0, width, height)
+
+end
+
+procedure display()
+   local n
+
+   repeat {
+      repeat {
+         while (*Pending() > 0) | \state | /input do
+            ProcessEvent(root, , shortcuts)
+         n := read(input) | {
+            Notice("End of data")
+            break
+            }
+         n := integer(fnc(n * scale)) | {
+            Notice("Nonnumeric data; terminating input")
+            break
+            }
+         n >:= height			# Motif bug avoidance
+         EraseArea(strip, width - 1, 0, width - 1, height)
+         DrawLine(strip, width - 1, height - n, width - 1, height)
+         CopyArea(strip, 1, 0, width - 1, height, 0, 0)
+         }
+   input := &null
+   }
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open      @O":  load()
+      "snapshot  @S":  return snapshot(strip)
+      "quit      @Q":  exit()
+      }
+   
+   fail
+
+end
+
+procedure configure_cb(vidget, value)
+
+   case value[1] of {
+      "scale":  {
+         repeat {
+            if TextDialog(, "scale", scale, 10) == "Okay" then {
+               scale := (0 < numeric(dialog_value[1])) | {
+                  Notice("Invalid scale value")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      "function":  {
+         repeat {
+            if TextDialog(,  "function", fnc, 10) == "Okay" then {
+               (proc | numeric)(fnc <-dialog_value[1]) | {
+                  Notice("Invalid function specification")
+                  next
+                  }
+               reset_cb()
+               return
+               }
+            else fail			# user canceled
+            }
+         }
+      }
+
+   fail
+
+end
+procedure pause_cb(vidget, value)
+
+   state := value
+
+   return
+
+end
+
+procedure reset_cb()
+
+   EraseArea(strip)
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {
+         "o":  load()
+         "q":  exit()
+         "s":  return snapshot(strip)
+         }
+   else fail
+
+end
+
+procedure load()
+
+   if load_file() == "Okay" then {
+      input := dialog_value
+      reset_cb()
+      return
+      }
+   else fail
+
+end
+
+  
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=477,255", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,477,255:",],
+   ["configure:Menu:pull::36,0,71,21:Configure",configure_cb,
+      ["scale","function"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open      @O","snapshot  @S","quit      @q"]],
+   ["line1:Line:::0,22,477,22:",],
+   ["pause:Button:regular:1:11,43,42,20:pause",pause_cb],
+   ["reset:Button:regular::11,76,42,20:reset",reset_cb],
+   ["strip:Rect:grooved::63,37,400,200:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/prompt.icn b/ipl/gprogs/prompt.icn
new file mode 100644
index 0000000..4450271
--- /dev/null
+++ b/ipl/gprogs/prompt.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     prompt.icn
+#
+#	Subject:  Program to prompt in a window
+#
+#	Author:   Clinton L. Jeffery
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#    A utility for interactive shell scripts.  Called from a
+# shell script, it pops up a window, writes its arguments out as
+# a prompt, and echos the user's response to standard output where
+# the shell script can use it (by means of the backquote character).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+  local s2, w
+
+  pos := "pos="
+  every s2 := QueryPointer() do pos ||:= (s2-10) || ","
+
+  w := WOpen("label=prompt", "cursor=on", "font="||("12x24"|"fixed"),
+	    "lines=1", pos[1:-1]) | stop("opening the window fails")
+  every writes(w,!args," ")
+  write(read(w))
+end
diff --git a/ipl/gprogs/randweav.icn b/ipl/gprogs/randweav.icn
new file mode 100644
index 0000000..b6f0463
--- /dev/null
+++ b/ipl/gprogs/randweav.icn
@@ -0,0 +1,254 @@
+############################################################################
+#
+#	File:     randweav.icn
+#
+#	Subject:  Program to create random weavable patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 6, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Randweav is an interactive program for generating random
+#	weavable patterns.  The top and left rows of the displayed
+#	pattern are a "key" to the vertical and horizontal threads
+#	of an imaginary loom.  The colors of the other cells are chosen
+#	so that each matches either the vertical or horizontal thread
+#	with which it is aligned.
+#
+#	The interactive controls are as follows:
+#
+#	Colors	Specifies the number of different colors from which
+#		the threads are selected.
+#
+#		If "cycle warp" is checked, the vertical thread colors
+#		repeat regularly.  If "cycle weft" is checked, the
+#		horizontal thread colors repeat regularly.
+#
+#	RENDER	When pressed, generates a new random pattern.
+#		Pressing the Enter key or space bar does the same thing.
+#
+#	Side	Specifies the number of threads along each side
+#		of the pattern.  The pattern is always square.
+#
+#	Bias	Specifies as a percentage the probability that the
+#		vertical thread will determine the color of a pixel.
+#
+#		If "perfect" is checked, vertical and horizontal
+#		threads alternate perfectly, ignoring the bias value.
+#
+#	Save	Brings up a dialog for saving the pattern as an image.
+#
+#	Quit	Exits the program.
+#
+#	Note that the mouse must be over a numeric field to type in
+#	a new value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: random, vsetup 
+#
+############################################################################
+
+link random
+link vsetup
+
+
+global vidgets		# table of vidgets
+global root		# root vidget
+global region		# pattern region
+
+global hidwin		# hidden window for saving to file
+
+global allcolors	# string of all palette colors
+
+global maxsiz		# maximum pattern size
+global patsize		# pattern size selected
+
+$define PALETTE "c1"				# color palette
+$define PREFCOLORS "06NBCDFsHIJM?!"		# preferred colors
+
+
+procedure main(args)
+
+   randomize()
+   allcolors := PREFCOLORS || (PaletteChars(PALETTE) -- PREFCOLORS)
+
+   Window ! put(ui_atts(), args)	# open window
+   vidgets := ui()			# set up vidgets
+   root := vidgets["root"]
+   region := vidgets["region"]
+   VSetState(vidgets["vcyclic"], 1)	# default "cycle warp" on
+   VSetState(vidgets["hcyclic"], 1)	# default "cycle weft" on
+
+   hidwin := WOpen("canvas=hidden",	# open hidden window
+      "width=" || region.uw, "height=" || region.uh)
+
+   maxsiz := region.uw			# set maximum size
+   maxsiz >:= region.uh
+   
+   render()				# draw once without prompting
+   GetEvents(root, , all)		# then wait for events
+end
+
+
+#  all(a, x, y) -- process all events, checking for keyboard shortcuts
+
+procedure all(a, x, y)
+   if a === !" \n\r" then render()	# draw new pattern for SPACE, CR, LF
+   else if &meta then case a of {
+      !"qQ":  exit()			# exit for @Q
+      !"sS":  save()			# save image for @S
+      }
+   return
+end
+
+
+#  render() -- draw a new pattern according to current parameters
+
+procedure render()
+   local ncolors, bias
+   local s, x, y, w, h, z, k
+   static prevsize
+
+   ncolors := txtval("colors", 1, *allcolors)	# retrieve "Colors" setting
+   patsize := txtval("side", 1, maxsiz)		# retrieve "Side" setting
+   bias := txtval("bias", 0, 100)		# retrieve "Bias" setting
+
+   k := (shuffle(PREFCOLORS) | allcolors)[1+:ncolors]	  # pick a color set
+   s := genpatt(patsize, k, bias / 100.0) 		  # generate a pattern
+   DrawImage(hidwin, 0, 0, s)				  # draw on hidden win
+
+   z := maxsiz / patsize				# calculate scaling
+   x := region.ux + (region.uw - z * patsize) / 2
+   y := region.uy + (region.uh - z * patsize) / 2
+
+   #  copy to main window with enlargement
+   if prevsize ~===:= patsize then
+      EraseArea(region.ux, region.uy, region.uw, region.uh)  # erase old pattern
+   Zoom(hidwin, &window, 0, 0, patsize, patsize, x, y, z * patsize, z * patsize)
+
+   return
+end
+
+
+#  genpatt(size, colors, bias) -- generate a new pattern as DrawImage() string
+
+procedure genpatt(size, colors, bias)
+   local warp, weft, perfect, s, x, y, w
+
+   #  choose thread colors
+   warp := genthreads(size, colors, VGetState(vidgets["vcyclic"]))
+   weft := genthreads(size, colors, VGetState(vidgets["hcyclic"]))
+
+   #  initialize output string (including first row)
+   s := size || "," || PALETTE || "," || warp
+
+   perfect := VGetState(vidgets["perfect"])
+
+   #  fill in remaining rows
+   every y := 2 to size do {
+      w := ?weft[y]			# get weft color
+      s ||:= w				# put in first column
+      if \perfect then
+         every x := 2 to size do	# fill the rest (perfect case)
+            s ||:= if ((x + y) % 2) = 0 then w else warp[x]
+      else
+         every x := 2 to size do	# fill the rest (random case)
+            s ||:= if ?0 > bias then w else warp[x]
+      }
+
+   return s
+end
+
+
+#  genthreads(n, colors, cyclic) -- generate a set of warp or weft threads
+
+procedure genthreads(n, colors, cyclic)
+   local s
+
+   if \cyclic then
+      return repl(shuffle(colors), 1 + n / *colors)[1+:n]
+
+   s := ""
+   every 1 to n do s ||:= ?colors
+   return s
+end
+
+
+
+#  txtval(s, min, max) -- get numeric value from named vidget and clamp to range
+
+procedure txtval(s, min, max)
+   local v, n
+
+   v := vidgets[s]			# find the vidget
+   VEvent(v, "\r", v.ax, v.ay)		# set RETURN event to update state
+   n := integer(VGetState(v)) | min	# retrieve int value, else use minimum
+   n <:= min				# limit value by min and max
+   n >:= max
+   VSetState(v, n)			# update vidget with validated value
+   return n				# return value
+end
+
+
+#  save() -- present dialog box and save pattern as image file
+
+procedure save()
+   local g
+
+   g := WAttrib("gamma")	# save old gamma value
+   WAttrib("gamma=1.0")		# don't gamma-correct on write
+   repeat case OpenDialog("Save pattern as:") of {
+      "Cancel": {
+         WAttrib("gamma=" || g)
+         fail
+         }
+      "Okay": {
+         if WriteImage(hidwin, dialog_value, 0, 0, patsize, patsize) then
+            break
+         else
+            Notice("cannot write file:", dialog_value)
+         }
+      }
+   WAttrib("gamma=" || g)	# restore gamma value
+   return
+end
+
+
+procedure quit()
+   exit()
+end
+
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=380,492", "bg=pale gray", "label=weaver"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,380,492:weaver",],
+   ["bias:Text::3:285,37,87,19:Bias:   \\=60",],
+   ["colors:Text::3:10,9,87,19:Colors: \\=6",],
+   ["hcyclic:Button:checkno:1:5,56,97,20:cycle weft",],
+   ["perfect:Button:checkno:1:281,57,76,20:perfect",],
+   ["quit:Button:regular::293,462,78,20:quit   @Q",quit],
+   ["render:Button:regular::159,24,72,36:RENDER",render],
+   ["save:Button:regular::8,462,78,20:save   @S",save],
+   ["side:Text::3:285,8,87,19:Side:   \\=90",],
+   ["vcyclic:Button:checkno:1:5,36,97,17:cycle warp",],
+   ["outline:Rect:sunken::153,18,84,48:",],
+   ["region:Rect:grooved::8,84,364,364:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/randweb.icn b/ipl/gprogs/randweb.icn
new file mode 100644
index 0000000..efc6683
--- /dev/null
+++ b/ipl/gprogs/randweb.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     randweb.icn
+#
+#	Subject:  Program to draw random web design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program connects lines in all possible ways between i randomly
+#  selected points in a window.  The value of i is given on the command
+#  line (default 20).  Large values of i produce unattractively dense
+#  structures.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, joinpair, random, wopen
+#
+############################################################################
+
+link gobject
+link joinpair
+link random
+link wopen
+
+procedure main(argl)
+   local i, j, k, angle, incr, points, size, radius
+
+   i := integer(argl[1]) | 20
+
+   size := 300
+   radius := size / 2
+
+   WOpen("label=random web", "width=" || size, "height=" || size) |
+      stop("*** cannot open window")
+
+   points := []
+
+   randomize()
+
+   every j := 1 to i do
+      put(points, Point(?size, ?size))
+
+   joinpair(points, points)
+
+   Event()
+
+end
diff --git a/ipl/gprogs/recticle.icn b/ipl/gprogs/recticle.icn
new file mode 100644
index 0000000..e71d491
--- /dev/null
+++ b/ipl/gprogs/recticle.icn
@@ -0,0 +1,118 @@
+############################################################################
+#
+#	File:     recticle.icn
+#
+#	Subject:  Program to draw rectangles recursively
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws filled color rectangles recursively.
+#
+#  The options supported are
+#
+#	-w i	width of image; default 400
+#	-h i	height of image; default 250
+#	-p s	palette; default "c3"
+#	-g i	gap between rectangles; default 3
+#	-i	save image file; default no
+#	-n s	default image file prefix; default "recticle"
+#	-m i	minimum length of side; default 10
+#	-b i	bias -- affects size choices; default 20
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  colrlist, options, random, wopen
+#
+############################################################################
+
+link colrlist
+link options
+link random
+link wopen
+
+global bias
+global gap
+global minside
+global palette
+
+procedure main(args)
+   local w, h, opts, name
+
+   opts := options(args, "w+h+p:g+b+m+n:i")
+
+   w := \opts["w"] | 400
+   h := \opts["h"] | 250
+   palette := \opts["p"] | "c3"
+   PaletteChars(palette) | stop("*** invalid palette: ", palette)
+   gap := \opts["g"] | 3
+   bias := \opts["b"] | 20
+   name := \opts["n"] | "recticle"
+   minside := \opts["m"] | 10
+
+   WOpen("width=" || w, "height=" || h, "canvas=hidden") |
+      stop("*** cannot open window")
+
+   randomize()
+
+   rect(gap, gap, w - gap, h - gap)
+
+   if \opts["i"] then WriteImage(name || ".gif")
+
+   WAttrib("canvas=normal")
+
+   WDone()
+
+end
+
+#  rect(x,y,w,h) -- draw rectangle, possibly subdivided, at (x,y)
+
+procedure rect(x, y, w, h)
+   local d
+   static colors
+
+   initial colors := colrplte(palette)
+
+   if d := divide(w < h) then {		# if cut horizontally:
+      rect(x, y, w, d)			#    draw top portion
+      rect(x, y + d, w, h - d)		#    draw bottom portion
+      }
+   else if d := divide(w) then {	# if cut vertically:
+      rect(x, y, d, h)			#    draw left portion
+      rect(x + d, y, w - d, h)		#    draw right portion
+      }
+   else {				# else draw single rect
+      Fg(?colors)	# set random color
+      FillRectangle(x, y, w - gap, h - gap)	# draw
+      }
+
+   return
+
+end
+
+
+#  divide(n) -- find division point along length n
+#
+#  Choose and return a division point at least minside units from
+#  either end.  Fail if the length is too small to subdivide;
+#  also fail randomly, depending partially on the bias setting.
+
+procedure divide(n)
+
+   if (n > 2 * minside) & (?n > bias) then
+      return minside + ?(n - 2 * minside)
+   else
+      fail
+
+end
diff --git a/ipl/gprogs/rectile.icn b/ipl/gprogs/rectile.icn
new file mode 100644
index 0000000..c767ee9
--- /dev/null
+++ b/ipl/gprogs/rectile.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     rectile.icn
+#
+#	Subject:  Program to extract portion of image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 26, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program extracts a fixed rectangle from the images given on the
+#  command line.
+#
+#  The supported options are:
+#
+#	-x i	x coordinate of upper-left corner of rectangle; default 0
+#	-y i	y coordinate of upper-left corner of rectangle; default 0
+#	-w i	width of rectangle; default 64
+#	-h i	height of rectangle; default 64
+#	-p s	prefix for name of saved file; default "rect_"; may be
+#		"", in which case the input file is overridden.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+procedure main(args)
+   local opts, prefix, x, y, w, h, win
+
+   opts := options(args, "x+y+w+h+p:")
+
+   x := \opts["x"] | 0
+   y := \opts["y"] | 0
+   w := \opts["w"] | 64
+   h := \opts["h"] | 64
+   
+   prefix := \opts["p"] | "rect_"
+
+   every name := !args do {
+      win := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+      WriteImage(win, prefix || name, x, y, w, h) |
+         write(&errout, "*** cannot write rectangle for ", name)
+      WClose(win)
+      }
+end
diff --git a/ipl/gprogs/rects.icn b/ipl/gprogs/rects.icn
new file mode 100644
index 0000000..c88b180
--- /dev/null
+++ b/ipl/gprogs/rects.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     rects.icn
+#
+#	Subject:  Program to tile window with colored rectangles
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 3, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      Rects tiles the window with randomly colored nonuniform
+#  rectangles.  Pressing the space bar produces a new tiling.
+#  Pressing "q" exits the program.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, random
+#
+############################################################################
+
+
+
+link graphics
+link random
+
+$define MinSide 10	# minimum size of a rectangle side
+$define Gap 3		# gap between rectangles
+$define Bias 20		# bias setting -- affects size choices
+
+
+
+procedure main(args)
+   local w, h
+
+   Window("bg=white", "width=600", "height=400", args)
+   w := integer(WAttrib("width"))
+   h := integer(WAttrib("height"))
+
+   randomize()
+   rect(Gap, Gap, w - Gap, h - Gap)
+
+   repeat case Event() of {
+      "q":  exit()
+      " ": {
+         EraseArea()
+         rect(Gap, Gap, w - Gap, h - Gap)
+         }
+   }
+
+end
+
+
+
+#  rect(x,y,w,h) -- draw rectangle, possibly subdivided, at (x,y)
+
+procedure rect(x, y, w, h)
+   local d
+   static darkness, hue
+   initial {
+      darkness := ["light", "medium", "dark", "deep"]
+      hue := ["red", "orange", "yellow", "green", "blue", "gray"]
+      }
+
+   if d := divide(w < h) then {		# if cut horizontally:
+      rect(x, y, w, d)			#    draw top portion
+      rect(x, y + d, w, h - d)		#    draw bottom portion
+      }
+   else if d := divide(w) then {	# if cut vertically:
+      rect(x, y, d, h)			#    draw left portion
+      rect(x + d, y, w - d, h)		#    draw right portion
+      }
+   else {				# else draw single rect
+      Fg(?darkness || " strong " || ?hue)	# set random color
+      FillRectangle(x, y, w - Gap, h - Gap)	# draw
+      }
+
+   return
+
+end
+
+
+
+#  divide(n) -- find division point along length n
+#
+#  Choose and return a division point at least MinSide units from
+#  either end.  Fail if the length is too small to subdivide;
+#  also fail randomly, depending partially on the Bias setting.
+
+procedure divide(n)
+
+   if (n > 2 * MinSide) & (?n > Bias) then
+      return MinSide + ?(n - 2 * MinSide)
+   else
+      fail
+
+end
diff --git a/ipl/gprogs/repeater.icn b/ipl/gprogs/repeater.icn
new file mode 100644
index 0000000..707b243
--- /dev/null
+++ b/ipl/gprogs/repeater.icn
@@ -0,0 +1,92 @@
+############################################################################
+#
+#	File:     repeater.icn
+#
+#	Subject:  Program to repeat image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program repeats images a specified number of times.  The image
+#  names are given on the command line.
+#
+#  The supported options are:
+#
+#	-h i	repeat horizontally i times, default 1.
+#	-v i	repeat vertically i times, default 1.
+#	-a i	repeat i times perpendicular to smallest dimension;
+#		default 10; and 1 time perpendicular to the largest dimension;
+#		overrides -h and 0v.
+#	-l i	limit size in repeat direction to i; default 256; only applies
+#		if -a is in force.
+#	-p s	prefix to prepend to image name, default "rep_".  Can
+#		be empty string, in which case the input image is
+#		overwritten.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, tile, wopen
+#
+############################################################################
+
+link options
+link tile
+link wopen
+
+procedure main(args)
+   local opts, prefix, h_rep, v_rep, win1, win2, name, width, height
+   local auto, wdim, hdim, limit
+
+   opts := options(args, "h+v+a+l+p:")
+
+   h_rep := \opts["h"] | 1
+   v_rep := \opts["v"] | 1
+   prefix := \opts["p"] | "rep_"
+   auto := \opts["a"]
+   limit := \opts["l"] | 256
+
+   every name := !args do {
+      win1 := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+      width := WAttrib(win1, "width")
+      height := WAttrib(win1, "height")
+      if \auto then {
+         if width > height then {
+            hdim := height * auto
+            hdim >:= limit
+            wdim := width
+            }
+         else {
+            hdim := height
+            wdim := width * auto
+            wdim >:= limit
+            }
+         }
+      else {
+         hdim := height * h_rep
+         wdim := width * v_rep
+         } 
+      win2 := WOpen("canvas=hidden", "width=" || wdim, "height=" || hdim) | {
+         write(&errout, "*** cannot open window for repeat")
+         WClose(win1)
+         next
+         }
+      tile(win1, win2)
+      WriteImage(win2, prefix || name)
+      WClose(win1)
+      WClose(win2)
+      }
+end
diff --git a/ipl/gprogs/rings.icn b/ipl/gprogs/rings.icn
new file mode 100644
index 0000000..61739b5
--- /dev/null
+++ b/ipl/gprogs/rings.icn
@@ -0,0 +1,108 @@
+############################################################################
+#
+#	File:     rings.icn
+#
+#	Subject:  Program to draw tiles of rings and circles
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 13, 1994
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces seamless tiles with drawings of circles and
+#  rings.
+#
+#  It words from characters input to the window:
+#
+#	q	quit
+#	c	draw 10 random circles
+#	r	draw 5 random rings
+#	W	writes image to GIF file; files are named ring000.gif,
+#		   ring001.gif, ...
+#	E	erases the window
+#	F       fills the window
+#	R	reverses the colors
+#
+#  At present there are no options except those provided for
+#  opening the window.
+#
+#  Some modifications have been made by Ralph E. Griswold
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  xio, xutils
+#
+############################################################################
+
+$define W 128
+$define H 128
+
+link xio, xutils
+
+procedure main(args)
+   local count
+
+   count := -1
+   Window(args)
+   repeat case Event() of {
+      QuitEvents():  exit()
+      "c":  randrop(circle, 10)
+      "r":  randrop(ring, 5)
+      "W":  WriteImage("rings" || right(count +:= 1, 3, "0") || ".gif",
+         , , W, W)
+      "E":  EraseArea()
+      "F":  FillRectangle()
+      "R":  {WAttrib("drawop=reverse"); FillRectangle(); WAttrib("drawop=copy")}
+      }
+end
+
+procedure replicate()
+   CopyArea(0, 0, W, H, 0, H)
+   CopyArea(0, 0, W, 2 * H, W, 0)
+   CopyArea(0, 0, 2 * W, 2 * H, 2 * W, 0)
+   CopyArea(0, 0, 4 * W, 2 * H, 0, 2 * H)
+   DrawLine(W, 0, W, H, 0, H)
+   return
+end
+
+procedure randrop(p, n)
+   local x, y
+   every 1 to n do {
+      x := ?W - W / 2
+      y := ?H - H / 2
+      p(x, y)
+      p(x, y + H)
+      p(x + W, y)
+      p(x + W, y + W)
+      }
+   replicate()
+   return
+end
+
+procedure ring(x, y)
+   static outer, inner
+   initial {
+      outer := Clone("fg=black", "linewidth=5")
+      inner := Clone("fg=white", "linewidth=3")
+      }
+   DrawCircle(outer, x, y, 30)
+   DrawCircle(inner, x, y, 30)
+   return
+end
+
+procedure circle(x, y)
+   static white
+   initial white := Clone("fg=white")
+   FillCircle(white, x, y, 12)
+   DrawCircle(x, y, 12)				#  change to 10 for gaps
+   return
+end
diff --git a/ipl/gprogs/rolypoly.icn b/ipl/gprogs/rolypoly.icn
new file mode 100644
index 0000000..2c2011f
--- /dev/null
+++ b/ipl/gprogs/rolypoly.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     rolypoly.icn
+#
+#	Subject:  Program to draw ``abstract'' art
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 28, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program makes a simple random abstract sketch.  It supports these
+#  options:
+#
+#	-p i	number of points (default 10)
+#	-s i	size of (square) window (default 300)
+#	-r	randomize seed
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  random, options, gobject, randfigs, wopen
+#
+############################################################################
+
+link random
+link options
+link gobject
+link randfigs
+link wopen
+
+procedure main(argl)
+   local opts, n, size, points, p
+
+   opts := options(argl, "p+s+r")
+
+   n := \opts["p"] | 10
+   size := \opts["s"] | 300
+   if \opts["r"] then randomize()
+
+   WOpen("label=rolypoly", "size=" || size || "," || size) |
+      stop("*** cannot open window")
+   
+   points := []			# list of x,y coordinates
+
+   every p := random_points(size, size) \ n do
+      every put(points, \!p)	# z coordinate is null
+
+				# here's the fun
+   every (FillPolygon | DrawCurve) ! points
+
+   Event()			# hold window open for an event
+
+end
diff --git a/ipl/gprogs/rows2blp.icn b/ipl/gprogs/rows2blp.icn
new file mode 100644
index 0000000..8dbe922
--- /dev/null
+++ b/ipl/gprogs/rows2blp.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     rows2blp.icn
+#
+#	Subject:  Program to convert row file to bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 30, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure main()
+   local rows
+
+   rows := []
+
+   while put(rows, read())
+
+   write(rows2pat(rows))
+
+end
diff --git a/ipl/gprogs/rows2isd.icn b/ipl/gprogs/rows2isd.icn
new file mode 100644
index 0000000..4d1b3fb
--- /dev/null
+++ b/ipl/gprogs/rows2isd.icn
@@ -0,0 +1,106 @@
+############################################################################
+#
+#	File:     rows2isd.icn
+#
+#	Subject:  Program to produce a ISD from bi-level pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 16, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes a row file or BLP from standard input
+#  and writes an ISD for a draft to standard output.
+#
+############################################################################
+#
+#  Links:  weavutil, xcode, patutils, patxform
+#
+############################################################################
+
+link patutils
+link patxform
+link weavutil
+link xcode
+
+procedure main(args)
+   local rows, cols, treadling, threading, count, tieup, y, width, height
+   local shafts, treadles, i, tie_line, row, treadle, draft, p, line
+
+   line := read() | stop("empty file")
+
+   if upto("#", line) then rows := pat2rows(line)
+   else {
+      rows := [line]
+      while put(rows, read())	# read in row pattern
+      }
+
+   cols := protate(rows)	# rotate to get columns
+
+   treadles := examine(rows)	# get treadles
+   shafts := examine(cols)	# get shafts
+
+   treadling := []		# construct treadling sequence
+   every put(treadling, treadles[!rows])
+
+   threading := []		# construct threading sequence
+   every put(threading, shafts[!cols])
+
+   tieup := []
+
+   every row := key(treadles) do {		# get unique rows
+      treadle := treadles[row]			# assigned treadle number
+      tie_line := repl("0", *shafts)		# blank tie-up line
+      every i := 1 to *row do			# go through row
+         if row[i] == "1" then			#    if warp on top
+            tie_line[threading[i]] := "1"	#       mark shaft position
+      put(tieup, tie_line)			# add line to tie-up
+      }
+
+   draft := isd("rows2isd")
+
+   draft.threading := threading
+   draft.treadling := treadling
+   draft.shafts := *shafts
+   draft.treadles := *treadles
+   draft.width := *shafts
+   draft.height := *treadles
+   draft.tieup := tieup
+   draft.color_list := ["black", "white"]
+   draft.warp_colors := list(*threading, 1)
+   draft.weft_colors := list(*treadling, 2)
+
+   write(xencode(draft))
+
+end
+
+procedure tromp(treadle)
+   local result
+
+   result := ""
+   
+   treadle ? {
+      every result ||:= upto("1") || ","
+      }
+
+   return result[1:-1]
+
+end
+
+procedure examine(array)
+   local count, lines, line
+
+   lines := table()			# table to be keyed by line patterns
+   count := 0
+
+   every line := !array do		# process lines
+      /lines[line] := (count +:= 1)	# if new line, insert with new number
+
+   return lines
+
+end
diff --git a/ipl/gprogs/rstarlab.icn b/ipl/gprogs/rstarlab.icn
new file mode 100644
index 0000000..c27b7bf
--- /dev/null
+++ b/ipl/gprogs/rstarlab.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     rstarlab.icn
+#
+#	Subject:  Program to draw regular stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws regular stars.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 5-7.
+#	
+#  The window is square.  The window size can be given on the command line,
+#  default 600.
+#
+#  The present user interface is crude.  To see all the regular stars
+#  that are provided by default, type
+#
+#	all
+#
+#  from standard input.  After each star is drawn, the program waits
+#  for an event before going on to the next star.
+#
+#  Alternatively, a single star can be drawn by typing its name preceded
+#  by an equals sign.  The names are rstar01 through rstar06.  For example,
+#
+#	=rstar02
+#
+#  draws the second star.
+#
+#  In future extensions, provision will be made for user-defined stars.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  drawlab, rstars, rstartbl
+#
+############################################################################
+
+link drawlab
+link rstars
+link rstartbl
+
+global size
+
+procedure main(argl)
+
+   size := integer(argl[1]) | 600
+
+   drawlab(rstar, rstartbl, "regular stars")
+
+end
diff --git a/ipl/gprogs/scroll.icn b/ipl/gprogs/scroll.icn
new file mode 100644
index 0000000..968160a
--- /dev/null
+++ b/ipl/gprogs/scroll.icn
@@ -0,0 +1,105 @@
+############################################################################
+#
+#       File:	  scroll.icn
+#
+#       Subject:  Program to scroll image
+#
+#	Author:   Jon Lipp
+#
+#	Date:     November 22, 1996
+#
+##########################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays an image, with scolling.
+#
+##########################################################################
+#
+#  Links:  options, vidgets, vscroll, wopen, xcompat
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link options
+link vidgets, vscroll
+link wopen
+link xcompat
+
+global win, im_win, view_width, view_height
+global scv, sch
+
+procedure main(args)
+   local opts, file, scrollbar_width, picw, pich, root
+
+   opts := options(args, "f:w+h+")
+   file := \opts["f"] | 
+      stop("Usage: scroll -f file [-w window size/width] [-h window height]")
+   view_width := \opts["w"] | 300
+   view_height := \opts["h"] | view_width
+   scrollbar_width := 15
+#
+#  Load in the bitmap; get the dimensions.
+#
+   im_win := WOpen("canvas=hidden", "image=" || file) |
+      stop("Couldn't make temporary bitmap.")
+   picw := WAttrib(im_win, "width")
+   pich := WAttrib(im_win, "height")
+
+   win := WOpen("label=" || file, "size=" ||
+      (view_width + scrollbar_width + 1) || "," ||
+      (view_height + scrollbar_width + 1) ) |
+         stop("*** cannot open file")
+
+   root := Vroot_frame(win)
+#
+#  Create two scrollbars.
+#
+   scv := Vvert_scrollbar(root, -1, 0, win, sl_cb, 1,
+      view_height,scrollbar_width, pich, 0, , view_height)
+   sch := Vhoriz_scrollbar(root, 0, -1, win, sl_cb, 2, view_width,
+     scrollbar_width, 0, picw, , view_width)
+
+   VResize(root)
+#
+#  Draw the initial view of the pixmap, based on the scrollbar's values.
+#
+   sl_cb(scv, scv.callback.value)
+   sl_cb(sch, sch.callback.value)
+# 
+#  Now get events, pass control to the procedure quit() if an event is not
+#  captured by a vidget.
+#
+   GetEvents(root, quit, , resize)
+end
+
+#
+#  Terminate the program on a keypress of "q".
+#
+procedure quit(e)
+
+   if e === "q" then stop("End scroll.")
+end
+
+procedure resize(root)
+
+   VReformat(scv, WAttrib(scv.win, "height") - 15)
+   VReformat(sch, WAttrib(sch.win, "width") - 15)
+end
+   
+#
+#  Copy a portion of the bitmap to the main
+#  window based on the values of the scrollbars.
+#  
+procedure sl_cb(caller, val)
+   static vpos, hpos
+   initial vpos := hpos := 0
+
+   (caller.id = 1, vpos := val) | hpos := val
+   CopyArea(im_win, win, hpos, vpos, view_width, view_height, 0, 0)
+end
diff --git a/ipl/gprogs/scroller.icn b/ipl/gprogs/scroller.icn
new file mode 100644
index 0000000..53ed308
--- /dev/null
+++ b/ipl/gprogs/scroller.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     scroller.icn
+#
+#	Subject:  Program to scroll image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 4, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(args)
+   local width, height, win1, win2
+
+   win1 := WOpen("image=" || args[1]) | stop("*** cannot open image")
+
+   height := WAttrib(win1, "height")
+   width := WAttrib(win1, "width")
+
+   win2 := WOpen("canvas=hidden", "size=1," || height)
+
+   repeat {
+      CopyArea(win1, win2, 0, 0, 1, height)
+      CopyArea(win1, win1, 1, 0, width - 1, height)
+      CopyArea(win2, win1, 0, 0, 1, height, width - 1, 0)
+      WDelay(10)
+      }
+
+end
diff --git a/ipl/gprogs/seamcut.icn b/ipl/gprogs/seamcut.icn
new file mode 100644
index 0000000..f75e6c4
--- /dev/null
+++ b/ipl/gprogs/seamcut.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     seamcut.icn
+#
+#	Subject:  Program to cut image for seamless tiling
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes image file names and does top/bottom separation and
+#  reordering, follows by the same for left and right.  The result is an
+#  image that tiles seamlessly, although the center part may be a mess.
+#
+#  The technique is described in Painter 2.0 Companion.
+#
+#  Files are expected to have the suffix .gif.  The corresponding files
+#  are given the suffix _s.gif.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wopen
+#
+############################################################################
+
+link basename
+link wopen
+
+procedure main(args)
+   local name, base, width, height, half_width, half_height, win1, win2
+
+   every name := !args do {
+      base := basename(name, ".gif") | {
+         write(&errout, "*** unexpected file extension ", name)
+         next
+         }
+      win1 := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+
+      width := WAttrib(win1, "width")
+      height := WAttrib(win1, "height")
+      half_width := width / 2
+      half_height := height / 2
+
+      win2 := WOpen("canvas=hidden", "width=" || width, "height=" || height) |
+         stop("*** cannot open target window")
+
+      CopyArea(win1, win2, 0, 0, half_width, height, half_width, 0)
+      CopyArea(win1, win2, half_width, 0, half_width, height, 0, 0)
+      EraseArea(win1)
+      CopyArea(win2, win1, 0, 0, width, half_height, 0, half_height)
+      CopyArea(win2, win1, 0, half_height, width, half_height, 0, 0)
+      WriteImage(win1, base || "_s.gif")
+      WClose(win1)
+      WClose(win2)
+      }
+
+end
diff --git a/ipl/gprogs/selectle.icn b/ipl/gprogs/selectle.icn
new file mode 100644
index 0000000..594c393
--- /dev/null
+++ b/ipl/gprogs/selectle.icn
@@ -0,0 +1,571 @@
+############################################################################
+#
+#	File:     selectle.icn
+#
+#	Subject:  Program to select tile from an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in locating areas within an image
+#  that, when tiled, produce a desired effect.  For example, a background
+#  may consist of a tiled image; this program can be used to find the
+#  smallest tile for the repeat (by "eye-balling").
+#
+#  Another interesting use of this program is to produce striped patterns by
+#  selecting a row or column of an image to get a tile that is one character
+#  wide.  Sometimes a few rows or columns give an interesting "fabric"
+#  effect.
+#
+#  The following features are provided through keyboard shortcuts,
+#  the File menu, and in some cases, on-board buttons:
+#
+#	@D	user-drawn selection rectangle
+#	@O	open new source image
+#	@P	pick a source image from GIF files in the current directory
+#	@Q	quit application
+#	@S	save current selection as an image
+#	@T	tile selection into source image window
+#
+#  Buttons provide for setting and adjusting the selection in various
+#  ways.
+#
+#  In the drawing mode, the mouse can be used to make a selection by
+#  dragging from one corner to another.  When the mouse is released,
+#  the action depends on the user keypress:
+#
+#	"r"	return the selection
+#	"n"	try again
+#	"q"	exit drawing mode
+#
+#  Typing "q" is the only way to get out of the drawing mode.  It can be
+#  done whether or not there is a selection.
+#
+#  Notes:
+#
+#	The selection starts as a single pixel in the upper-left corner.
+#	The repeat window can be resized by the user.
+#
+############################################################################
+#
+#  Features to add/improve:
+#
+#	show current selection
+#	file-system navigation
+#	chained selection dialogs for large numbers of files
+#	  *or* scrolling line dialog
+#	add flips, rotations, and other transformations (using external
+#	  utilities)
+#	allow images of types other than GIF
+#	
+#  Bugs:
+#	width and height setting should take into account the current
+#         origin
+#	edit in system menu is bogus (bug is in interact.icn)
+#
+#	
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX (for "pick" feature)
+#
+############################################################################
+#
+#  Links:   grecords, interact, io, select, tile
+#
+############################################################################
+
+link grecords
+link interact
+link io
+link select
+link tile
+
+#  To do:  alphabetize the following globals
+
+global pattern		# repeat window
+global source		# source window hidden
+global screen		# source window visible
+global vidgets		# table of interface vidgets
+global root		# root vidget
+global controls
+
+global text		# label with respect to which information is written
+
+global posx		# x position relative to interface window
+global posy		# y position relative to repeat window
+global wmax		# maximum width of source image
+global hmax		# maximum height of source image
+
+global auto		# auto-save toggle
+global prefix		# auto-save prefix
+global count		# auto-save count
+global name		# image name
+global draw		# draw vidget
+global current		# current selection
+
+$define PosX	"posx=10"
+$define PosY	"posy=10"
+
+procedure main()
+   local atts
+
+   atts := ui_atts()
+
+   #  The interface window is opened with a hidden canvas so that it
+   #  can be made the active window later by making it visible.
+
+   put(atts, "canvas=hidden", PosX, PosY)
+
+   controls := (WOpen ! atts) | stop("*** cannot open window")
+   vidgets := ui()
+
+   init()
+
+   GetEvents(root, , shortcuts)
+
+end
+
+#  Auto-save callback toggle.
+
+procedure auto_cb(vidget, value)
+
+  auto := value
+
+  if \auto then {
+      if OpenDialog("Specify prefix for auto-saving:") == "Cancel" then fail
+      prefix := dialog_value
+      count := -1		# initial count less 1
+      }
+
+  return
+
+end
+
+#  Callback that handles all the buttons that change x, y, w, and h.
+
+procedure change_cb(vidget)
+
+   # Cute code alert.  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   check(
+      case vidget.s of {
+         "h +":       current.h <- current.h + 1
+         "h -":       current.h <- current.h - 1
+         "w +":       current.w <- current.w + 1
+         "w -":       current.w <- current.w - 1
+         "w + h +":   current.h <- current.h + 1 & current.w <- current.w + 1
+         "w - h -":   current.h <- current.h - 1 & current.w <- current.w - 1
+         "h max":     current.h <- hmax
+         "w max":     current.w <- wmax
+         "w h max":   current.h <- hmax & current.w <- wmax
+         "x +":       current.x <- current.x + 1
+         "x -":       current.x <- current.x - 1
+         "y +":       current.y <- current.y + 1
+         "y -":       current.y <- current.y - 1
+         "x + y +":   current.x <- current.x + 1 & current.y <- current.y + 1
+         "y - x -":   current.y <- current.y - 1 & current.x <- current.x - 1
+         "x 1/2":     current.x <- wmax / 2
+         "y 1/2":     current.y <- hmax / 2
+         "x y 1/2":   current.x <- wmax / 2 & current.y <- hmax / 2
+         }
+     ) | fail
+
+   show()
+
+   return
+
+end
+
+#  Check validity of selection.
+
+procedure check()
+
+   if (0 <= current.h <= hmax) &
+      (0 <= current.w <= wmax) &
+      (0 <= current.x <= hmax) &
+      (0 <= current.y <= wmax)
+   then return else {
+      Alert()
+      fail
+      }
+
+end
+
+#  Copy hidden source window to a visible window.
+
+$define Margin 20
+
+procedure copy_source(label)
+
+   screen := WOpen("size=" || WAttrib(source, "width") || "," ||
+      WAttrib(source, "height"), "posx=" || posx, "posy=" || posy,
+        "label=" || label) | ExitNotice("Cannot open image window")
+
+   CopyArea(source, screen)
+
+   expose(controls)
+
+   wmax := WAttrib(source, "width")
+   hmax := WAttrib(source, "height")
+
+   WAttrib(pattern, "width=" || (WAttrib(screen, "width") + Margin))
+   WAttrib(pattern, "height=" || (WAttrib(screen, "height") + Margin))
+
+   reset_cb()
+
+   return
+
+end
+
+#  Enable user-drawn selection.
+
+procedure draw_cb(vidget, value)
+   local sel
+
+   if /value then return
+
+   if /source then {
+      Notice("No source image.")
+      SetVidget(draw, &null)
+      fail
+      }
+
+   expose(screen)
+
+   while current := select(screen) do
+      show()
+
+   SetVidget(draw, &null)
+
+   expose(controls)
+
+   return
+
+end
+
+#  File menu callback.
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O":  get_image()
+      "pick  @P":  pick()
+      "quit  @Q":  exit()
+      "save  @S":  snap()
+      "tile  @T":  tile_selection()
+      }
+
+   return
+
+end
+
+#  Utility procedure to get new source image.
+
+procedure get_image()
+
+   WClose(\source)
+   WClose(\screen)
+
+   repeat {
+      (OpenDialog("Open image:") == "Okay") | fail
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Can't open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      wmax := WAttrib(source, "width")
+      hmax := WAttrib(source, "height")
+      break
+      }
+
+   return
+
+end
+
+#  These values are for Motif; they may need to be changed for other
+#  window managers.
+
+$define Offset1	32
+$define Offset2	82
+
+#  Initialize the program
+
+$define MinSize 600
+
+procedure init()
+   local iheight
+
+   current := rect(0, 0, 1, 1)
+   hmax := wmax := 0
+
+   posx := WAttrib("width") + Offset1
+
+   iheight := WAttrib("height")
+
+   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
+      "," || iheight, "posx=" || posx, PosY) |
+         stop("*** cannot open window for repeat ***")
+
+   posy := WAttrib(pattern, "height") + Offset2
+
+   root := vidgets["root"]
+   text := vidgets["text"]
+   draw := vidgets["draw"]
+
+   WAttrib("canvas=normal")
+
+   auto := &null
+
+   return
+
+end
+
+#  Utility procedure to let user pick an image file in the current directory.
+
+procedure pick()
+   local plist, ls
+
+   plist := filelist("*.gif *.GIF") |
+      return FailNotice("Pick not supported on this platform")
+
+   if *plist = 0 then return FailNotice("No files found.")
+
+   repeat {
+      if SelectDialog("Select image file:", plist, plist[1]) == "Cancel"
+         then fail
+      WClose(\source)
+      WClose(\screen)
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      break
+      }
+
+   return
+   
+end
+   
+#  Callback to terminate program execution.
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+#  Callback to reset x, y, w, and h to initial values.
+
+procedure reset_cb()
+
+   current := rect(0, 0, 1, 1)
+
+   show()
+
+   return
+
+end
+
+#  Callback procedure to save the current selection as an image file.
+
+procedure save_cb()
+
+   snap()
+
+end
+
+#  Callback procedure to allow use of standard tile sizes.
+
+procedure select_cb(vidget, value)
+
+   check(current.w := current.h := case value of {
+      "     4 x 4":    4
+      "     8 x 8":    8
+      "   16 x 16":   16
+      "   32 x 32":   32
+      "   64 x 64":   64
+      "   72 x 72":   72
+      "   96 x 96":   96
+      " 100 x 100":  100
+      " 128 x 128":  128
+      " 256 x 256":  256
+      " 400 x 400":  400
+      " 512 x 512":  512
+      }) | fail
+
+   show()
+
+   return
+
+end
+
+#  Callback to allow setting of specific selection rectangle values.
+
+procedure set_cb()
+
+   repeat {
+      if TextDialog("Set values:",
+         ["x", "y", "w", "h"],
+         [  current.x,
+            current.y,
+            current.w,
+            current.h
+            ]
+         ) == "Cancel" then fail
+      check(
+         current.x <- integer(dialog_value[1]) &
+         current.y <- integer(dialog_value[2]) &
+         current.w <- integer(dialog_value[3]) &
+         current.h <- integer(dialog_value[4])
+         ) | {
+            Notice("Invalid value")
+            next
+            }
+      show()
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   if &meta then
+      case map(e) of {			# fold case
+         "d":   SetVidget(draw, 1)
+         "o":   get_image()
+         "p":   pick()
+         "q":	exit()
+         "s":	snap()
+         "t":   tile_selection()
+         }
+
+   return
+
+end
+
+#  Procedure to handle all that goes with a new selection.
+
+#  These constants are ad hoc.
+
+$define Width	200
+$define Height	 30
+$define YOff	 10
+
+procedure show()
+   static sx, sy
+
+   initial {
+      sx := text.ax
+      sy := text.ay
+      }
+
+   if /source then return FailNotice("No source image.")
+
+   tile(source, pattern, current.x, current.y, current.w, current.h)
+
+   if \auto then {
+      name := prefix || right(count +:= 1, 3, "0") || ".gif"
+      WriteImage(source, name, current.x, current.y, current.w, current.h)
+      }
+
+   EraseArea(sx, sy, Width, Height) 
+
+   DrawString(sx, sy + YOff, "x=" || current.x  || " y=" || current.y ||
+      " w=" || current.w || " h=" || current.h)
+
+   if \auto then DrawString(sx, sy + 30, "last auto-save: " || name)
+
+   return
+
+end
+
+#  Utility procedure to save current selection.
+
+procedure snap()
+
+   return snapshot(\source, current.x, current.y, current.w, current.h) |
+     FailNotice("No source image.")
+
+end
+
+#  Callback for System menu.
+
+procedure system_cb(vidget, value)
+
+   case value[1] of {
+      "edit":     edit_file()
+      "execute":  execute()
+      }
+
+   return
+
+end
+
+procedure tile_selection()
+
+   tile(pattern, screen, current.x, current.y, current.w, current.h)
+   CopyArea(screen, source)
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=397,360", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,397,360:",],
+   ["auto save:Button:regular:1:12,74,70,20:auto save",auto_cb],
+   ["draw:Button:regular:1:20,172,50,20:draw",draw_cb],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","pick  @P","save  @S    ","tile  @T","quit  @Q"]],
+   ["hmax:Button:regular::205,54,56,20:h max",change_cb],
+   ["hminus:Button:regular::169,106,35,20:h -",change_cb],
+   ["hplus:Button:regular::168,80,35,20:h +",change_cb],
+   ["line1:Line:::0,25,400,25:",],
+   ["quit:Button:regular::19,311,50,20:quit",quit_cb],
+   ["reset_cb:Button:regular::20,116,50,20:reset",reset_cb],
+   ["save:Button:regular::19,40,50,20:save",save_cb],
+   ["select:Choice::12:285,29,99,252:",select_cb,
+      ["     4 x 4","     8 x 8","   16 x 16","   32 x 32","   64 x 64",
+      "   72 x 72","   96 x 96"," 100 x 100"," 128 x 128"," 256 x 256",
+      " 400 x 400"," 512 x 512"]],
+   ["set:Button:regular::20,143,50,20:set",set_cb],
+   ["system:Menu:pull::37,1,50,21:System",system_cb,
+      ["edit","execute"]],
+   ["text:Button:regularno::112,290,154,20:current specification",],
+   ["whmax:Button:regular::206,80,56,20:w h max",change_cb],
+   ["whminus:Button:regular::108,54,56,20:w - h -",change_cb],
+   ["whplus:Button:regular::108,30,56,20:w + h +",change_cb],
+   ["wmax:Button:regular::206,29,56,20:w max",change_cb],
+   ["wminus:Button:regular::168,54,35,20:w -",change_cb],
+   ["wplus:Button:regular::168,29,35,20:w +",change_cb],
+   ["xhalf:Button:regular::213,153,56,20:x 1/2",change_cb],
+   ["xminus:Button:regular::173,180,35,20:x -",change_cb],
+   ["xplus:Button:regular::172,153,35,20:x +",change_cb],
+   ["xyhalf:Button:regular::212,206,56,20:x y 1/2",change_cb],
+   ["xyminus:Button:regular::109,181,56,20:x - y +",change_cb],
+   ["xyplus:Button:regular::110,151,56,20:x + y +",change_cb],
+   ["y minus:Button:regular::172,231,35,20:y -",change_cb],
+   ["y plus:Button:regular::173,206,35,20:y +",change_cb],
+   ["yhalf:Button:regular::212,177,56,20:y 1/2",change_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/sensdemo.icn b/ipl/gprogs/sensdemo.icn
new file mode 100644
index 0000000..c9ade64
--- /dev/null
+++ b/ipl/gprogs/sensdemo.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     sensdemo.icn
+#
+#	Subject:  Program to demonstrate sensor routines
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 12, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     sensdemo illustrates several of the input sensors provided in the
+#  program library.  It is written to use mutable colors but will struggle
+#  along slowly if they're not available.
+#
+#     There are four pushbuttons.  Buttons "One", "Two", and "Three" just
+#  write a line on standard output.  The "QUIT" button does what you'd
+#  expect.
+#
+#     The three vertically oriented sliders control (from left to right)
+#  alter the red, green, and blue components of the color in the large
+#  square.  The individual components appear in the small squares, and
+#  the hexadecimal form of the color spec is displayed below the square.
+#
+#     The small horizontal slider below the square adjusts all three
+#  color components simultaneously.  Notice how moving it also moves
+#  the three vertical sliders.
+#
+#     The largs square sounds a bell if Return is pressed while it
+#  contains the cursor.  The standard "quitsensor" causes the program
+#  to exit when q or Q is pressed anywhere in the window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, slider, evmux, graphics
+#
+############################################################################
+
+link button
+link slider
+link evmux
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+record rgbrec(r, g, b, k)
+record boxrec(x, y, w, h, b, i)
+global val, colr, sl, win
+
+procedure main(args)
+   local cwin, h, m, c
+
+   # open window
+   win := Window("size=400,400", args)
+   m := WindowMargin
+   h := WAttrib("height") - 2 * m			# usable height
+
+   # set up boxes for displaying colors, each with its own binding
+   colr := rgbrec(
+      boxrec(m, m, 40, 40),
+      boxrec(m, m + 55, 40, 40),
+      boxrec(m, m + 110, 40, 40),
+      boxrec(m + 65, m, 150, 150))
+   every c := !colr do {
+      c.b := Clone(win)
+      Bg(c.b, c.i := NewColor(win))			# fails if b/w screen
+      BevelRectangle(win, c.x, c.y, c.w, c.h, -BevelWidth)
+      EraseArea(c.b,
+         c.x+BevelWidth, c.y+BevelWidth, c.w-2*BevelWidth, c.h-2*BevelWidth)
+      }
+
+   # set up sliders to control the colors
+   val := rgbrec(0.1, 0.8, 1.0, 0.8)			# initial positions
+   sl := rgbrec()
+   sl.r := slider(win, setrgb, 1, 290, m, 20, h, 0.0, val.r, 1.0)
+   sl.g := slider(win, setrgb, 2, 330, m, 20, h, 0.0, val.g, 1.0)
+   sl.b := slider(win, setrgb, 3, 370, m, 20, h, 0.0, val.b, 1.0)
+   sl.k := slider(win, setgray, 4, m+65, m+160, 150, 14, 0.0, 0.8, 1.0)
+   setcolors()						# download the colors
+
+   # set up miscellaneous sensors
+   quitsensor(win)					# quit on q or Q
+   sensor(win, '\r', ding, &null, m+65, m, 150, 150)	# \r in box sounds bell
+   buttonrow(win, 150, 250, 100, 20, 0, 30,		# vertical button row
+      "One", bpress, "one",
+      "Two", bpress, "two",
+      "Three", bpress, "three",
+      )
+   button(win, "QUIT", argless, exit, m, m+h-60, 60, 60)  # and a QUIT button
+
+   # enter event loop
+   evmux(win)
+end
+
+procedure bpress(win, a)		# echo a button press
+   write("button ", a)
+   return
+end
+
+procedure ding(win, a, x, y, k)		# ring the bell
+   writes("\^g")
+   flush(&output)
+   return
+end
+
+procedure setcolors()			# set the colors in the color map
+   colorbox(colr.r, 65535 * val.r, 0, 0)
+   colorbox(colr.g, 0, 65535 * val.g, 0)
+   colorbox(colr.b, 0, 0, 65535 * val.b)
+   colorbox(colr.k, 65535 * val.r, 65535 * val.g, 65535 * val.b)
+   GotoXY(win, 100, 200)
+   write(win, "color = #", hexv(val.r), hexv(val.g), hexv(val.b))
+   return
+end
+
+procedure colorbox(box, r, g, b)
+   r := integer(r)
+   g := integer(g)
+   b := integer(b)
+   if \box.i then
+      Color(box.b, box.i, r || "," || g || "," || b)
+   else {
+      Shade(box.b, r || "," || g || "," || b)
+      FillRectangle(box.b, box.x+1, box.y+1, box.w-1, box.h-1)
+      }
+   return
+end
+
+procedure hexv(v)			# two-hex-digit specification of v
+   static hextab
+   initial {
+      every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
+      }
+   return hextab [integer(255 * v + 1.5)]
+end
+
+procedure setgray(win, i, v)		# set a grayvalue of v
+   every i := 1 to 3 do
+      slidervalue(sl[i], val[i] := v)
+   setcolors()
+   return
+end
+
+procedure setrgb(win, i, v)		# set color component i to value v
+   val[i] := v
+   setcolors()
+end
diff --git a/ipl/gprogs/showcolr.icn b/ipl/gprogs/showcolr.icn
new file mode 100644
index 0000000..d41e6e2
--- /dev/null
+++ b/ipl/gprogs/showcolr.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     showcolr.icn
+#
+#	Subject:  Program to list colors in Icon palettes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program produces files of color specifications for all of Icon's
+#  built-in palettes.  The output is written to a file whose base name is
+#  the palette and whose suffix is ".clr".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure main()
+   local palette, output
+
+   every palette := ("c" || (1 to 6)) | ("g" || (2 to 256)) do {
+      output := open(palette || ".clr", "w") |
+         stop("*** cannot open output file for palette ", palette)
+      every write(output, PaletteColor(palette, !PaletteChars(palette)))
+      close(output)
+      }
+
+end
diff --git a/ipl/gprogs/showtile.icn b/ipl/gprogs/showtile.icn
new file mode 100644
index 0000000..339a6d1
--- /dev/null
+++ b/ipl/gprogs/showtile.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     showtile.icn
+#
+#	Subject:  Program to display tiles
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays pattern tiles given in standard input.
+#
+#  The options are:
+#
+#	-P	show pattern produced by tile; default show tile
+#	-i s	create image files with prefix s
+#	-a	run without waiting for event in window
+#	-u	don't show on-screen images; implies -a
+#	-p i	start with page i
+#	-r i	number of rows, default 7 for -P, otherwise 10
+#	-c i	number of columns, default 6 for -P, otherwise 12
+#	-n s	number pages using s as a prefix
+#	-w i	width of area for tile; default 48 unless -P
+#	-h i	height of area for file; default 48 unless -P
+#	-d	add date line
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, patutils, xio, xutils, graphics, xcompat
+#
+############################################################################
+
+link options
+link patutils
+link xio
+link xutils
+link graphics
+link xcompat
+
+procedure main(args)
+   local x, y, w, h, pattern, count, page, opts, images, auto, unseen, foot
+   local rows, cols, prefix, bfont, nfont, dims, areaw, areah, signal, poff
+   local date, HGap, VGap, patterns
+
+   opts := options(args, "Pi:aup+r+c+w+h+n:d")
+
+   images := \opts["i"]
+   auto := \opts["a"]
+   auto := unseen := \opts["u"]
+   page := (\opts["p"] - 1) | 0
+   prefix := \opts["n"]
+   if \opts["d"] then date := &dateline else date := ""
+   foot := \prefix | \opts["d"]
+
+   if \opts["P"] then {				# pattern mode
+      patterns := 1
+      HGap := 32				# gap between
+      VGap := 32				# gap below
+      areaw := 128				# pattern width
+      areah := 64				# pattern height
+      rows := \opts["r"] | 7
+      cols := \opts["c"] | 6
+      w := (areaw + HGap) * cols - HGap
+      h := (areah + VGap) * rows
+      if \foot then h +:= 20
+      }
+   else {					# image mode
+      HGap := 16				# gap between
+      VGap := 16				# gap below
+      rows := \opts["r"] | 10
+      cols := \opts["c"] | 12
+      areaw := \opts["w"] | 48
+      areah := \opts["h"] | 48
+      w := (areaw + HGap) * cols + 1
+      h := (areah + VGap) * rows + 1
+      if \foot then h +:= 20			# space for page number
+      }
+
+   WOpen("width=" || w, "height=" || h, "canvas=hidden") |
+      stop("*** cannot open window")
+   if /unseen then WAttrib("canvas=normal")
+
+   if \patterns then WAttrib("fillstyle=textured")
+
+   bfont := "-misc-fixed-medium-r-normal--10-100-75-75-c-60-iso8859-1"
+   nfont := "-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso8859-1"
+
+   Font(bfont | "6x10" | "fixed")
+
+   count := 0
+
+#  Skip pages if requested.
+
+   every 1 to (rows * cols) * page do {
+      readpatt() | stop("*** premature end of file")
+      count +:= 1
+      }
+
+#  Main processing loop.
+
+   repeat {
+      if \patterns then EraseArea()
+      else grid(areaw + HGap, areah + VGap, cols, rows)
+
+      x := y := 0
+
+#  Do a page.
+
+      every 1 to rows do {
+         every 1 to cols do {
+            pattern := readpatt() | break break break
+            count +:= 1
+            if \patterns then {
+               Pattern(pattern) | {
+                   write(&errout, "*** could not set pattern: ", pattern)
+                   next
+                   }
+               FillRectangle(x, y, areaw, areah)
+               GotoXY(x, y + areah + VGap / 3)
+               WWrites(left(count || ":", 5))
+               dims := tiledim(pattern)
+               WWrites(left(dims.w || "x" || dims.h, 7))
+               WWrites("d=", left(pdensity(pattern), 7))
+               GotoXY(x, y + areah + VGap / 3 + 11)
+               if *pattern > 20 then pattern := pattern[1+:18] || "..."
+               WWrites(pattern)
+               }
+            else {
+               poff := (HGap + areaw - tiledim(pattern).w) / 3
+               DrawImage(x + poff, y + VGap / 2, pattern)
+               WFlush()
+               CenterString(x + poff * 2, y + areah + VGap / 3, count)
+               }
+            x +:= areaw + HGap
+            }
+         x := 0
+         y +:= areah + VGap
+         }
+
+      page +:= 1
+      if \foot then {
+         GotoXY(0, h - 5)
+         Font(nfont | "10x20" | "fixed")		# numbering font
+         WWrites(\prefix || page)
+         GotoXY(w - TextWidth(date), h - 5)
+         WWrites(date)
+         Font(bfont | "6x10" | "fixed")		# restore body font
+         }
+      if /auto & /unseen then signal := Event()
+      WriteImage(\images || right(page, 2, "0") || ".gif")
+      if signal === "q" then exit()
+      }
+
+   page +:= 1
+   if \foot then {
+      GotoXY(0, h - 5)
+      Font(nfont | "10x20" | "fixed")			# numbering font
+      WWrites(\prefix || page)
+      GotoXY(w - TextWidth(date), h - 5)
+      WWrites(date)
+      }
+   WriteImage(\images || right(page, 2, "0") || ".gif")
+   if /auto then WDone()
+
+end
+
+#  Draw a grid for the tile mode
+
+procedure grid(w, h, c, r)
+   local wc, hr, x, y
+
+   wc := w * c
+   hr := h * r
+
+   EraseArea()
+
+   every x := 0 to wc by w do
+      DrawLine(x, 0, x, hr)
+   every y := 0 to hr by h do
+      DrawLine(0, y, wc, y)
+
+   return
+
+end
diff --git a/ipl/gprogs/sier.icn b/ipl/gprogs/sier.icn
new file mode 100644
index 0000000..a0b48cf
--- /dev/null
+++ b/ipl/gprogs/sier.icn
@@ -0,0 +1,218 @@
+############################################################################
+#
+#	File:     sier.icn
+#
+#	Subject:  Program for generalized Sierpinski's triangle
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 10, 2004
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     Originally inspired by the Nova television show on chaos.
+#     Colorization suggested by Kenneth Walker.
+#
+############################################################################
+#
+#     This program constructs Sierpinski's triangle using an iterative
+#  method.  An initial point is chosen (by clicking the mouse inside the
+#  triangle) and marked.  Then, the program repeatedly moves half way to
+#  a randomly chosen vertex and plots a point in the color corresponding
+#  to the vertex.
+#
+#     The polygon need not be a triangle.  The number of sides may be given
+#  as a command line argument, or a digit 3 through 9 or 0 through 2 may be
+#  pressed to establish a new polygon of 3 to 12 sides.
+#
+#     The S, G, E, and Q keys function identically to the Stop, Go, Erase,
+#  Quit pushbuttons.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: button, evmux, random, graphics
+#
+############################################################################
+
+link button
+link evmux
+link random
+link graphics
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+global win, bwin, vwin, vcolors
+global m, w, h
+global nsides, xpos, ypos, outline
+global running, xcur, ycur
+
+procedure main(args)
+   local i, vcolors
+
+   win := Window("size=400,400", "font=Helvetica,bold,14", "bg=pale gray", args)
+   nsides := integer(args[1]) | 3
+   if nsides < 3 then stop("sierpinski: need at least 3 sides!")
+
+   m := WindowMargin
+   h := WAttrib("height") - 2 * m		# usable height
+   w := WAttrib("width") - 2 * m		# usable width
+
+   # make a window (g.c.) for drawing in background color
+   bwin := Clone(win)
+   Fg(bwin, Bg(win))
+
+   # make a color for each vertex
+   vcolors := [ 
+      "deep green",
+      "dark red",
+      "dark blue",
+      "deep red-magenta",
+      "dark cyanish blue",
+      "dark red-orange",
+      "deep purple",
+      "deep cyan",
+      "deep brown",
+      "deep orangish red",
+      "deep purple",
+      "dark cyanish blue"
+      ]
+   vwin := []
+   if WAttrib(win, "depth") > 2 then
+      every put(vwin, Clone(win, "fg=" || !vcolors))
+   else
+      put(vwin, win)
+
+   # configure and draw the polygon
+   configure()
+   erase()
+
+   # set up buttons and character handlers
+   button(win, "Go", setfill, 0, m, m, 50, 20)
+   button(win, "Stop", setfill, -1, m, m + 30, 50, 20)
+   button(win, "Erase", argless, erase, m + w - 50, m, 50, 20)
+   button(win, "Quit", argless, exit, m + w - 50, m + 30, 50, 20)
+   sensor(win, 'Gg', setfill, 0)
+   sensor(win, 'Ss', setfill, -1)
+   sensor(win, 'Ee', argless, erase)
+   quitsensor(win)				# enable Q-for-quit etc.
+   sensor(win, '3456789012', setsides)
+
+   # set up sensor for drawing the curve
+   sensor(win, &lrelease, setfill, 1, m, m, w, h)
+
+   # process events
+   randomize()
+   i := 1
+   repeat {
+      while *Pending(win) > 0 | running < 0 do
+         evhandle(win)
+      every 1 to 100 do {
+         DrawPoint(vwin [i | 1], xcur, ycur)
+         i := ?nsides
+         xcur := (xcur + xpos[i]) / 2
+         ycur := (ycur + ypos[i]) / 2
+         }
+      }
+end
+
+
+
+#  configure() -- set vertex points
+
+procedure configure()
+   local a, da, i
+   local xmin, xmax, xscale, ymin, ymax, yscale
+
+   # ensure we have enough windows for the vertices
+   while *vwin < nsides do
+      vwin |||:= vwin
+
+   # get coordinates for vertices as points on a radius-1 circle
+   da := 2 * &pi / nsides
+   a := 1.5 * &pi - da / 2
+   if nsides = 4 then
+      a +:= &pi / 12
+   xpos := list(nsides)
+   ypos := list(nsides)
+   every i := 1 to nsides do {
+      xpos[i] := cos(a)
+      ypos[i] := sin(a)
+      a -:= da
+      }
+
+   # now scale to available window size
+   # also make coord list for drawing outline
+   xmin := xmax := ymin := ymax := 0.0
+   every xmin >:= !xpos
+   every xmax <:= !xpos
+   every ymin >:= !ypos
+   every ymax <:= !ypos
+   xscale := w / (xmax - xmin)
+   yscale := h / (ymax - ymin)
+   outline := [win]
+   every i := 1 to nsides do {
+      put(outline, m + xscale * (1.01 * xpos[i] - xmin))
+      put(outline, m + h - yscale * (1.01 * ypos[i] - ymin))
+      xpos[i] := m + xscale * (xpos[i] - xmin)
+      ypos[i] := m + h - yscale * (ypos[i] - ymin)
+      }
+   put(outline, outline[2])
+   put(outline, outline[3])
+end
+
+
+
+#  erase(gc) -- erase the polygon and draw its outline
+
+procedure erase(gc)
+   outline[1] := bwin
+   FillPolygon ! outline
+   outline[1] := \gc | win
+   DrawLine ! outline
+   running := -1
+   xcur := m + w / 2
+   ycur := m + h / 2
+   return
+end
+
+
+
+#  setfill(win, n, x, y) -- start/stop filling points according to n
+#
+#  n<0  stop
+#  n=0  start, from current point
+#  n>0  start, from (x,y)
+
+procedure setfill(win, n, x, y)
+   if n > 0 then {
+      xcur := x
+      ycur := y
+      }
+   if n >= 0 then {
+      outline[1] := bwin
+      DrawLine ! outline		# erase outline
+      }
+   running := n
+   return
+end
+
+
+
+#  setsides(win, dummy, x, y, event) - reset the number of sides
+
+procedure setsides(win, dummy, x, y, event)
+   nsides := integer(event)
+   if nsides < 3 then nsides +:= 10
+   erase(bwin)
+   configure()
+   erase()
+end
diff --git a/ipl/gprogs/sier1.icn b/ipl/gprogs/sier1.icn
new file mode 100644
index 0000000..af02464
--- /dev/null
+++ b/ipl/gprogs/sier1.icn
@@ -0,0 +1,50 @@
+############################################################################
+#
+#	File:     sier1.icn
+#
+#	Subject:  Program to draw the Sierpinski triangle
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program demonstrates an interesting way to draw the Sierpinski
+#  triangle.  For an explanation, see
+#
+#	Chaos and Fractals, Heinz-Otto Peitgen, Harmut Jurgens,
+#	and Dietmar Saupe, Springer-Verlah, 1992, pp. 132-134.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local width, offset, x, y
+
+   WOpen("label=sierpinski", "size=300,300") |
+      stop("*** cannot open window")
+
+   width := 256
+   offset := 30
+
+   every y := 0 to width - 1 do
+      every x := 0 to width - 1 do
+         if iand(x, y) = 0 then DrawPoint(x + offset, y + offset)
+
+  Event()
+
+end
diff --git a/ipl/gprogs/sier2.icn b/ipl/gprogs/sier2.icn
new file mode 100644
index 0000000..2ae6ba2
--- /dev/null
+++ b/ipl/gprogs/sier2.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     sier2.icn
+#
+#	Subject:  Program to display the Sierpinski fractal
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 24, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is a barebones version of a display of the Sierpinski fractal.
+#  It has deliberately been left simple and free of options so that the
+#  basic idea is clear and so that it can be used as the basis of
+#  more capable versions.
+#
+#  This program is based on material given in "Chaos, Fractals,
+#  and Dynamics", Robert L. Devaney, Addison-Wesley, 1990.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main()
+   local extent, x, y, i
+
+   extent := 300
+
+   WOpen("label=sier", "height=" || extent, "width=" || extent) |
+      stop("*** cannot open window")
+
+   x := 20			# The results do not depend on these values
+   y := 150
+
+   every i := 1 to 100000 do {
+      case ?3 of {		# Decide what to do at random
+         1: {
+            x /:= 2
+            y /:= 2
+            }
+         2: {
+            x /:= 2
+            y := (extent + y) / 2
+            }
+         3: {
+            x := (extent + x) / 2
+            y := (extent + y) / 2
+            }
+         }
+      if i > 1000 then DrawPoint(x, y)		# Wait until attraction
+      }
+
+   Event()
+
+end
diff --git a/ipl/gprogs/snapper.icn b/ipl/gprogs/snapper.icn
new file mode 100644
index 0000000..4411efd
--- /dev/null
+++ b/ipl/gprogs/snapper.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     snapper.icn
+#
+#	Subject:  Program to display images
+#
+#	Authors:  Ralph E. Griswold and Clinton L. Jeffery
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This is just a simple program to display black-and-white versions of screen
+#  dumps.
+#
+#  Type the name of an XBM or XPM file on the prompt in the input window.
+#  Get rid of an image by click in the image window.  Exit the program
+#  by clicking in the input window.
+#
+#  As an exercise, you might want to make this program more versatile --
+#  and perhaps write a program to do slide shows.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure main(av)
+   local name, window, winput
+
+   if *av > 0 then {
+      every name := !av do {
+         (window := WOpen("label=" || name, "image=" || name,"pos=400,200")) | 
+            write(&errout,"cannot open image ",name)
+	 }
+      Active()
+   } else {
+      winput := WOpen("label=snapper! (click mouse in this window to exit)") |
+	 stop("** can't open window")
+
+      repeat {
+	 close(\window)
+	 writes(winput, "next image: ")
+	 name := read(winput)
+	 (window := WOpen("label=" || name, "image=" || name,"pos=400,200")) | 
+	    write(winput,"cannot open image")
+         if Event(winput) === (&lpress | &mpress | &rpress) then
+            exit()
+      }
+   }
+   
+end
diff --git a/ipl/gprogs/spectra.icn b/ipl/gprogs/spectra.icn
new file mode 100644
index 0000000..a7e2225
--- /dev/null
+++ b/ipl/gprogs/spectra.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     spectra.icn
+#
+#	Subject:  Program to report color spectra in images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program analyzes images whose names are given on the command line
+#  and produces a file with the lists of colors and number of pixels of
+#  each color.  The entries are given in the order of most to least frequent
+#  color.  The color files have the base name of the image file and the
+#  extension ".spc".
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, imgcolor, wopen
+#
+############################################################################
+
+link imgcolor
+link basename
+link wopen
+
+procedure main(args)
+   local file, colors, output, name, count
+
+   every file := !args do {
+      WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open image file ", file)
+         next
+         }
+     colors := imgcolor()
+     WClose()
+     name := basename(file, ".gif")
+     output := open(name || ".spc", "w") | {
+        write("*** cannot open ", name, ".spc")
+        next
+        }
+      colors := sort(colors, 4)
+      while count := pull(colors) do
+         write(output, left(pull(colors), 20), right(count, 8))
+      close(output)
+      &window := &null
+      }
+
+end
diff --git a/ipl/gprogs/spider.icn b/ipl/gprogs/spider.icn
new file mode 100644
index 0000000..0c25529
--- /dev/null
+++ b/ipl/gprogs/spider.icn
@@ -0,0 +1,567 @@
+############################################################################
+#
+#	File:     spider.icn
+#
+#	Subject:  Program to play Spider solitaire card game
+#
+#	Author:   William S. Evans
+#
+#	Date:     February 19, 2002
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#   Initially, 54 cards are dealt (from two decks shuffled together)
+#   into 10 piles (6,5,5,6,5,5,6,5,5,6) with only the top card in each
+#   pile face-up.  You may pile face-up cards in decreasing order (Ace
+#   is smallest) by moving the topmost face-up "run" of cards from one
+#   pile to another.  A run is a decreasing sequence of cards in the
+#   same suit.  To perform the move, you may drag the run to its
+#   destination, click on the pile containing the run, or type its
+#   number.  In the latter two cases, the program tries to move the
+#   longest run in the pile to the "best" location.  You may move any
+#   run to an empty pile.  To move a partial run, drag or click its
+#   deepest card using the center mouse button.
+#
+#   A run from King to Ace can be removed from the board (by clicking on
+#   its pile or typing its pile number).
+#
+#   The 50 additional cards remaining in the deck may be dealt, one to
+#   each pile, as long as every pile contains at least one card.
+#
+#   The goal of the game is to remove all 104 cards from the board.
+#
+#   The following keys are recognized by the program:
+#	'd'	Deal.
+#	'u'	Undo last move or deal.
+#	'q'	Quit.
+#	'e'	Print list of face-up cards in pile. (Useful if the
+#		pile becomes so big that the card names are obscured.)
+#	'E'	Print list of face-down cards in pile. (Cheating)
+#	'n'	Start a new game.
+#	's'	Save the current game to a file.
+#	'r'	Read a game from a file.
+#	'1234567890'	Move run from indicated pile.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  drawcard, graphics, random
+#
+############################################################################
+
+link drawcard
+link graphics
+link random
+
+$define SPIDER_VERSION "spider-0.3"	# version of spider
+
+global cardw, cardh			# card width and height
+global ymargin, xmargin, xgap		# margins, gap between cards
+global height,width,fheight,descent	# window attributes
+global lap		# overlap of facedown cards
+global deck		# a string of characters
+global up		# list of integers
+global pile		# list of strings
+global yoff		# list of lists of integers
+global nextCard		# an integer
+global undoStack	# list of integers
+global currentFile	# filename to store/retrieve a game
+global readingGame	# =1 if reading game from file =0 o.w.
+
+procedure main(args)
+    local fromPile,maxCards,e,p
+
+    initialize(args)
+    newgame()
+    repeat case e := Event() of {
+	!"qQ": {
+	    exit()
+	}
+	"d": {
+	    deal() | beep()
+	}
+	"e": {
+	    message(pileNames(1+(&x-xmargin+xgap/2)/(cardw+xgap)))
+	}
+	"E": {
+	   message(hiddenNames(1+(&x-xmargin+xgap/2)/(cardw+xgap)))
+	}
+	"n": {
+	    newgame()
+	}
+	"u": {
+	    undo() | beep()
+	}
+	"r": {
+	    readingGame := 1
+	    WAttrib("bg=pale gray","fg=black")
+	    readFile()
+	    readingGame := 0
+	    WAttrib("bg=deep moderate green","fg=white")
+	    drawBoard()
+	}
+	"s": {
+	    WAttrib("bg=pale gray","fg=black")
+	    saveFile()
+	    WAttrib("bg=deep moderate green","fg=white")
+	}
+	!"1234567890": {
+	    p := 0 < ord(e)-ord("0") | 10
+	    click(13,p,p) | beep()
+	}
+	&lpress | &rpress: {
+	    fromPile := 1 + (&x - xmargin + xgap/2) / (cardw + xgap)
+	    maxCards := 13
+	}
+	&mpress: {
+	    fromPile := 1 + (&x - xmargin + xgap/2) / (cardw + xgap)
+	    maxCards := 1
+	    every &y <= !yoff[11 > fromPile] do
+		maxCards +:= 1
+	}
+	&lrelease | &mrelease | &rrelease: {
+	    click(maxCards,fromPile,1 + (&x-xmargin+xgap/2) / (cardw+xgap)) |
+		beep()
+	}
+#	&resize: {
+#	    drawBoard()
+#	}
+    }
+
+end
+
+procedure initialize(args)
+
+    currentFile := "game1.spd"
+    readingGame := 0
+    cardw := 80
+    cardh := 124
+    pile := list(11)
+    up := list(11)
+    yoff := list(11)
+    undoStack := list(0)
+
+    deck := "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ" ||
+	    "aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ"
+    randomize()
+
+    ymargin := 10
+    xmargin := 16
+    xgap := xmargin / 2
+    lap := 5			# how much facedown cards overlap in pile
+
+    WOpen("width="||(10 * cardw + 9 * xgap + 2 * xmargin),"height=500",
+	  "bg=deep moderate green","fg=white")
+    if WAttrib("displaywidth") < 900 then {
+	xmargin := xgap := 0;
+	WAttrib("width=800")
+    }
+    Font("serif")
+    height := WAttrib("height")
+    width  := WAttrib("width")
+    fheight:= WAttrib("fheight")
+    descent:= WAttrib("descent")
+
+    ymargin <:= fheight
+
+    return
+end
+
+
+
+procedure newgame(initialDeck)
+   local i, j, s
+
+   while (pop(undoStack))		# empty stack
+
+   deck := \initialDeck |		# use initialDeck or shuffle deck
+       every i := *deck to 2 by -1 do
+	   deck[?i] :=: deck[i]
+
+   deck ? {
+       pile[1] := move(6)
+       pile[2] := move(5)
+       pile[3] := move(5)
+       pile[4] := move(6)
+       pile[5] := move(5)
+       pile[6] := move(5)
+       pile[7] := move(6)
+       pile[8] := move(5)
+       pile[9] := move(5)
+       pile[10] := move(6)
+       nextCard := 55
+   }
+   pile[11] := ""
+
+   every i := 1 to 10 do
+       up[i] := 1
+   up[11] := 0
+
+   drawBoard()
+   return
+end
+
+procedure drawPiles(p[])
+    local i,j,n,x,y,ht,mlap,upstart,yposns
+
+    if readingGame = 0 then {
+	every i := 1 <= 10 >= !p do {
+
+#	write("pile ",i," = ",pile[i]," up = ",up[i])
+
+	    yoff[i] := yposns := list(0)
+	    x := xmargin + (i-1) * (cardw + xgap)
+	    EraseArea(x,ymargin,cardw,height-2*ymargin)
+	    GotoXY(x+cardw/2,ymargin-descent)
+	    WWrites(10 > i | 0)
+	    n := *(pile[i])
+	    mlap := lap
+	    if n > 1 then
+		mlap >:= (height - 2*ymargin - cardh)/(n-1.0)
+	    every j := n to up[i]+1 by -1 do {
+		y := ymargin + (n - j)*mlap
+		drawcard(x,y,"-")
+		put(yposns, y)
+	    }
+	    if up[i] > 0 then {
+		upstart := ymargin + (n-up[i])*mlap
+		mlap := (height-2*ymargin-cardh-(n-up[i])*mlap)/
+		    (0<up[i]-1.0) | 0
+		mlap >:= cardh / 3
+		every j := up[i] to 1 by -1 do {
+		    y := integer(upstart + (up[i] - j)*mlap)
+		    drawcard(x,y,pile[i][j])
+		    put(yposns, y)
+		}
+	    }
+	}
+	message("")
+    }
+    return
+end
+
+
+procedure drawBoard()
+    if readingGame = 0 then {
+	WAttrib("label=Spider Deck "||104-nextCard+1)
+	drawPiles(1,2,3,4,5,6,7,8,9,10)
+    }
+    return
+end
+
+procedure deal()
+    local i
+
+    every i := 1 to 10 do {
+	if *(pile[i]) = 0 then fail
+    }
+
+    every i := 1 to 10 do {
+	pile[i] := (deck[nextCard] || pile[i]) | fail
+	up[i] +:= 1
+	nextCard +:= 1
+    }
+    if readingGame = 0 then {
+	push(undoStack,0,0,0,2)			# flag for deal
+	drawBoard()
+    }
+    return
+end
+
+procedure undo()
+    local undoFlag,i,toPile,fromPile,n
+
+#    writes(">")
+#    every writes(!undoStack," ")
+#    write("")
+
+    undoFlag := pop(undoStack) | fail
+    case undoFlag of {
+	0 | 1: {			# undo move
+	    toPile := pop(undoStack)
+	    fromPile := pop(undoStack)
+	    n := pop(undoStack)
+	    up[fromPile] -:= undoFlag	# undoFlag = 1 means unturn card
+	    moveNoUndo(n,toPile,fromPile)
+	}
+	2: {				# undo deal
+	    every i := 1 to 10 do {
+		pile[i] := pile[i][2:0]
+		up[i] -:= 1
+		nextCard -:= 1
+	    }
+	    pop(undoStack)		# push spacers
+	    pop(undoStack)
+	    pop(undoStack)
+	    drawBoard()
+	}
+	default: fail			# this should never happen
+    }
+    return
+end
+
+procedure moveNoUndo(n,fromPile,toPile)
+#    write("moveNoUndo ",n," ",fromPile," ",toPile)
+    pile[toPile] := pile[fromPile][1:n+1] || pile[toPile]
+    up[toPile] +:= n
+    pile[fromPile] := (pile[fromPile][n+1:0] | "")
+    up[fromPile] -:= n
+    drawPiles(fromPile,toPile)
+    return
+end
+
+procedure moveCards(n,fromPile,toPile)
+    push(undoStack,n)
+    push(undoStack,fromPile)
+    push(undoStack,toPile)
+    if n = up[fromPile] & *(pile[fromPile]) > n then {
+	push(undoStack,1)
+	up[fromPile] +:= 1
+    } else {
+	push(undoStack,0)
+    }
+    moveNoUndo(n,fromPile,toPile)
+
+    return
+end
+
+procedure chainPrefix(p)
+    local i
+
+    i := 1
+    while (i < up[p] & \(succ(pile[p][i])) == pile[p][i+1]) do {
+	       i +:= 1
+	   }
+    return pile[p][1:i+1]
+end
+
+
+procedure click(maxCards, fromPile, toPile)
+    local i,j,tail,chain,c
+
+#    write("click ",fromPile," ",toPile)
+
+    chain := chainPrefix(fromPile) | fail
+    chain := chain[1+:maxCards]		# limit chain size (may fail, no effect)
+    0 < toPile <= 10 | fail
+    0 < fromPile <= 10 | fail
+
+    if fromPile = toPile then {		# find best pile to move to
+	if *chain = 13 then {		# take-off entire suit
+	   moveCards(13,fromPile,11)
+	   return
+	} else {			# move chain
+	    tail := succ(chain[-1]) | &null
+
+	    i := 0 < fromPile - 1 | 10
+	    j := fromPile
+	    while i ~= fromPile do {
+		if pile[i] == "" & j = fromPile then {
+		    j := i
+		} else if pile[i][1] == \tail then {
+		    j := i
+		    break
+		} else if rank(pile[i][1]) == rank(\tail) then {
+		    j := i
+		}
+		i := 0 < i - 1 | 10
+	    }
+	    if j ~= fromPile then {
+		moveCards(*chain,fromPile,j)
+		return
+	    }
+	}
+    } else {				# move to toPile
+	if pile[toPile] == "" then {
+	    moveCards(*chain,fromPile,toPile)
+	    return
+	} else {
+	    c := pile[toPile][1]
+  	    every i := 1 to *chain do {
+  		if rank(c) == rank(chain[i]) + 1 then {
+  		    moveCards(i,fromPile,toPile)
+  		    return
+  		}
+  	    }
+	}
+    }
+    cantMove(chain[-1])
+#   fail
+end
+
+procedure cantMove(c)
+    message("Can't move " || rankName(c) || suitName(c))
+    return
+end
+
+
+# label: ABCDEFGHIJKLM NOPQRSTUVWXYZ abcdefghijklm nopqrstuvwxyz
+# rank:  A23456789TJQK A23456789TJQK A23456789TJQK A23456789TJQK
+# suit:  hearts....... spades....... clubs........ diamonds.....
+
+procedure suit(c)
+    if c >>= "A" & c <<= "M" then return "A"	#hearts
+    if c >>= "N" & c <<= "Z" then return "N"	#spades
+    if c >>= "a" & c <<= "m" then return "a"	#clubs
+    if c >>= "n" & c <<= "z" then return "n"	#diamonds
+#   fail
+end
+
+procedure rank(c)
+    return ord(c)-ord(suit(c))
+end
+
+procedure succ(c)
+    if c == !"MZmz" then fail
+    else return char(ord(c)+1)
+end
+
+procedure beep()
+    writes("\^g")
+    flush(&output)
+    return
+end
+
+procedure rankName(c)
+    local r
+
+    case r := rank(c) of {
+	0: return "A"
+	1 to 9: return string(r+1)
+	10: return "J"
+	11: return "Q"
+	12: return "K"
+    }
+end
+
+procedure suitName(c)
+    case suit(c) of {
+	"A": return "h"
+	"N": return "s"
+	"a": return "c"
+	"n": return "d"
+    }
+end
+
+procedure message(s)
+    local x
+    x := 5
+    EraseArea(x,height-fheight,width,fheight)
+    GotoXY(x,height-descent)
+    WWrites(s)
+    return
+end
+
+
+procedure hiddenNames(p)
+   local i, s, card
+
+   i := up[p]
+   s := ""
+   every card := pile[p][i to *(pile[p])] do {
+      s ||:= rankName(card) || suitName(card)
+   }
+   return s
+end
+
+procedure pileNames(p)
+    local i,run,s
+
+    i := up[p]
+    s := ""
+    while ( i >= 1 ) do {
+	s ||:= rankName(pile[p][i])
+	run := 0
+	while ( pile[p][i] == succ(pile[p][i-1])[1] ) do {
+	    i -:= 1
+	    run := 1
+	}
+	if ( run = 1 ) then {
+	    s ||:= "-"
+	    s ||:= rankName(pile[p][i])
+	}
+	s ||:= suitName(pile[p][i])
+	i -:= 1
+    }
+    return s
+end
+
+procedure saveFile()
+    local output
+
+    repeat {
+	case OpenDialog("Save game as:",currentFile) of {
+	    "Okay": {
+		if output := open(dialog_value,"w") then {
+		    currentFile := dialog_value
+		    write(output,SPIDER_VERSION)
+		    write(output,deck)
+		    every writes(output,!undoStack," ")
+		    write(output,"")
+		    return
+		} else {
+		    Notice("Cannot open file for writing.")
+		}
+	    }
+	    "Cancel" : fail
+	}
+    }
+end
+
+
+procedure readFile()
+    local input
+
+    repeat {
+	case OpenDialog(,currentFile) of {
+	    "Okay": {
+		if input := open(dialog_value) then {
+		    currentFile := dialog_value
+		    if read(input)==SPIDER_VERSION then {
+			newgame(read(input))
+			read(input) ? {
+			    while put(undoStack,integer(tab(upto(" "))))
+			}
+			if doAll() then return
+		    }
+		    Notice("Not a valid spider game file.")
+		} else
+		    Notice("Cannot open file.")
+	    }
+	    "Cancel": fail
+	}
+    }
+end
+
+procedure doAll()
+    local i,doFlag,toPile,fromPile,n
+
+#    writes(">")
+#    every writes(!undoStack," ")
+#    write("")
+
+    i := *undoStack
+    while i >= 1 do {
+	case doFlag := undoStack[i-3] of {
+	    0 | 1: {
+		toPile := undoStack[i-2]
+		fromPile := undoStack[i-1]
+		n := undoStack[i]
+		up[fromPile] +:= doFlag	# doFlag = 1 means turn card
+		moveNoUndo(n,fromPile,toPile) | fail
+	    }
+	    2: {
+		deal() | fail
+	    }
+	}
+	i -:= 4
+    }
+    return
+end
diff --git a/ipl/gprogs/spiral.icn b/ipl/gprogs/spiral.icn
new file mode 100644
index 0000000..6109b39
--- /dev/null
+++ b/ipl/gprogs/spiral.icn
@@ -0,0 +1,100 @@
+############################################################################
+#
+#       File:     spiral.icn
+#
+#	Subject:  Program to draw polygonal spirals
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program displays polyline based spiral
+#
+#	See the procedure 'helpmsg' for command line options
+#	(or run as 'spiral -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links:  glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local dist, angle, incr, n, nextarg, arg, t
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 1.0
+   
+    dist := 0.02
+    angle := 144
+    incr := 0.01
+    n := 100
+
+    nextarg := create !args
+    while arg := @nextarg do {
+       if arg == ("-help"|"-h") then stop(helpmsg())
+       if match(arg, "-distance") then dist := numeric(@nextarg)
+       else if match(arg, "-angle") then angle := numeric(@nextarg)
+       else if match(arg, "-increment") then incr := numeric(@nextarg)
+       else if arg == "-n" then n := integer(@nextarg)
+       }
+
+    win := WOpen("label=Poly Spiral", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(0,0), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    Fg(win, "black")
+    t := turtle(Window, point(w/2, h/2), 0)
+    polyspiral(t, dist, angle, incr, n)
+
+    Event(win)
+    close(win)
+end
+
+procedure polyspiral(t, dist, angle, incr, n)
+   local i
+
+   every i := 1 to n do {
+      Line_Forward(t, dist)
+      Right(t, angle)
+      dist +:= incr
+      }
+
+end
+
+procedure helpmsg()
+   write("Usage: Spiral [-d dist] [-a angle] [-i increment] [-n nlines]")
+   write("   where")
+   write("     -d N		-- initial line length {default: 0.02")
+   write("     -a N		-- angle of change (degrees) {144}")
+   write("     -i N		-- incremental change to line {0.01}")
+   write("     -n N		-- number of lines to draw {100}")
+   return
+end
+
diff --git a/ipl/gprogs/spiro.icn b/ipl/gprogs/spiro.icn
new file mode 100644
index 0000000..42ac1b3
--- /dev/null
+++ b/ipl/gprogs/spiro.icn
@@ -0,0 +1,148 @@
+############################################################################
+#
+#       File:     spiro.icn
+#
+#	Subject:  Program to display spirograph lines
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program displays spirograph-like output
+#	There are two methods of drawing: epitrochoid, where
+#	the secondary circle moves around the outside of the
+#	primary circle, and hypotrochoid (the default here),
+#	where the secondary circle moves around the inside of
+#	the primary circle.
+#
+#	See the procedure 'helpmsg' for command line options
+#	 (or run as 'spiro -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links:  glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib		# need the turtle graphic stuff
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local a, b, k, t1, t2, N, arg, use_epi, t, alist
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 350.0
+   
+    a := 100.0
+    b := 5.0
+    k := 20.0
+    t1 := 0.0
+    t2 := 1.0				# only roll around once.
+    N := 500
+
+    while arg := get(args) do {
+       case arg of {
+          "-help"|"-h" : helpmsg()
+          "-epi" : use_epi := "yes"
+          "-a": a := real(get(args))
+          "-b": b  := real(get(args))
+          "-k": k := real(get(args))
+          "-t1": t1 := real(get(args))
+          "-t2": t2 := real(get(args))
+          "-N" : N := integer(get(args))
+          }
+       }
+
+    win := WOpen("label=Spirograph", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(-w,-h), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    t := turtle(Window, point(w/2, h/2), 0, create |"red")
+
+    # build list of arguments to pass to parametric equations
+    #    (same list for both x and y equations here)
+    alist := [a,b,k]
+
+    if \use_epi then
+       draw_curve(t,epi_x,alist,epi_y,alist,t1,t2,N)
+    else
+       draw_curve(t,hypo_x,alist,hypo_y,alist,t1,t2,N)
+        
+
+    # sit and wait for an event on the window.
+    Event(win)
+    close(win)
+end
+
+procedure epi_x(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]+a[2]
+   return (ab)*cos(twopi*t) - a[3]*cos(twopi*((ab)*t)/a[2])
+end
+
+procedure epi_y(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]+a[2]
+   return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
+end
+
+procedure hypo_x(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]-a[2]
+    return (ab)*cos(twopi*t) + a[3]*cos(twopi*((ab)*t)/a[2])
+end
+
+procedure hypo_y(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]-a[2]
+    return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
+end
+
+procedure helpmsg()
+   write("Usage: Spiro [-a r] [-b r] [-k r] [-t1 r] [-t2 r] [-N n] [-epi]")
+   write()
+   write("where:")
+   write("\t-a r	- radius of center circle {default 100}")
+   write("\t-b r	- radius of moving circle {5}")
+   write("\t-k r	- distance of pen from center of moving circle {20}")
+   write("\t-t1 r	- initial value for parameter {0.0}")
+   write("\t-t2 r	- final value for parameter {1.0 (one revolutio)}")
+   write("\t-N n	- number of intervals to draw {500}")
+   write("\t-epi	- use epitrochoid instead of hypotrochoid")
+   stop()
+end
diff --git a/ipl/gprogs/splat.icn b/ipl/gprogs/splat.icn
new file mode 100644
index 0000000..1c85f0c
--- /dev/null
+++ b/ipl/gprogs/splat.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     splat.icn
+#
+#	Subject:  Program to drop paint splatters in a window
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     September 30, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  usage: splat [nspots [diameter]]
+#
+#     splat draws random circular spots in a window.  The number of spots
+#  and maximum diameter can be passed as command options.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, random
+#
+############################################################################
+
+link graphics
+link random
+
+procedure main(args)
+   local w, h, n, m, d
+
+   Window("size=800,500", args)
+   w := WAttrib("width")
+   h := WAttrib("height")
+   n := integer(args[1]) | 1000
+   m := integer(args[2]) | 100
+
+   randomize()
+   every 1 to n do {
+      Shade(RandomColor())
+      d := (?m * ?m * ?m) / (m * m)
+      FillArc(?(w - d - 1), ?(h - d - 1), d, d)
+      }
+   WDone()
+end
diff --git a/ipl/gprogs/spokes.icn b/ipl/gprogs/spokes.icn
new file mode 100644
index 0000000..e0c2c81
--- /dev/null
+++ b/ipl/gprogs/spokes.icn
@@ -0,0 +1,91 @@
+############################################################################
+#
+#	File:     spokes.icn
+#
+#	Subject:  Program to draw spokes design
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 13, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws "spokes" patterns.
+#
+#  The following options are supported:
+#
+#	-g	run continuously; ignore user events; default: process user
+#		  events
+#	-l i	limit on number of iterations, default 2 ^ 10
+#	-n i	maximum number of spokes, default 50
+#	-s i	size of window (width/height); default 256
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  interact, options, wopen
+#
+############################################################################
+
+link interact
+link options
+link wopen
+
+procedure main(args)
+   local i, j, k, angle, incr, xpoint, ypoint, size, radius, opts
+   local extent, max, limit, run
+
+   opts := options(args, "gl+n+s+")
+
+   extent := \opts["s"] | 256
+   limit := \opts["l"] | (2 ^ 10)
+   max := \opts["n"] | 50
+   run := opts["g"]
+
+   radius := extent / 4
+
+   WOpen("label=spokes", "width=" || extent, "height=" || extent,
+      "bg=light gray", "dx=" || (extent / 2), "dy=" || (extent / 2)) |
+         ExitNotice("Cannot open window.")
+
+   every 1 to limit do {
+      i := ?max
+      if i < 4 then i+:= 3 + ?10	# too few doesn't work well ...
+      angle := 0.0
+      incr := 2 * &pi / i
+      every j := 1 to i do {
+         spokes(radius * cos(angle), radius * sin(angle), radius, i, angle)
+         angle +:= incr
+         }
+      if /run then repeat case Event() of {
+         "q":   exit()
+         "s":   snapshot()
+         "n":   break
+         }
+      WDelay(1000)
+      EraseArea()
+      }
+   
+end
+
+procedure spokes(x, y, r, i, angle)
+   local incr, j
+
+   incr := 2 * &pi / i 
+
+   every j := 1 to i do {
+      DrawLine(x, y, x + r * cos(angle), y + r * sin(angle))
+      angle +:= incr
+      }
+
+   return
+
+end
+
diff --git a/ipl/gprogs/striper.icn b/ipl/gprogs/striper.icn
new file mode 100644
index 0000000..5cf4f07
--- /dev/null
+++ b/ipl/gprogs/striper.icn
@@ -0,0 +1,87 @@
+############################################################################
+#
+#	File:     striper.icn
+#
+#	Subject:  Program to make striped pattern from image edge
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the left column or top row of pixels of an image
+#  and creates a 1 x n or n x 1 image file from it.  The result, when
+#  tiled, is a striped pattern.
+#
+#  This program is useful for creating regular striped patterns from
+#  scans.
+#
+#  The following options are supported:
+#
+#	-d s	stripe direction:
+#		   "h"	horizontal (the default)
+#		   "v"	vertical
+#		   "b"	both horizontal and vertical
+#	-p s	prefix for GIF file names, default "stripes_"
+#	-w i	width of swatch, default 1
+#	-x i	x offset, default 0
+#	-y i	y offset, default 0
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+procedure main(args)
+   local file, hidden, count, prefix, opts, w, h, v, x, y
+
+   opts := options(args, "d:w+p:x+y+")
+   prefix := \opts["p"] | "stripes_"
+   w := \opts["w"] | 1
+   x := \opts["x"] | 0
+   y := \opts["y"] | 0
+   case opts["d"] of {
+      "h":   h := 1
+      "v":   v := 1
+      "b":   {
+         h := 1
+         v := 1
+         }
+      &null: h := 1
+      default:  stop("Invalid direcTion specification")
+      }
+
+   count := 0
+
+   every file := !args do {
+      hidden := WOpen("canvas=hidden", "image=" || file) | {
+         write(&errout, "*** cannot open ", file)
+         next
+         }
+      if \h then {
+         WriteImage(hidden, prefix || right(count +:= 1, 3, "0") || ".gif",
+            x, 0, w, WAttrib(hidden, "height")) |
+               write(&errout, "*** cannot write image file")
+         }
+      if \v then {
+         WriteImage(hidden, prefix || right(count +:= 1, 3, "0") || ".gif",
+            0, y, WAttrib(hidden, "width"), w) |
+               write(&errout, "*** cannot write image file")
+         }
+      WClose(hidden)
+      }
+
+end
diff --git a/ipl/gprogs/subdemo.icn b/ipl/gprogs/subdemo.icn
new file mode 100644
index 0000000..881d888
--- /dev/null
+++ b/ipl/gprogs/subdemo.icn
@@ -0,0 +1,264 @@
+############################################################################
+#
+#	File:     subdemo.icn
+#
+#	Subject:  Program to show the turtle graphics subset
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     subdemo displays various random designs in a window using the
+#  turtle graphics subset library procedures.  Click in the window,
+#  or enter a character on the keyboard, to start a new design.
+#
+#     The following keyboard characters have meaning:
+#
+#	w or W:			random walk
+#	b or B:			fractal bush (looks like "desert broom")
+#	s or S:			spiral design
+#	p or P:			polygon design
+#	t or T:			rectangular tiling
+#	r or R:			radial tiling
+#
+#	\n, \r, \t, or SP:	choose design randomly
+#	q or Q:			exit program
+#
+#	0:			pause drawing
+#	1, ... 9:		set speed of drawing (9 is fastest)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, subturtl, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link subturtl
+link random
+link graphics
+
+global msec	# delay between drawing actions
+global event	# interrupting event, if any
+
+procedure main(args)
+   local opts, dlist, p, e
+
+   opts := options(args, winoptions())
+   /opts["W"] := /opts["H"] := 500
+   &window := optwindow(opts)
+
+   randomize()
+   dlist := [walk, bush, poly, spiral, tile, radial]
+   msec := 0
+   event := "\r"
+   repeat {
+      e := \event | Event()
+      event := &null
+      case e of {
+         QuitEvents():				break
+         "\n" | "\r" | "\t" | " ":		run(?dlist)
+         &lrelease | &mrelease | &rrelease:	run(?dlist)
+         "b" | "B":				run(bush)
+         "w" | "W":				run(walk)
+         "s" | "S":				run(spiral)
+         "p" | "P":				run(poly)
+         "t" | "T":				run(tile)
+         "r" | "R":				run(radial)
+         "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9": setdelay(e)
+         }
+      }
+end
+
+#  run(p) -- execute procedure p after resetting screen environment
+
+procedure run(p)
+   TReset()
+   return p()
+end
+
+#  continue() -- delay and check for interrupts
+#
+#  Every demo should call this periodically and should exit if it fails.
+#  The global "event" is set to the interrupting event and can be checked
+#  to exit from recursive calls.
+
+procedure continue()
+   local evlist
+
+   event := &null
+   delay(msec)
+   if *Pending() = 0 then
+      return
+   event := Event()
+   if setdelay(event) then {
+      event := &null
+      return
+      }
+   else
+      fail
+end
+
+#  setdelay(e) -- handle delay-setting event, or fail
+
+procedure setdelay(e)
+   while e === "0" do		# 0 is pause -- wait until anything else input
+      e := Event()
+   if type(e) == "string" & *e = 1 & (e ? any(&digits)) then {
+      if e === "9" then
+         msec := 0
+      else
+         msec := ishift(1, 12 - e)
+      return
+      }
+   else
+      fail
+end
+
+
+#################### drawing routines ####################
+
+
+procedure walk()				# random walk
+   local stepsize, maxturn, bias
+
+   maxturn := 30
+   bias := 1
+   while continue() do
+      every 1 to 10 do {
+         TDraw(1)
+         TRight(?maxturn - maxturn/2.0 + bias)
+         }
+end
+
+
+procedure bush(n, len)				# fractal bush
+   local maxturn
+
+   if /n then {
+      TSkip(-150)
+      n := 4 + ?4
+      len := 400 / n
+      }
+   maxturn := 60
+   TSave()
+   TRight(?maxturn - maxturn / 2.0)
+   TDraw(?len)
+   if n > 0 & /event then {
+      continue()
+      every 1 to ?4 do
+         bush(n - 1, len)
+      }
+   TRestore()
+end
+
+
+procedure poly()				# regular nonconvex polygon
+   local angle, side, x0, y0
+   angle := 60 + ?119
+   side := 200 - 100 * cos(dtor(angle))
+   x0 := WAttrib("width") / 2 - side / 2
+   y0 := WAttrib("height") / 2 - side / 3
+   TGoto(x0, y0)
+   TLeft(THeading())				# set heading to zero (East)
+   while continue() do {
+      TDraw(side)
+      TRight(angle)
+      if abs(TX() - x0) + abs(TY() - y0) < 1 then break
+      }
+end
+
+
+procedure spiral()				# polygon spiral
+   local angle, side, incr
+   angle := 30 + ?149
+   incr := sqrt(4 * ?0) + 0.3
+   side := 0
+   while side < 1000 & continue() do {
+      TDraw(side +:= incr)
+      TRight(angle)
+      }
+end
+
+
+procedure tile()
+   local i, j, n, x0, y0, x, y, dx, dy, f, m
+
+   n := 5
+   x0 := WAttrib("width") / 2
+   y0 := WAttrib("height") / 2
+   dx := x0 / n
+   dy := y0 / n
+   f := mkfig(?10)
+   x := dx / 2
+   m := dx + dy
+   every i := 1 to n do {
+      y := dy / 2
+      every j := 1 to n do {
+         THeading(45)
+         TGoto(x0 + x, y0 + y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         TGoto(x0 + x, y0 - y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         TGoto(x0 - x, y0 + y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         TGoto(x0 - x, y0 - y);  every 1 to 4 do { putfig(f, m); TRight(90) }
+         y +:= dy
+         if not continue() then
+            return
+         }
+      x +:= dx
+      }
+end
+
+
+procedure radial()
+   local f, i, j, nrings, rwidth, fwd, circ, nfig, da
+
+   f := mkfig(?8)
+   nrings := 5
+   rwidth := WAttrib("width") / (2 * nrings)
+   every i := 1 to nrings do {
+      circ := &pi * 2 * i * rwidth
+      nfig := integer(circ / 50)
+      nfig := nfig / 2 + ?nfig
+      da := 360.0 / nfig
+      every j := 0 to nfig-1 do {
+         TGoto(WAttrib("width") / 2, WAttrib("height") / 2)
+         TRight(-THeading() + 90 - j * da)
+         TSkip(rwidth * (i - 0.9))
+         putfig(f, rwidth)
+         if not continue() then
+            return
+         }
+      }
+end
+
+
+procedure mkfig(nseg)
+   local f
+   f := []
+   every 1 to nseg do {
+      put(f, ?0 / nseg)		# draw
+      put(f, -90 + 180 * ?0)	# turn
+      }
+   return f
+end
+
+procedure putfig(f, m)
+   local i
+   TSave()
+   every i := 1 to *f by 2 do {
+      TDraw(m * f[i])
+      TRight(f[i+1])
+      }
+   TRestore()
+end
diff --git a/ipl/gprogs/sym4mm.icn b/ipl/gprogs/sym4mm.icn
new file mode 100644
index 0000000..717c539
--- /dev/null
+++ b/ipl/gprogs/sym4mm.icn
@@ -0,0 +1,250 @@
+############################################################################
+#
+#	File:     sym4mm.icn
+#
+#	Subject:  Program to draw symmetrically
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program draws with the eight symmetries of the square - 4mm
+#  symmetry.
+#
+#  It is based on a simple drawing program by Gregg Townsend.
+#
+#  Pressing the left mouse button draws a point.  Dragging with the left mouse
+#  button depressed draws a line.  Pressing and dragging with the middle mouse
+#  depressed shows a dashed straight line, which is drawn solid when
+#  the middle mouse button is released.  Dragging with the right mouse
+#  button depressed erases in the vicinity of the mouse pointer.
+#
+#  Typing "f" toggles restriction of drawing to the "generating region"
+#  which is shaded when drawing is restricted.
+#
+#  Typing "g" toggles the grid lines.
+#
+#  Typing "p" toggles the background in the generating region.
+#
+#  Typing "c" clears the window.
+#
+#  Typing "s" takes a snapshot, writing a GIF file.  File names begin with
+#  a prefix, followed by three digits starting at 000 and increasing, and
+#  terminated by .GIF.
+#
+#  Typing "q" terminates the session.
+#
+#  Grid lines and shading are only provided for servers that support mutable
+#  colors.
+#
+#  The options supported are:
+#
+#	-w i	width of the window, default 512
+#	-h i	height of the window, default 512
+#	-s i	size of square, default 512x512; supersedes -w and -h
+#	-p s	prefix for image files, default "sym"
+#
+#  Note:  Although the window does not have to be square, the application is
+#  designed to work with a square window.
+#
+############################################################################
+#
+#  Requires:  Graphics
+#
+############################################################################
+#
+#  Links:  options, xio
+#
+############################################################################
+
+link options
+link xio
+
+procedure main(args)
+   local x, y, opts, number, w, h, prefix, curr, alt, restrict, xc, yc, grid
+   local xd, yd, nonrestrict, palt, pattern, pcurr, x1, y1, x2, y2, delta
+
+   opts := options(args, "w+h+s+p:")
+
+   number := -1
+
+   w := \opts["w"] | 512
+   h := \opts["h"] | 512
+   w := h := \opts["s"]
+   prefix := \opts["p"] | "sym"
+
+   restrict := 1			# initially restricted
+   nonrestrict := &null
+
+   WOpen("size=" || w || "," || h) | stop("*** cannot open window")
+
+   xc := w / 2
+   yc := h / 2
+
+   w -:= 1			# adjustment for 0-origin indexing
+   h -:= 1
+
+   curr := "light blue"
+   pcurr := "pink"
+   alt := "white"
+   palt := "white"
+
+   Pattern("2,#01")
+
+   if grid := NewColor(curr) then {
+      drawgrid(w, h, grid)
+      }
+
+   if pattern := NewColor(pcurr) then {
+      shade(w, h, pattern)
+      }
+
+   repeat case Event() of {
+      "f": {
+          restrict :=: nonrestrict
+          Color(\pattern, pcurr :=: palt)
+          }
+      "q": {
+         exit()
+         }
+      "c":  {
+         EraseArea()
+         if \grid then {
+            drawgrid(w, h, grid)
+            shade(w, h, pattern)
+            }
+         }
+      "s":  {
+         Color(\grid, "white")
+         Color(\pattern, "white")
+         WriteImage(prefix || right(number +:= 1, 3, 0) || ".gif")
+         Color(\grid, curr)
+         Color(\pattern, pcurr)
+         }
+      "g":  {
+         Color(\grid, curr :=: alt)
+         }
+      "p":  {
+         Color(\pattern, pcurr :=: palt)
+         }
+      &lpress: {
+         if \restrict & ((real(&x) / (&y + 0.0001) < 1.0) | (&x > xc) |
+            (&y > yc)) then next
+         every DrawPoint(&x | (w - &x), &y | (h - &y))
+         every DrawPoint(&y | (w - &y), &x | (h - &x))
+         x := &x
+         y := &y
+         }
+      &ldrag: {
+         if \x then {			# just in case (for artificial events)
+            if \restrict & ((real(x) / (y + 0.0001)  < 1.0) | (x > xc) |
+               (y > yc)) then next
+            DrawLine(x, y, &x, &y)
+            DrawLine(w - x, y, w - &x, &y)
+            DrawLine(x, h - y, &x, h - &y)
+            DrawLine(w - x, h - y, w - &x, h - &y)
+            DrawLine(y, x, &y, &x)
+            DrawLine(w - y, x, w - &y, &x)
+            DrawLine(y, h - x, &y, h - &x)
+            DrawLine(w - y, h - x, w - &y, h - &x)
+            }
+         x := &x
+         y := &y
+         }
+      &lrelease: {
+         x := y := &null
+         }
+      &mpress: {
+         x1 := xd := &x
+         y1 := yd := &y
+         WAttrib("linestyle=dashed")
+         WAttrib("drawop=reverse")
+         DrawLine(x1, y1, xd, yd)		# start trace line
+         }
+      &mdrag: {
+         DrawLine(x1, y1, xd, yd)		# erase current trace line
+         xd := &x
+         yd := &y
+         DrawLine(x1, y1, xd, yd)		# draw new trace line
+         }
+      &mrelease: {
+         DrawLine(x1, y1, xd, yd)		# erase trace line
+         WAttrib("drawop=copy")
+         WAttrib("linestyle=solid")
+         x2 := &x
+         y2 := &y
+         if \restrict then {			# adjust end points
+            if ((x1 > xc) & (x2 > xc)) | ((y1 > yc) & (y2 > yc)) then next
+            if x2 > x1 then {
+               x1 :=: x2
+               y1 :=: y2
+               }
+            if x1 > xc then {
+               y1 := y2 + ((xc - x2) * (y1 - y2)) / (x1 - x2)
+               x1 := xc
+               }
+            if y2 > yc then {
+               x2 := x1 - ((x1 - x2) * (y1 - yc)) / (y1 - y2)
+               y2 := yc
+               }
+            if y1 > y2 then {
+               y1 :=: y2
+               x1 :=: x2
+               }
+            if y1 > x1 then next
+            if y2 > x2 then {
+               delta := real(x2 - x1) / (y2 - y1)
+               x2 := (x1 - y1 * delta) / (1 - delta)
+               y2 := x2
+               }
+            }
+         DrawLine(x1, y1, x2, y2)
+         DrawLine(w - x1, y1, w - x2, y2)
+         DrawLine(x1, h - y1, x2, h - y2)
+         DrawLine(w - x1, h - y1, w - x2, h - y2)
+         DrawLine(y1, x1, y2, x2)
+         DrawLine(w - y1, x1, w - y2, x2)
+         DrawLine(y1, h - x1, y2, h - x2)
+         DrawLine(w - y1, h - x1, w - y2, h - x2)
+         x := &x
+         y := &y
+         }
+      &rpress | &rdrag: {
+         every EraseArea((&x - 2) | (w - &x - 2),
+            (&y - 2) | (h - &y - 2), 5, 5)
+         every EraseArea((&y - 2) | (w - &y - 2),
+            (&x - 2) | (h - &x - 2), 5, 5)
+         }
+      }
+end
+
+procedure drawgrid(w, h, grid)
+
+   Fg(grid)
+   DrawLine(0, 0, w, h)
+   DrawLine(w, 0, 0, h)
+   DrawLine(0, h / 2, w, h / 2)
+   DrawLine(w / 2, 0, w / 2, h)
+   Fg("bleck")
+
+   return
+
+end
+
+procedure shade(w, h, pattern)
+
+   Fg(pattern)
+   WAttrib("fillstyle=textured")
+   FillPolygon(1, 0, w / 2, 1, w / 2, h / 2, 1, 0)
+   WAttrib("fillstyle=solid")
+   Fg("black")
+
+   return
+
+end
diff --git a/ipl/gprogs/symdraw.icn b/ipl/gprogs/symdraw.icn
new file mode 100644
index 0000000..ecc56a9
--- /dev/null
+++ b/ipl/gprogs/symdraw.icn
@@ -0,0 +1,338 @@
+############################################################################
+#
+#	File:     symdraw.icn
+#
+#	Subject:  Program to draw symmetrically
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 21, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Pressing the left mouse button draws a point.  Dragging with the left mouse
+#  button draws a line.  Pressing and dragging with the middle mouse
+#  shows a dashed straight line, which is drawn solid when
+#  the middle mouse button is released.  Dragging with the right mouse
+#  button erases in the vicinity of the mouse pointer.
+#
+#  There are several known bugs:
+#
+#	Erasing in restricted mode is bogus outside the generating region.
+#
+#	Perfectly vertical and horizontal straight lines are not clipped.
+#
+#	Some legal straight lines are not drawn.
+#
+#  In other words, the clipping logic is not correct.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics, interact, vsetup
+#
+############################################################################
+
+link graphics
+link interact
+link vsetup
+
+global W, H, X, Y, xc, yc, restrict, nonrestrict, gcurr, pcurr, galt, palt
+global number, xd, yd, pattern, x1, y1, x2, y2, delta, x, y, lines, Pane
+
+procedure main(args)
+   local pane, vidgets, obg
+
+   number := -1
+
+   vidgets := ui()
+
+   VSet(vidgets["lines"], 1)		# Start with lines,
+   VSet(vidgets["shade"], 1)		# shading,
+   VSet(vidgets["restrict"], 1)		# and restricted drawing enabled.
+
+   pane := vidgets["pane"]
+
+   W := pane.uw
+   H := pane.uh
+   X := pane.ux
+   Y := pane.uy
+
+   Pane := Clone("bg=white", "dx=" || X, "dy=" || Y)
+   Clip(Pane, 0, 0, W, H)
+
+   restrict := 1			# initially restricted
+   nonrestrict := &null
+
+   xc := W / 2
+   yc := H / 2
+
+   W -:= 1			# adjustment for 0-origin indexing
+   H -:= 1
+
+   gcurr := "light blue"
+   pcurr := "pink"
+   galt := "white"
+   palt := "white"
+
+   Pattern(Pane, "2,#01")	# pattern for shading generation region
+
+   obg := Bg(Pane)
+   Bg(Pane, "white")
+#  EraseArea(Pane, 0, 0, W, H)
+   EraseArea(Pane)
+   Bg(Pane, obg)
+
+   if lines := NewColor(Pane, gcurr) then {	# requires mutable colors
+      drawlines()
+      }
+
+   if pattern := NewColor(Pane, pcurr) then {	# requires mutable colors
+      shade()
+      }
+   GetEvents(vidgets["root"], shortcuts)
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "save  @S":  save()
+      "help  @H":  help()
+      "quit  @Q":  exit()
+      }
+
+   fail
+
+end				# not handled
+
+procedure pane_cb(vidget, event)	# handle drawing events
+   local obg
+
+   &x -:= X
+   &y -:= Y
+
+   case event of {
+      &lpress: {			# start free-hand drawing
+         if \restrict & ((real(&x) / (&y + 0.0001) < 1.0) | (&x > xc) |
+            (&y > yc)) then fail
+         every DrawPoint(Pane, &x | (W - &x), &y | (H - &y))
+         every DrawPoint(Pane, &y | (W - &y), &x | (H - &x))
+         x := &x
+         y := &y
+         }
+      &ldrag: {				# free-hand drawing
+         if \x then {			# just in case (for artificial events)
+            if \restrict & ((real(x) / (y + 0.0001)  < 1.0) | (x > xc) |
+               (y > yc)) then fail
+            DrawLine(Pane, x, y, &x, &y)
+            DrawLine(Pane, W - x, y, W - &x, &y)
+            DrawLine(Pane, x, H - y, &x, H - &y)
+            DrawLine(Pane, W - x, H - y, W - &x, H - &y)
+            DrawLine(Pane, y, x, &y, &x)
+            DrawLine(Pane, W - y, x, W - &y, &x)
+            DrawLine(Pane, y, H - x, &y, H - &x)
+            DrawLine(Pane, W - y, H - x, W - &y, H - &x)
+            }
+         x := &x
+         y := &y
+         }
+      &lrelease: {			# end free-hand drawing
+         x := y := &null
+         }
+      &mpress: {			# start straight line
+         x1 := xd := &x
+         y1 := yd := &y
+         WAttrib(Pane, "linestyle=dashed")
+         WAttrib(Pane, "drawop=reverse")
+         DrawLine(Pane, x1, y1, xd, yd)	# start trace line
+         }
+      &mdrag: {				# locate end of straight line
+         DrawLine(Pane, x1, y1, xd, yd)	# erase current trace
+         xd := &x
+         yd := &y
+         DrawLine(Pane, x1, y1, xd, yd)	# draw new trace line
+         }
+      &mrelease: {			# end straight line
+         DrawLine(Pane, x1, y1, xd, yd)	# erase trace line
+         WAttrib(Pane, "drawop=copy")
+         WAttrib(Pane, "linestyle=solid")
+         x2 := &x
+         y2 := &y
+
+      #  This probably can be done in a better way.  What's here "just grew"
+
+         if \restrict then {				# adjust end points
+            if ((x1 > xc) & (x2 > xc)) | ((y1 > yc) & (y2 > yc)) then fail
+            if x2 > x1 then {
+               x1 :=: x2
+               y1 :=: y2
+               }
+            if x1 > xc * x1 ~= x2 then {
+               y1 := y2 + ((xc - x2) * (y1 - y2)) / (x1 - x2)
+               x1 := xc
+               }
+            if y2 > yc & y1 ~= y2 then {
+               x2 := x1 - ((x1 - x2) * (y1 - yc)) / (y1 - y2)
+               y2 := yc
+               }
+            if y1 > y2 then {
+               y1 :=: y2
+               x1 :=: x2
+               }
+            if y1 > x1 then fail
+            if y2 > x2 & y1 ~= y2 then {
+               delta := real(x2 - x1) / (y2 - y1)
+               x2 := (x1 - y1 * delta) / (1 - delta)
+               y2 := x2
+               }
+            }
+         DrawLine(Pane, x1, y1, x2, y2)
+         DrawLine(Pane, W - x1, y1, W - x2, y2)
+         DrawLine(Pane, x1, H - y1, x2, H - y2)
+         DrawLine(Pane, W - x1, H - y1, W - x2, H - y2)
+         DrawLine(Pane, y1, x1, y2, x2)
+         DrawLine(Pane, W - y1, x1, W - y2, x2)
+         DrawLine(Pane, y1, H - x1, y2, H - x2)
+         DrawLine(Pane, W - y1, H - x1, W - y2, H - x2)
+         x := &x
+         y := &y
+         }
+
+      #  This code is not correct when pointer is outside
+      #  the generation region.
+
+      &rpress | &rdrag: {		# erase around pointer
+         obg := Bg(Pane)
+         Bg(Pane, "white")
+         every EraseArea(Pane, ((&x - 2) | (W - &x - 2)),
+            ((&y - 2) | (H - &y - 2)), 5, 5)
+         every EraseArea(Pane, ((&y - 2) | (W - &y - 2)),
+            ((&x - 2) | (H - &x - 2)), 5, 5)
+         Bg(Pane, obg)
+         }
+      }
+end
+
+procedure help()			# help (someday)
+
+   Notice("There is no help to be had")
+
+end
+
+procedure shortcuts(event)
+
+   if &meta & event := string(event) then
+      case map(event) of {			# fold case
+         "q":	exit()
+         "h":	help()
+         "s":	save()
+         }
+
+   return
+
+end
+
+procedure lines_cb()			# toggle lines
+
+   Color(Pane, \lines, gcurr :=: galt)
+
+end
+
+procedure clear_cb()			# clear drawing area
+   local obg
+
+   obg := Bg(Pane)
+   Bg(Pane, "white")
+   EraseArea(Pane, 0, 0, W, H)
+   Bg(Pane, obg)
+   if \lines then {
+      drawlines()
+      shade()
+      }
+
+end
+
+procedure drawlines()			# draw lines
+   local ofg, obg
+
+   ofg := Fg(Pane)
+   obg := Bg(Pane)
+   Fg(Pane, lines)
+   Bg(Pane, "white")
+   DrawLine(Pane, 0, 0, W, H)
+   DrawLine(Pane, W, 0, 0, H)
+   DrawLine(Pane, 0, H / 2, W, H / 2)
+   DrawLine(Pane, W / 2, 0, W / 2, H)
+   Fg(Pane, ofg)
+   Bg(Pane, obg)
+
+   return
+
+end
+
+procedure shade()			# shade generating region
+   local ofg, obg
+
+   ofg := Fg(Pane)
+   obg := Bg(Pane)
+   Fg(Pane, pattern)
+   Bg(Pane, "white")
+   WAttrib(Pane, "fillstyle=textured")
+   FillPolygon(Pane, 1, 0, W / 2, 1, W / 2, H / 2, 1, 0)
+   WAttrib(Pane, "fillstyle=solid")
+   Fg(Pane, ofg)
+   Bg(Pane, obg)
+
+   return
+
+end
+
+procedure save()			# save drawing in image file
+
+   Color(Pane, \lines, "white")
+   Color(Pane, \pattern, "white")
+   snapshot(Pane, 0, 0, W, H)
+   Color(Pane, \lines, gcurr)
+   Color(Pane, \pattern, pcurr)
+
+end
+
+procedure restrict_cb()			# toggle restriction to generating
+					# region
+   restrict :=: nonrestrict
+
+end
+
+procedure shade_cb()			# toggle shading of generating region
+
+   Color(Pane, \pattern, pcurr :=: palt)
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=523,461", "bg=pale-gray", "label=symdraw"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   ["symdraw:Sizer:::0,0,523,461:symdraw",],
+   ["clear:Button:regular::20,45,64,20:clear",clear_cb],
+   ["file:Menu:pull::33,4,36,21:File",file_cb,
+      ["save  @S","help  @H","quit  @Q"]],
+   ["line:Line:::0,30,528,30:",],
+   ["lines:Button:regular:1:20,84,64,20:lines",lines_cb],
+   ["restrict:Button:regular:1:20,165,64,20:restrict",restrict_cb],
+   ["shade:Button:regular:1:20,125,64,20:shade",shade_cb],
+   ["pane:Rect:grooved::105,45,405,405:",pane_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/sympmm.icn b/ipl/gprogs/sympmm.icn
new file mode 100644
index 0000000..e61b092
--- /dev/null
+++ b/ipl/gprogs/sympmm.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     sympmm.icn
+#
+#	Subject:  Program to produce pmm symmetry composite images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program reflects and concatenates images in the horizontal and
+#  vertical directions to produce composite images with the pmm ("prickly
+#  pear") plane symmetry.  The resulting images tile seamlessly.
+#
+#  The composite images are given the base name of the input images with
+#  "_pmm" appended.
+#
+#  Warning:  This program is slow.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, wopen, xformimg
+#
+############################################################################
+
+link basename
+link xformimg
+link wopen
+
+procedure main(args)
+   local name, base, win1, win2, win3, win4, win5
+
+   every name := !args do {
+      base := basename(name, ".gif")
+      win1 := WOpen("canvas=hidden", "image=" || name) | {
+         write(&errout, "*** cannot open ", name)
+         next
+         }
+      win2 := wreflect(win1, "v")
+      win3 := wcatenate(win1, win2, "h")
+      WClose(win1)
+      WClose(win2)
+      win4 := wreflect(win3, "h")
+      win5 := wcatenate(win3, win4, "v")
+      WClose(win3)
+      WClose(win4)
+      WriteImage(win5, base || "_pmm.gif")
+      WClose(win5)
+      }
+
+end
+
diff --git a/ipl/gprogs/testpatt.icn b/ipl/gprogs/testpatt.icn
new file mode 100644
index 0000000..8188e8c
--- /dev/null
+++ b/ipl/gprogs/testpatt.icn
@@ -0,0 +1,199 @@
+############################################################################
+#
+#	File:     testpatt.icn
+#
+#	Subject:  Program to show test patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 18, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     testpatt cycles through a set of test patterns as the return
+#  key is pressed.  Backspacing cycles in the other direction.
+#  The window can be resized at any time.  Press "q" to exit.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor
+#
+############################################################################
+
+link graphics
+link imscolor
+
+global wwidth, wheight			# window width and height
+
+$define SQUARE 60			# size of squares, in pixels
+
+
+#  main procedure
+
+procedure main(args)
+   local patlist
+
+   Window("size=1000,700", "gamma=1.0", args)
+   &error := 1
+   WAttrib("resize=on")
+   &error := 0
+
+   patlist := [checkers, grid, ghost, pinstripe, white, bars, palette]
+						# revolving list of procedures
+   
+   reset()					# reset display
+   patlist[1]()					# display initial pattern
+
+   repeat case Event() of {
+      !"\r\n":  {				# \r or \n advances pattern
+         put(patlist, get(patlist))
+         reset()
+         patlist[1]()
+         }
+      !"\b\d":  {				# \b or \d cycles backwards
+         push(patlist, pull(patlist))
+         reset()
+         patlist[1]()
+         }
+      !"qQ":					# q exits the program
+         exit()
+      &resize: {				# resize requires redrawing
+         reset()
+         patlist[1]()
+         }
+      }
+end
+
+
+#  reset() -- prepare for next test
+#
+#  The screen is cleared and the fg/bg colors are reset.
+#  Each test procedure is responsible for restoring anything else it changes.
+
+procedure reset()
+   WAttrib("fg=black", "bg=white")
+   EraseArea()
+   wwidth := WAttrib("width")
+   wheight := WAttrib("height")
+   return
+end
+
+
+#  checkers() -- a checkerboard with additional lines
+#
+#  There should be no red or green tinge to the edges of the squares.
+
+procedure checkers()
+   local x, y
+
+   WAttrib("drawop=reverse")
+   every x := 0 to wwidth by 2 * SQUARE do {
+      FillRectangle(x, 0, SQUARE, wheight)
+      DrawLine(x + SQUARE / 2, 0, x + SQUARE / 2, wheight)
+      }
+   every y := 0 to wheight by 2 * SQUARE do {
+      FillRectangle(0, y, wwidth, SQUARE)
+      DrawLine(0, y + SQUARE / 2, wwidth, y + SQUARE / 2)
+      }
+   WAttrib("drawop=copy")
+   return
+end
+
+
+#  grid() -- a grid of white lines
+
+procedure grid()
+   local x, y
+
+   FillRectangle()
+   Fg("white")
+   every x := SQUARE / 2 to wwidth by SQUARE do
+      DrawLine(x, 0, x, wheight)
+   every y := SQUARE / 2 to wheight by SQUARE do
+      DrawLine(0, y, wwidth, y)
+   return
+end
+
+
+#  ghost() -- generate ghosting pattern
+#
+#  Look for white echoes of the black vertical lines
+#  displaced about 1mm to their right.
+
+procedure ghost()
+   $define NSTEPS 12
+   local dx, x1, x2, y1, y2, i, g
+
+   dx := wwidth / NSTEPS
+   x1 := .10 * dx
+   x2 := .90 * dx
+   y1 := .95 * wheight
+   y2 := .05 * wheight
+   every i := 1 to NSTEPS do {
+      g := i * 65535 / NSTEPS
+      Bg(g || "," || g || "," || g)
+      WAttrib("dx=" || integer((i - 1) * dx))
+      EraseArea(0, 0, dx + 1, wheight)
+      DrawLine(x1, y1, x1, y2, x2, y1)#, x2, y2)
+      }
+   WAttrib("bg=white", "dx=0")
+   return
+end
+
+
+#  pinstripe() -- generate vertical pinstripe pattern
+#
+#  The moire patterns that result on a Trinitron-type CRT
+#  reveal the consistency of pixel sizing across the display.
+
+procedure pinstripe()
+   WAttrib("pattern=2,#2", "fillstyle=textured")
+   FillRectangle()
+   WAttrib("fillstyle=solid")
+   return
+end
+
+
+#  white() -- generate a white screen
+
+procedure white()
+   return
+end
+
+
+#  bars() -- generate color bars
+
+procedure bars()
+   local dx, i
+
+   dx := (wwidth + 7) / 8
+   "black blue red magenta green cyan yellow white " ?
+      every i := 0 to 7 do {
+         Fg(tab(upto(' ')))
+         move(1)
+         FillRectangle(i * dx, 0, dx, wheight)
+         }
+   return
+end
+
+
+#  palette() -- draw color palettes
+
+procedure palette()
+   local dx
+
+   dx := (wwidth + 3) / 4
+   drawpalette("c1",      0, 0, dx, wheight, "")
+   drawpalette("c1",     dx, 0, dx, wheight, "l")
+   drawpalette("c1", 2 * dx, 0, dx, wheight, "o")
+   drawpalette("c1", 3 * dx, 0, dx, wheight, "")
+   return
+end
diff --git a/ipl/gprogs/textures.icn b/ipl/gprogs/textures.icn
new file mode 100644
index 0000000..3069650
--- /dev/null
+++ b/ipl/gprogs/textures.icn
@@ -0,0 +1,86 @@
+############################################################################
+#
+#	File:     textures.icn
+#
+#	Subject:  Program to show various 4x4 patterns
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     textures illustrates many different patterns that can be
+#  created by tiling a 4x4 pixel cell.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+
+link graphics
+
+global win
+
+procedure main(args)
+   local cols, rows, xsiz, ysiz, gutter, w, h, pats, i, x, y, s
+
+   pats := [
+      "#0000 #0010 #8010 #0820 #0420 #1040",
+      "#8050 #0124 #0424 #0260 #0142 #0610 #0224 #0601 #2208",
+      "#A050 #0161 #1414 #0660 #1284 #4221 #0168 #1144 #0505 _
+             #0258 #0158 #8421 #4510 #0306",
+      "#A052 #8641 #8443 #1922 #0272 #0525 #0515 #0433 #281C",
+      "#A452 #0356 #2C34 #2A54 #1C32 #8711 #88E1 #0555 #0707 #070D #5451",
+      "#A552 #8356 #2F22 #2555 #0787 #5A1A #124F #121F #9887",
+      "#6666 #5555 #5AA5 #A5A5 #9696 #0F0F #0FF0"]
+
+   cols := 2 * *pats - 1
+   rows := 16
+   xsiz := 36
+   ysiz := 30
+   gutter := 6
+
+   w := cols * xsiz + (cols + 1) * gutter - 1
+   h := rows * ysiz + (rows + 1) * gutter - 1
+   win := open("textures", "g", "width="||w, "height="||h)
+
+   Shade(win, "gray")
+   FillRectangle(win, 0, 0, w, h)
+   Fg(win, "black")
+
+   WAttrib(win, "fillstyle=textured")
+
+   every i := 1 to *pats do {
+      y := gutter
+      x := gutter + 2 * (xsiz + gutter) * (i - 1)
+      pats[i] ? {
+         while tab(upto('#')) do {
+            s := move(5)
+            rect(x, y, xsiz, ysiz, s)
+            rect(x + xsiz + gutter, y, xsiz, ysiz,
+               map(s, "0123456789ABCDEF", "FEDCBA9876543210"))
+            y +:= ysiz + gutter
+            }
+         }
+      }
+   WDone(win)
+end
+
+procedure rect(x, y, w, h, s)
+   Pattern(win, "1,1")
+   DrawLine(win, x + w, y - 1, x + w, y + h, x - 1, y + h)
+   Pattern(win, "1,0")
+   DrawLine(win, x - 1, y + h, x - 1, y - 1, x + w, y - 1)
+   Pattern(win, "4," || s)
+   FillRectangle(win, x, y, w, h)
+end
diff --git a/ipl/gprogs/tgdemo.icn b/ipl/gprogs/tgdemo.icn
new file mode 100644
index 0000000..d6c66fb
--- /dev/null
+++ b/ipl/gprogs/tgdemo.icn
@@ -0,0 +1,263 @@
+############################################################################
+#
+#	File:     tgdemo.icn
+#
+#	Subject:  Program to demonstrate turtle graphics
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     tgdemo displays various random designs in a window using the
+#  turtle graphics library procedures.  Click in the window, or
+#  enter a character on the keyboard, to start a new design.
+#
+#     The following keyboard characters have meaning:
+#
+#	w or W:			random walk
+#	b or B:			fractal bush (looks like "desert broom")
+#	s or S:			spiral design
+#	p or P:			polygon design
+#	t or T:			rectangular tiling
+#	r or R:			radial tiling
+#
+#	\n, \r, \t, or SP:	choose design randomly
+#	q or Q:			exit program
+#
+#	0:			pause drawing
+#	1, ... 9:		set speed of drawing (9 is fastest)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, turtle, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link turtle
+link random
+link graphics
+
+global msec	# delay between drawing actions
+global event	# interrupting event, if any
+
+procedure main(args)
+   local opts, dlist, p, e
+
+   opts := options(args, winoptions())
+   /opts["W"] := /opts["H"] := 500
+   &window := optwindow(opts)
+
+   randomize()
+   dlist := [walk, bush, poly, spiral, tile, radial]
+   msec := 0
+   event := "\r"
+   repeat {
+      e := \event | Event()
+      event := &null
+      case e of {
+         QuitEvents():				break
+         "\n" | "\r" | "\t" | " ":		run(?dlist)
+         &lrelease | &mrelease | &rrelease:	run(?dlist)
+         "b" | "B":				run(bush)
+         "w" | "W":				run(walk)
+         "s" | "S":				run(spiral)
+         "p" | "P":				run(poly)
+         "t" | "T":				run(tile)
+         "r" | "R":				run(radial)
+         "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9": setdelay(e)
+         }
+      }
+end
+
+#  run(p) -- execute procedure p after resetting screen environment
+
+procedure run(p)
+   TReset()
+   return p()
+end
+
+#  continue() -- delay and check for interrupts
+#
+#  Every demo should call this periodically and should exit if it fails.
+#  The global "event" is set to the interrupting event and can be checked
+#  to exit from recursive calls.
+
+procedure continue()
+   local evlist
+
+   event := &null
+   delay(msec)
+   if *Pending() = 0 then
+      return
+   event := Event()
+   if setdelay(event) then {
+      event := &null
+      return
+      }
+   else
+      fail
+end
+
+#  setdelay(e) -- handle delay-setting event, or fail
+
+procedure setdelay(e)
+   while e === "0" do		# 0 is pause -- wait until anything else input
+      e := Event()
+   if type(e) == "string" & *e = 1 & (e ? any(&digits)) then {
+      if e === "9" then
+         msec := 0
+      else
+         msec := ishift(1, 12 - e)
+      return
+      }
+   else
+      fail
+end
+
+
+#################### drawing routines ####################
+
+
+procedure walk()				# random walk
+   local stepsize, maxturn, bias
+
+   maxturn := 30
+   bias := 1
+   while continue() do
+      every 1 to 10 do {
+         TDraw(1)
+         TRight(?maxturn - maxturn/2.0 + bias)
+         }
+end
+
+
+procedure bush(n, len)				# fractal bush
+   local maxturn
+
+   if /n then {
+      TSkip(-150)
+      n := 4 + ?4
+      len := 400 / n
+      }
+   maxturn := 60
+   TSave()
+   TRight(?maxturn - maxturn / 2.0)
+   TDraw(?len)
+   if n > 0 & /event then {
+      continue()
+      every 1 to ?4 do
+         bush(n - 1, len)
+      }
+   TRestore()
+end
+
+
+procedure poly()				# regular nonconvex polygon
+   local angle, side, x0, y0
+   angle := 60 + ?119
+   side := 200 - 100 * cos(dtor(angle))
+   x0 := WAttrib("width") / 2 - side / 2
+   y0 := WAttrib("height") / 2 - side / 3
+   TGoto(x0, y0, 0)
+   while continue() do {
+      TDraw(side)
+      TRight(angle)
+      if abs(TX() - x0) + abs(TY() - y0) < 1 then break
+      }
+end
+
+
+procedure spiral()				# polygon spiral
+   local angle, side, incr
+   angle := 30 + ?149
+   incr := sqrt(4 * ?0) + 0.3
+   side := 0
+   while side < 1000 & continue() do {
+      TDraw(side +:= incr)
+      TRight(angle)
+      }
+end
+
+
+procedure tile()
+   local i, j, n, x0, y0, x, y, dx, dy, f
+
+   n := 5
+   x0 := WAttrib("width") / 2
+   y0 := WAttrib("height") / 2
+   dx := x0 / n
+   dy := y0 / n
+   f := mkfig(?10)
+   x := dx / 2
+   TScale(dx + dy)
+   every i := 1 to n do {
+      y := dy / 2
+      every j := 1 to n do {
+         THeading(45)
+         TGoto(x0 + x, y0 + y);  every 1 to 4 do { putfig(f); TRight(90) }
+         TGoto(x0 + x, y0 - y);  every 1 to 4 do { putfig(f); TRight(90) }
+         TGoto(x0 - x, y0 + y);  every 1 to 4 do { putfig(f); TRight(90) }
+         TGoto(x0 - x, y0 - y);  every 1 to 4 do { putfig(f); TRight(90) }
+         y +:= dy
+         if not continue() then
+            return
+         }
+      x +:= dx
+      }
+end
+
+
+procedure radial()
+   local f, i, j, nrings, rwidth, fwd, circ, nfig, da
+
+   f := mkfig(?8)
+   nrings := 5
+   rwidth := WAttrib("width") / (2 * nrings)
+   TScale(rwidth)
+   every i := 1 to nrings do {
+      circ := &pi * 2 * i * rwidth
+      nfig := integer(circ / 50)
+      nfig := nfig / 2 + ?nfig
+      da := 360.0 / nfig
+      every j := 0 to nfig-1 do {
+         TGoto(, , 90 - j * da)
+         TSkip(i - 0.9)
+         putfig(f)
+         if not continue() then
+            return
+         }
+      }
+end
+
+
+procedure mkfig(nseg)
+   local f
+   f := []
+   every 1 to nseg do {
+      put(f, ?0 / nseg)		# draw
+      put(f, -90 + 180 * ?0)	# turn
+      }
+   return f
+end
+
+procedure putfig(f)
+   local i
+   TSave()
+   every i := 1 to *f by 2 do {
+      TDraw(f[i])
+      TRight(f[i+1])
+      }
+   TRestore()
+end
diff --git a/ipl/gprogs/tilescan.icn b/ipl/gprogs/tilescan.icn
new file mode 100644
index 0000000..395d000
--- /dev/null
+++ b/ipl/gprogs/tilescan.icn
@@ -0,0 +1,649 @@
+############################################################################
+#
+#	File:     tilescan.icn
+#
+#	Subject:  Program to select tile from an image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 14, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program is designed to assist in locating areas within an image
+#  that, when tiled, produce a desired effect.  For example, a background
+#  may consist of a tiled image; this program can be used to find the
+#  smallest tile for the repeat (by "eye-balling").  It's worth noting
+#  that interesting images can be found for other settings.  For example,
+#  another interesting use of this program is to produce striped patterns by
+#  selecting a row or column of an image to get a tile that is one character
+#  wide.  Sometimes a few rows or columns give an interesting "fabric"
+#  effect.
+#
+#  There are three windows:
+#
+#	the VIB control window
+#	the source image window
+#	a repeat window, which shows the selection from the source
+#	  image, tiled.
+#
+#  The selection from the source image is shown as a marquee in the
+#  source image window.  When a source image is loaded, the marquee starts
+#  with the entire image.  The marquee can be changed by buttons and
+#  arrow-key events on the control window (not the source image window).
+#
+#  The arrow keys have two modes.  With no modifier, they nudge the
+#  location of the marquee.  With the meta-key modifier, they nudge
+#  the dimensions of the marquee.
+#
+#  The reset button resets the marquee to the entire image.
+#
+#  The current selection can be mirrored using the mirror button.
+#
+#  The following features are provided through keyboard shortcuts,
+#  the File menu, and in some cases, on-board buttons:
+#
+#	@M	mirror selection
+#	@M	mirror selection
+#	@O	open new source image
+#	@P	pick a source image from GIF files in the current directory
+#	@Q	quit application
+#	@S	save current selection as an image
+#
+#  The repeat window can be resized by the user, but it is not redrawn
+#  until the marque is changed or the refresh button is pushed.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX (for "pick" feature)
+#
+############################################################################
+#
+#  Links:   grecords, interact, mirror, tile
+#
+############################################################################
+#
+#  Includes:  keysyms.icn
+#
+############################################################################
+
+link grecords
+link interact
+link mirror
+link tile
+
+$include "keysyms.icn"
+
+#  Globals related to windows:
+
+global controls		# VIB control window
+global pattern		# repeat window
+global screen		# source image window visible
+global source		# source image window hidden
+global symmetry		# mirroring window
+
+global posx		# x position relative to interface window
+global posy		# y position relative to repeat window
+
+global sx		# marquee location information
+global sy
+
+#  Globals related to the selection:
+
+global current		# current selection record
+global hmax		# maximum height of source image
+global wmax		# maximum width of source image
+global previous		# previous selection record
+
+global vidgets		# table of interface vidgets
+
+procedure main()
+   local atts, x1, y1
+
+   atts := ui_atts()
+   put(atts,  "posx=10", "posy=10")
+
+   controls := (WOpen ! atts) | ExitNotice("Cannot open control window.")
+
+   vidgets := ui()
+
+   init()
+
+   repeat {
+      while *Pending(controls) > 0 do
+         ProcessEvent(vidgets["root"], , shortcuts)
+      while *Pending(\screen) > 0 do
+         if Event(screen) === &lpress then draw_marquee()
+      }
+
+end
+
+#  Callback that handles all the buttons that change x, y, w, and h.
+
+procedure dimens_cb(vidget, value)
+
+   if /source then fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value of {
+      "w max":  current.w := (wmax - current.x)
+      "h max":  current.h := (hmax - current.y)
+      "w = 1":  current.w := 1
+      "h = 1":  current.h := 1
+      "full":   {
+         current.h := hmax
+         current.w := wmax
+         current.x := 0
+         current.y := 0
+         }
+      "w / 2":    check(current.w <- current.w / 2)
+      "h / 2":    check(current.h <- current.h / 2)
+      "w * 2":    check(current.w <- current.w * 2)
+      "h * 2":    check(current.h <- current.h * 2)
+      } | fail
+
+   show()
+
+   return
+
+end
+
+procedure draw_marquee()
+   local x1, y1
+
+   current.x := &x
+   current.y := &y
+   current.h := current.w := 0
+
+   update()
+
+   repeat {
+      case Event(screen) of {
+         &ldrag:  update_marquee()
+         &lrelease:  {
+            update_marquee()
+            Raise(controls)
+            return
+            }
+         }
+      }
+
+end
+
+procedure update_marquee()
+
+   if &x < 0 then &x := 0
+   if &y < 0 then &y := 0
+   if &x > wmax then &x := wmax
+   if &y > hmax then &y := hmax
+   current.w := &x - current.x
+   current.h := &y - current.y
+
+   show()
+
+   return
+
+end
+
+procedure location_cb(vidget, value)
+
+   if /source then fail
+
+   # Cute code alert:  The selected reversible assignment is performed
+   # and passed to check().  It checks the resulting selection rectangle
+   # and fails if it's not valid.  That failure causes the reversible
+   # assignment to be undone and the expression fails, leaving the
+   # selection as it was.
+
+   case value of {
+      "nw":     current.x := current.y := 0
+      "ne":     {
+          current.x := wmax - current.w
+          current.y := 0
+          }
+      "se":     {
+          current.x := wmax - current.w
+          current.y := hmax - current.h
+          }
+      "sw":     {
+          current.x := 0
+          current.y := hmax - current.h
+          }
+      "x max":  current.x := wmax - current.w
+      "y max":  current.y := hmax - current.h
+      "center": {
+         current.x := (wmax - current.w) / 2
+         current.y := (hmax - current.h) / 2
+         }
+      "home":   {
+         current.x := 0
+         current.y := 0
+         }
+      "x / 2":    current.x <- current.x / 2
+      "y / 2":    current.y <- current.y / 2
+      "x * 2":    check(current.x <- current.x * 2)
+      "y * 2":    check(current.y <- current.y * 2)
+         } | fail
+   show()
+
+   return
+
+end
+
+#  Check validity of selection.
+
+procedure check()
+
+   if
+      (0 <= current.w <= (wmax - current.x)) &
+      (0 <= current.h <= (hmax - current.y)) &
+      (0 <= current.x <= hmax) &
+      (0 <= current.y <= wmax)
+   then return else {
+      Alert()
+      fail
+      }
+
+end
+
+#  Copy hidden source window to a visible window.
+
+procedure copy_source(label)
+
+   screen := WOpen(
+      "size=" || WAttrib(source, "width") || "," || WAttrib(source, "height"),
+      "posx=" || posx,
+      "posy=" || posy,
+      "label=" || label,
+      "drawop=reverse",
+      "linestyle=onoff"
+      ) | ExitNotice("Cannot open image window.")
+
+   CopyArea(source, screen)
+
+   Raise(controls)
+
+   wmax := WAttrib(source, "width")
+   hmax := WAttrib(source, "height")
+
+   WAttrib(pattern, "width=" || (WAttrib(screen, "width")))
+   WAttrib(pattern, "height=" || (WAttrib(screen, "height")))
+   EraseArea(pattern)
+
+   current := rect(0, 0, wmax, hmax)
+
+   show()
+
+   return
+
+end
+
+#  File menu callback.
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "open  @O":        get_image()
+      "pick  @P":        pick()
+      "quit  @Q":        exit()
+      "save  @S":        save_cb()
+      "save mirrored":   mirror_snap()
+      }
+
+   return
+
+end
+
+#  Utility procedure to get new source image.
+
+procedure get_image()
+
+   WClose(\source)
+   WClose(\screen)
+   WClose(\symmetry)
+   EraseArea(pattern)
+
+   repeat {
+      (OpenDialog("Open image:") == "Okay") | fail
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Can't open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      wmax := WAttrib(source, "width")
+      hmax := WAttrib(source, "height")
+      break
+      }
+
+   return
+
+end
+
+#  These values are for Motif; they may need to be changed for other
+#  window managers.
+
+$define Offset1	32
+$define Offset2	82
+
+#  Initialize the program.
+
+procedure init()
+   local iheight
+
+   posx := WAttrib(controls, "width") + Offset1
+
+   iheight := WAttrib(controls, "height")
+
+   pattern := WOpen("label=repeat", "resize=on", "size=" || iheight ||
+      "," || iheight, "posx=" || posx, "posy=10") |
+         ExitNotice("Cannot open pattern window.")
+
+   posy := WAttrib(pattern, "height") + Offset2
+
+   sx := vidgets["text"].ax
+   sy := vidgets["text"].ay
+
+   Raise(controls)
+
+   return
+
+end
+
+procedure update()
+
+   #  Update selection information on interface.
+
+   WAttrib(controls, "drawop=reverse")
+
+   DrawString(controls, sx, sy, "marquee:  x=" || (\previous).x  || "  y=" ||
+      previous.y || "  w=" || previous.w || "  h=" || previous.h)
+   DrawString(controls, sx, sy, "marquee:  x=" || current.x  || "  y=" ||
+      current.y || "  w=" || current.w || "  h=" || current.h)
+
+   WAttrib(controls, "drawop=copy")
+
+   #  Update the selection rectangle.
+
+   DrawRectangle(screen, (\previous).x, previous.y, previous.w, previous.h)
+   DrawRectangle(screen, current.x, current.y, current.w, current.h)
+
+   previous := copy(current)
+
+   return
+
+end
+
+procedure mirror_cb()
+
+   if /source then {
+      Notice("No source window.")
+      fail
+      }
+
+   if current.w < 0 then {
+      current.w := -current.w
+      current.x -:= current.w
+      }
+
+   if current.h < 0 then {
+      current.h := -current.h
+      current.y -:= current.h
+      }
+
+   WClose(\symmetry)
+
+   symmetry := mirror(source, current.x, current.y, current.w, current.h) | {
+      Notice("Cannot mirror tile.")
+      fail
+      }
+
+   #  In case the window manager opens a window larger than requested ...
+
+   tile(symmetry, pattern, 0, 0, current.w * 2, current.h * 2)
+
+   #  Hide it but keep it in case the user wants to save it.
+
+   WAttrib(symmetry, "canvas=hidden")
+
+   Raise(controls)
+
+   return
+
+end
+
+procedure mirror_snap()
+
+   snapshot(\symmetry, 0, 0, current.w * 2, current.h * 2) | {
+      Notice("No mirrored tile.")
+      fail
+      }
+
+   return
+
+end
+
+#  Utility procedure to let user pick an image file in the current directory.
+
+procedure pick()
+   local plist, ls
+
+   plist := filelist("*.gif *.GIF") | {
+      Notice("Pick not supported on this platform.")
+      fail
+      }
+
+   if *plist = 0 then {
+      Notice("No files found.")
+      fail
+      }
+
+   repeat {
+      if SelectDialog("Select image file:", plist, plist[1]) == "Cancel"
+         then fail
+      WClose(\source)
+      WClose(\screen)
+      WClose(\symmetry)
+      EraseArea(pattern)
+      source := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open " || dialog_value || ".")
+         next
+         }
+      copy_source(dialog_value)
+      break
+      }
+
+   return
+   
+end
+   
+#  Callback to terminate program execution.
+
+procedure quit_cb()
+
+   exit()
+
+end
+
+procedure refresh_cb()
+
+   tile(source, pattern, current.x, current.y, current.w, current.h)
+
+   return
+
+end
+
+#  Callback procedure to allow use of standard tile sizes.
+
+procedure select_cb(vidget, value)
+
+   if /source then fail
+
+   check(current.w <- current.h <-
+      case value of {
+         "     4 x 4":    4
+         "     8 x 8":    8
+         "   16 x 16":   16
+         "   32 x 32":   32
+         "   64 x 64":   64
+         "   72 x 72":   72
+         "   96 x 96":   96
+         " 100 x 100":  100
+         " 128 x 128":  128
+         " 200 x 200":  200
+         " 256 x 256":  256
+         " 400 x 400":  400
+         " 512 x 512":  512
+         }) | fail
+
+   show()
+
+   return
+
+end
+
+#  Callback to allow setting of specific selection rectangle values.
+
+procedure set_cb()
+
+   repeat {
+      if TextDialog("Set values:",
+         ["x", "y", "w", "h"],
+         [current.x, current.y, current.w, current.h ]
+         ) == "Cancel" then fail
+      check(
+         current.x <- integer(dialog_value[1]) &
+         current.y <- integer(dialog_value[2]) &
+         current.w <- integer(dialog_value[3]) &
+         current.h <- integer(dialog_value[4])
+         ) | {
+            Notice("Invalid value.")
+            next
+            }
+      show()
+      return
+      }
+
+end
+
+#  Keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   case type(e) of {
+      "string": {
+         if &meta then case map(e) of {			# fold case
+            "m":   mirror_cb()
+            "o":   get_image()
+            "p":   pick()
+            "q":   exit()
+            "s":   save_cb()
+            }
+         }
+      "integer": {
+         if &meta then {	# nudge dimensions
+            if check(
+               case e of {
+                  Key_Left:  current.w <- current.w - 1
+                  Key_Right: current.w <- current.w + 1
+                  Key_Up:    current.h <- current.h - 1
+                  Key_Down:  current.h <- current.h + 1
+                  }
+               ) then show() else fail
+            }
+         else {			# nudge location
+            if check (
+               case e of {
+                  Key_Left:  current.x <- current.x - 1
+                  Key_Right: current.x <- current.x + 1
+                  Key_Up:    current.y <- current.y - 1
+                  Key_Down:  current.y <- current.y + 1
+                  }
+               ) then show() else fail
+            }
+         }
+      }
+
+   return
+
+end
+
+#  Procedure to handle all that goes with a new selection.
+
+procedure show()
+   local x, y, w, h
+
+   if /source then {
+      Notice("No source image.")
+      fail
+      }
+
+   x := current.x
+   y := current.y
+   w := current.w
+   h := current.h
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   tile(source, pattern, x, y, w, h)
+
+   update()
+
+   return
+
+end
+
+#  Utility procedure to save current selection.
+
+procedure save_cb()
+
+   return snapshot(\source, current.x, current.y, current.w, current.h) | {
+     Notice("No source image.")
+     fail
+     }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=445,373", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,445,373:",],
+   ["dim:Label:::209,34,70,13:dimensions",],
+   ["dimens:Choice::9:214,55,64,189:",dimens_cb,
+      ["home","w max","h max","w * 2","h * 2",
+      "w / 2","h / 2","w = 1","h = 1"]],
+   ["file:Menu:pull::0,1,36,21:File",file_cb,
+      ["open  @O","pick  @P","save  @S    ","save mirrored","quit  @Q"]],
+   ["line1:Line:::0,22,326,22:",],
+   ["loc:Label:::120,34,56,13:location",],
+   ["location:Choice::11:113,55,71,231:",location_cb,
+      ["nw","ne","se","sw","center",
+      "x max","y max","x * 2","y * 2","x / 2",
+      "y / 2"]],
+   ["mirror:Button:regular::17,126,58,20:mirror",mirror_cb],
+   ["refresh:Button:regular::17,88,58,20:refresh",refresh_cb],
+   ["select:Choice::13:309,55,99,273:",select_cb,
+      ["     4 x 4","     8 x 8","   16 x 16","   32 x 32","   64 x 64",
+      "   72 x 72","   96 x 96"," 100 x 100"," 128 x 128"," 200 x 200",
+      " 256 x 256"," 400 x 400"," 512 x 512"]],
+   ["set:Button:regular::17,51,58,20:set",set_cb],
+   ["size:Label:::341,34,28,13:size",],
+   ["text:Button:regularno::17,347,10,20:",],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/travels.icn b/ipl/gprogs/travels.icn
new file mode 100644
index 0000000..e268405
--- /dev/null
+++ b/ipl/gprogs/travels.icn
@@ -0,0 +1,1121 @@
+############################################################################
+#
+#	File:     travels.icn
+#
+#	Subject:  Program to animate the traveling salesman problem
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     September 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  travels [window options] [-q] [npoints]
+#
+#     -q	(quiet) suppresses commentary normally written to stdout
+#
+#     npoints	seeds the field with that many initial cities
+#		and sets the count for the "reseed" button
+#
+#
+#     travels illustrates several heuristic algorithms for obtaining
+#  approximate solutions to the traveling salesman problem.  Cities may
+#  be seeded randomly or entered with the mouse.  Speed may be controlled
+#  using a slider.  The CPU time, number of cities, and path length are
+#  displayed on a status line and written to standard output after every
+#  major action.
+#
+############################################################################
+#
+#     Several types of controls are provided.  New cities may be added
+#  at any time, invalidating any current path.  At least two cities must
+#  be seeded before a path can be constructed.  A path must be constructed
+#  before any of the optimization algorithms can be applied.
+#
+#     For a description on of the algorithms used, see:
+#        David S. Johnson
+#	 Local Optimization and the Traveling Salesman Problem
+#        Proc. 17th Colloquium on Automata, Languages, & Programming
+#        Springer-Verlag (1990), pp. 446-461
+#
+#
+#  Mouse Actions:
+#
+#     Clicking the left mouse button adds a new point.
+#
+#
+#  Keyboard Actions:
+#
+#     The digit 0 clears all points.
+#     The digits 1 through 9 seed 1 to 81 (n ^ 2) new points.
+#
+#     Each of the pushbuttons below also has a keyboard equivalent
+#     which is indicated on the pushbutton.
+#
+#
+#  Pushbuttons:
+#
+#    Removing and adding points:
+#       Clear	   Remove all points
+#       Reseed	   Add n random points (a command option, default 20)
+#
+#    Path construction:
+#       Initial	   Connect points in order of initialization
+#       Random	   Random path
+#	Strip	   Strip-wise construction
+#       NearNbr	   Nearest-neighbor algorithm
+#	NearIns	   Nearest-insertion algorithm
+#	FarIns	   Farthest-insertion algorithm
+#       Greedy	   Greedy algorithm
+#
+#    Optimizations:
+#       2-Adj	   Swap pairs of adjacent points
+#	Uncross    Swap pairs of intersecting segments
+#       2-Opt	   Swap all segment pairs that shorten the path
+#
+#    Control:
+#       List	   List coordinates of points on standard output
+#       Refresh	   Redraw the screen
+#       Quit	   Exit the program
+#
+#
+#  Delay Slider:
+#
+#     The delay slider can be used to slow down the action.  It specifies a
+#  number of milliseconds to pause before visiting a new point or drawing
+#  a new path segment.  Its response is nonlinear in order to allow finer
+#  control of short delays.  Delays are inexact due to system granularity
+#  and other problems.
+#
+#     Unfortunately, the delay slider can only be changed between actions,
+#  not during construction or optimization.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, button, slider, evmux, random, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link button
+link slider
+link evmux
+link random
+link graphics
+
+$define EColor "dark blue"	# emphasis color
+
+
+
+global ptlist		# list of point records (permanent id order, not route)
+record point(
+   id,			#    permanent id
+   x, y,		#    location
+   nxt, prv,		#    forward and backward links for route
+   t1, t2)		#    scratch cells for traversal algorithms
+
+
+
+global distlist		# list of distance recs (linearized triangular matrix)
+global distsrt		# sorted distance list  (created when needed)
+record dstrec(
+   d,			#    distance between two points (x1000, stored as int)
+   p, q)		#    the two points
+
+
+
+global newpts			# non-null if points are new since last report
+
+global havepath			# non-null if we have a valid path
+				# (start from any point and follow links)
+
+global lastclk			# value of &time before last computation
+global delaytime		# delay time between steps, in msec
+
+global opts			# command line options
+global nseed			# number of points to seed
+
+global win			# main window
+global fgwin			# binding for drawing in foreground color
+global emwin			# binding for drawing in emphasis color
+global bgwin			# binding for erasing in background color
+
+global m, w, h, bw, bh, fh	# screen layout parameters
+global ax, ay, aw, ah		# corners and size of arena
+
+
+
+
+#########################  main program  #########################
+
+
+
+procedure main(args)
+   local base, pt, sg, hl
+
+   # get options and open a window
+   opts := options(args, "qE:" || winoptions())		# get options
+
+   /opts["W"] := 700					# default width
+   /opts["H"] := 500					# default height
+   /opts["E"] := EColor					# default emphasis
+   /opts["T"] := "sans,bold,12"				# default font
+   /opts["M"] := -1					# use standard margin
+   win := optwindow(opts, "linewidth=2")	# open window
+   m := opts["M"]					# save specified margin
+   h := opts["H"]					# save usable height
+   w := opts["W"]					# save usable width
+
+   bw := 100						# button width
+   bh := 18						# button height
+   fh := 20						# footer height
+
+   ax := m + bw + m					# arena bounds and size
+   ay := m
+   aw := w - bw - m
+   ah := h - fh - m
+
+   fgwin := Clone(win)
+   emwin := Clone(win, "fg=" || (opts["E"] | EColor | "black"), "linewidth=4")
+   bgwin := Clone(win, "fg=" || Bg(win), "linewidth=4")
+
+   # set up sensor for adding points
+   sensor(win, &lrelease, addpt, &null, ax, ay, aw, ah)
+
+   # set up buttons
+   buttonrow(win, m, m, bw, bh, 0, bh + (2 > m | 2),
+      "seeding", &null, &null,
+      "Clear    0", argless, clrpts,
+      "Reseed   D", argless, reseed,
+      &null,        &null, &null,			# spacing
+      "construction", &null, &null,
+      "Initial  I", argless, initpath,
+      "Random   R", argless, randpath,
+      "Strip    S", argless, strippath,
+      "NearNbr  B", argless, nearnbr,
+      "NearIns  N", argless, nearins,
+      "FarIns   F", argless, farins,
+      "Greedy   G", argless, greedypath,
+      &null,        &null, &null,
+      "optimization", &null, &null,
+      "2-Adj    A", argless, twoadj,
+      "Uncross  U", argless, uncross,
+      "2-Opt    T", argless, twoopt,
+      &null,        &null, &null,
+      "control",    &null, &null,
+      "Refresh  H", argless, refresh,
+      "List     L", argless, listpath,
+      &null,        &null, &null,
+      "Quit     Q", argless, exit,
+      )
+
+   # set up corresponding keyboard handlers
+   quitsensor(win)			# q and Q
+   sensor(win, 'Ii', argless, initpath)
+   sensor(win, 'Rr', argless, randpath)
+   sensor(win, 'Ss', argless, strippath)
+   sensor(win, 'Bb', argless, nearnbr)
+   sensor(win, 'Nn', argless, nearins)
+   sensor(win, 'Ff', argless, farins)
+   sensor(win, 'Gg', argless, greedypath)
+   sensor(win, 'Aa', argless, twoadj)
+   sensor(win, 'Uu', argless, uncross)
+   sensor(win, 'Tt', argless, twoopt)
+   sensor(win, 'Ll', argless, listpath)
+   sensor(win, 'Dd', argless, reseed)
+   sensor(win, 'Hh', argless, refresh)
+   sensor(win, '0', argless, clrpts)
+   sensor(win, '123456789', reseed)
+
+   # set up speed slider
+   slider(win, setdly, 0, m, m + h - bh, bw, bh, 0, 0, 1)
+   setdly(win, 0, 0)
+
+   # initialize
+   randomize()
+   clrpts()
+   lastclk := &time
+
+   if nseed := integer(args[1]) then
+      reseed()
+   else
+      nseed := 20
+
+   # process events
+   evmux(win)
+end
+
+
+
+#  setdly(win, arg, value) -- set delay time
+
+procedure setdly(win, arg, value)
+   local s, l
+
+   value := integer(10001 ^ value + 0.5) - 1
+   delaytime := value
+   s := "  delay " || value || "  "
+   l := TextWidth(win, s)
+   GotoXY(win, m + (bw - l) / 2, m + h - bh - m / 2)
+   writes(win, s)
+   return
+end
+
+
+
+#  pause() -- delay according to the current setting
+
+procedure pause()
+   if delaytime > 0 then
+      WDelay(win, delaytime)
+   return
+end
+
+
+
+#########################  path constructions  #########################
+
+
+
+#  initpath() -- connect in initial placement order
+
+procedure initpath()
+   local i
+
+   bgnpath(0, "placement order...") | fail
+   ptlist[1].nxt := &null
+   every i := 2 to *ptlist do {
+      follow(ptlist[i-1], ptlist[i])
+      pause()
+      }
+   ptlist[-1].nxt := ptlist[1]
+   ptlist[1].prv := ptlist[-1]
+   drawpath(fgwin, ptlist[-1], ptlist[1])
+
+   havepath := 1
+   report("initial path")
+   return
+end
+
+
+
+#  randpath() -- make random connections
+
+procedure randpath()
+   local l, i, p, q
+
+   bgnpath(0, "connecting randomly...") | fail
+
+   l := copy(ptlist)			# get copy of point list
+   every i := 1 to *l do		# shuffle it
+      l[i] :=: l[?i]
+
+   p := l[1]
+   q := l[-1]
+   p.nxt := &null
+   every i := 2 to *l do {
+      follow(l[i-1], l[i])
+      pause()
+      }
+   p.prv := q
+   q.nxt := p
+   drawpath(fgwin, q, p)
+
+   havepath := 1
+   report("random path")
+   return
+end
+
+
+
+#  strippath() -- construct using strips
+
+procedure strippath()
+   local i, l, n, p, q, r
+
+   if *ptlist < 3 then
+      return
+   bgnpath(0, "stripwise algorithm")
+
+   n := integer(sqrt(*ptlist) + .5)
+   l := list(n)
+   every !l := list()
+
+   every p := !ptlist do {
+      i := integer(1 + n * (p.x - ax) / real(aw + 1))
+      put(l[i], p)
+      }
+
+   every i := 1 to n do
+      l[i] := sortf(l[i], 3)
+   every i := 2 to n by 2 do {
+      r := []
+      every push(r, !l[i])
+      l[i] := r
+      }
+
+   q := !!l			# get first point from first non-empty bin
+   every p := !!l do {
+      q.nxt := p
+      p.prv := q
+      drawpath(fgwin, q, p)
+      q := p
+      pause()
+      }
+   q := !!l
+   p.nxt := q
+   q.prv := p
+   drawpath(fgwin, p, q)
+
+   havepath := 1
+   report("stripwise algorithm")
+   return
+end
+
+
+
+#  nearnbr() -- nearest neighbor
+
+procedure nearnbr()
+   local f, p, q, s, d
+
+   bgnpath(1, "nearest neighbor...") | fail
+
+   f := p := ?ptlist
+   p.nxt := p.prv := &null
+   s := set([p])
+   while *s < *ptlist do {
+      every d := !distsrt do {
+         if d.p === p then
+            q := d.q
+         else if d.q === p then
+            q := d.p
+         else
+            next
+         if member(s, q) then
+            next
+         insert(s, q)
+         p := follow(p, q)
+         p.nxt := &null
+         pause()
+         break
+         }
+      }
+   p.nxt := f
+   f.prv := p
+   drawpath(fgwin, p, f)
+
+   havepath := 1
+   report("nearest neighbor")
+   return
+end
+
+
+
+#  nearins() -- make path using nearest-insertion algorithm
+
+procedure nearins()
+   local d, p, q, t, todo, mind
+
+   bgnpath(0, "nearest insertion...") | fail
+
+   # init path with the two closest points
+   mind := 1000000000
+   every d := !distlist do
+      if mind >:= d.d then {
+         p := d.p
+         q := d.q
+         }
+   p.nxt := p.prv := q
+   q.nxt := q.prv := p
+   drawpath(fgwin, p, q)
+   pause()
+
+   todo := set(ptlist)		# set of points not yet on path
+   every delete(todo, p | q)
+
+   every t := !todo do
+      t.t1 := dist(t, q)	# point.t1 = distance to nearest point on path
+
+   while *todo > 0 do {		# repeat for each new point added to path
+      mind := 1000000000	# mind = minimum distance this pass
+      every t := !todo do {
+         t.t1 >:= dist(t, p)	# update pt's dist to path if latest pt closer
+         if mind >:= t.t1 then	# check for better (smaller) min d this pass
+            q := t		# if nearest so far
+         }
+      # point q is the remaining point nearest from any point on the path
+      joinpath(p, q)
+      delete(todo, q)
+      pause()
+      p := q
+      }
+
+   havepath := 1
+   redraw()
+   report("nearest insertion")
+   return
+end
+
+
+
+#  farins() -- make path using farthest-insertion algorithm
+
+procedure farins()
+   local d, p, q, t, todo, maxd
+
+   bgnpath(0, "farthest insertion...") | fail
+
+   # init path with the two most distant points
+   maxd := -1
+   every d := !distlist do
+      if maxd <:= d.d then {
+         p := d.p
+         q := d.q
+         }
+   p.nxt := p.prv := q
+   q.nxt := q.prv := p
+   drawpath(fgwin, p, q)
+   pause()
+
+   todo := set(ptlist)		# set of points not yet on path
+   every delete(todo, p | q)
+
+   every t := !todo do
+      t.t1 := dist(t, q)	# point.t1 = distance to nearest point on path
+
+   while *todo > 0 do {		# repeat for each new point added to path
+      maxd := -1		# maxd = furthest distance this pass
+      every t := !todo do {
+         t.t1 >:= dist(t, p)	# update pt's dist to path if latest pt closer
+         if maxd <:= t.t1 then	# check for better (larger) maxd this pass
+            q := t		# if farthest so far
+         }
+      # point q is the remaining point farthest from any point on the path
+      joinpath(p, q)
+      delete(todo, q)
+      pause()
+      p := q
+      }
+
+   havepath := 1
+   redraw()
+   report("farthest insertion")
+   return
+end
+
+
+
+#  joinpath(p, q) -- add q at best place in path beginning at p
+
+procedure joinpath(p, q)
+   local start, best, d
+
+   d := dist(p, q) + dist(q, p.nxt) - dist(p, p.nxt)
+   start := best := p
+   while (p := p.nxt) ~=== start do
+      if d >:= dist(p, q) + dist(q, p.nxt) - dist(p, p.nxt) then
+         best := p
+
+   follow(best, q)
+   return
+end
+
+
+
+#  greedypath() -- make path using greedy algorithm
+
+procedure greedypath()
+   local p, q, d, g, need
+
+   bgnpath(1, "greedy algorithm...") | fail
+
+   every p := !ptlist do {
+      p.nxt := p.prv := &null
+      p.t1 := p.id				# point.t1 = group membership
+      p.t2 := 0					# point.t2 = degree of node
+      }
+
+   need := *ptlist				# number of edges we still need
+
+   every d := |!distsrt do {			# |! is to handle 2-pt case
+      p := d.p
+      q := d.q
+      if p.t2 > 1 | q.t2 > 1 then		# if either is fully connected
+         next
+      if p.t1 = q.t1 & need > 1 then		# if would be cycle & not done
+         next
+
+      # now we are committed to adding the point
+      pause()
+      DrawLine(fgwin, p.x, p.y, q.x, q.y)	# draw new edge
+      p.t2 +:= 1				# increase degree counts
+      q.t2 +:= 1
+
+      if /p.nxt <- q & /q.prv := p then {	# if q can follow p easily
+         g := q.t1 ~=:= p.t1 | break		# break if the final connection
+         while q := \q.nxt do
+            q.t1 := g
+         }
+      else if /q.nxt <- p & /p.prv := q then {	# if p can follow q easily
+         g := p.t1 ~=:= q.t1 | break		# break if the final connection
+         while p := \p.nxt do
+            p.t1 := g
+         }
+      else if /p.nxt := q then {  # implies /q.nxt -- both are chain tails
+         g := p.t1
+         repeat {
+            q.t1 := g
+            q.nxt := q.prv
+            q.prv := p
+            p := q
+            q := \q.nxt | break
+            }
+         }
+      else { # /p.prv & /q.prv -- both are chain heads
+         p.prv := q
+         g := p.t1
+         repeat {
+            q.t1 := g
+            q.prv := q.nxt
+            q.nxt := p
+            p := q
+            q := \q.prv | break
+            }
+         }
+
+      if (need -:= 1) = 0 then			# quit when have all edges
+         break
+      }
+
+   havepath := 1
+   report("greedy algorithm")
+   return
+end
+
+
+
+
+#  bgnpath(i, msg) -- common setup for path construction
+#
+#  i > 0 if *sorted* distance table will be needed
+#  msg is status message
+
+procedure bgnpath(i, msg)
+   if *ptlist < 2 then
+      fail
+   prepdist(i)
+   status(msg)
+   if \havepath then
+      erasepath()
+   havepath := &null
+   lastclk := &time
+   return
+end
+
+
+
+#########################  optimizations  #########################
+
+
+
+#  twoadj() -- swap pairs of adjacent points
+
+procedure twoadj()
+   local lastchg, nflips, p, q
+
+   if /havepath then
+      return
+   status("2-adj...")
+   lastclk := &time
+   nflips := 0
+
+   lastchg := p := ?ptlist			# pick random starting point
+
+   repeat {
+
+      q := p.nxt.nxt
+      repeat {
+         DrawLine(emwin, p.x, p.y, p.nxt.x, p.nxt.y)	# mark current spot
+         if not pairtest(p, q) then		# if swap doesn't help
+            break
+         flip(p, q)				# do the swap
+         nflips +:= 1				# count it
+         lastchg := p				# update point of last change
+         }
+
+      pause()
+      p := p.nxt
+      if p === lastchg then
+         break			# have made complete circuit without changes
+      }
+
+   report("2-adj (" || nflips || " flips)")
+   refresh()
+   return
+end
+
+procedure adjtest(p, q)
+   return ((p.nxt.nxt === q) | (q.nxt.nxt === p)) & pairtest(p, q)
+end
+
+
+
+#  twoopt() -- swap segments if total path shortens
+
+procedure twoopt()
+   pairdriver("2-opt", pairtest)
+   return
+end
+
+#  pairtest(p, q) -- succeed if swapping out-segments from p and q shortens path
+
+procedure pairtest(p, q)
+   return (dist(p,q) + dist(p.nxt,q.nxt)) < (dist(p,p.nxt) + dist(q,q.nxt)) &
+            (not (p === (q.prv | q | q.nxt)))
+end
+
+
+
+#  uncross() -- swap intersecting segments
+
+procedure uncross()
+   pairdriver("uncross", intersect)
+   return
+end
+
+#  intersect(p, q) -- succeed if outward segments from p and q intersect
+#
+#  from comp.graphics.algorithms FAQ, by O'Rourke
+
+procedure intersect(p, q)
+   local a, b, c, d
+   local xac, xdc, xba, yac, ydc, yba
+   local n1, n2, d12, r, s
+
+   a := p
+   b := p.nxt
+   c := q
+   d := q.nxt
+   xac := a.x - c.x
+   xdc := d.x - c.x
+   xba := b.x - a.x
+   yac := a.y - c.y
+   ydc := d.y - c.y
+   yba := b.y - a.y
+
+   n1 := yac * xdc - xac * ydc
+   n2 := yac * xba - xac * yba
+   d12 := real(xba * ydc - yba * xdc)
+
+   if d12 = 0.0 then
+      fail		# lines are parallel or coincident
+
+   r := n1 / d12
+   s := n2 / d12
+
+   # intersection point is: (a.x + r * xba, a.y + r * yba)
+
+   if 0.0 < r < 1.0 & 0.0 < s < 1.0 then
+      return		# segments AB and CD do intersect 
+   else
+      fail		# segments do not intersect (though extensions do)
+end
+
+
+
+
+#  pairdriver(label, tproc) -- driver for "uncross" and "2-opt"
+
+procedure pairdriver(label, tproc)
+   local slist, todo, nflips, a, p, q
+
+   if /havepath then
+      return
+   status(label || "...")
+   lastclk := &time
+   nflips := 0
+
+   slist := list()			# initial list of segments
+   every put(slist, path())
+   todo := set()			# segments to reconsider
+
+   while p := get(slist) | ?todo do {	# pick candidate segment
+
+      delete(todo, p)
+      pause()
+
+      # restart search every time p's outgoing edge changes
+      repeat {
+
+         DrawLine(emwin, p.x, p.y, p.nxt.x, p.nxt.y)  # mark segment in progress
+
+         # check for swap with every other edge
+         every q := !ptlist do {
+
+            if tproc(p, q) then {		# if test procedure succeeds,
+						# a swap is worthwhile
+
+               # the path from p.nxt through q will reverse direction;
+               # this will change segment labelings; so fix up "todo" set
+               a := q.prv
+               while a ~=== p do {
+                  if member(todo, a) then {	# if segment is on list
+                     delete(todo, a)		# remove under old name
+                     insert(todo, a.nxt)	# add under new name
+                     }
+                  a := a.prv
+                  }
+
+               # new segment from p will be done when we loop again
+               # other new segment to list
+               insert(todo, p.nxt)	# add to list
+
+               # now flip the edges
+               flip(p, q)		# flip the edges
+               nflips +:= 1		# count the flip
+
+               break next	# restart search loop using new edge
+               }
+            }
+
+         break		# if no improvement for one full loop
+         }
+
+      }
+
+   report(label || " (" || nflips || " flips)")
+   refresh()
+   return
+end
+
+
+
+#########################  point maintenance  #########################
+
+
+
+#  clrpts() -- remove all points
+
+procedure clrpts()
+   ptlist := []
+   distlist := []
+   distsrt := []
+   havepath := &null
+   refresh()
+   fillrect(bgwin)
+   status("0 points")
+   return
+end
+
+
+
+#  reseed() -- add random points to the list
+
+procedure reseed(win, dummy, x, y, event)
+   local p, v, n
+
+   n := integer(\event)^2 | nseed
+   every 1 to n do
+      addpt(win, &null, ax + ?aw, ay + ?ah)
+   return
+end
+
+
+
+#  addpt(win, dummy, x, y) -- add one point to the list
+
+procedure addpt(win, dummy, x, y)
+   local n, p, q
+
+   if \havepath then {
+      erasepath()
+      havepath := &null
+      }
+   n := *ptlist
+   p := point(n + 1, x, y)
+   every q := !ptlist do
+      put(distlist, dstrec(integer(1000 * sqrt((q.x-x)^2 + (q.y-y)^2)), p, q))
+   put(ptlist, p)
+   drawpt(p)
+   status(*ptlist || " points")
+   newpts := 1
+   return p
+end
+
+
+
+#  prepdist(i) -- prepare distance data for path construction
+#
+#  copy the distance list, if not already done, so it can be indexed quickly.
+#  also create the sorted list if i > 0.
+
+procedure prepdist(i)
+   static c, n
+
+   if c ~=== distlist | n ~= *distlist then {
+      c := distlist := copy(distlist)
+      n := *distlist
+      }
+   if \i > 0 & *distsrt < *distlist then {
+      status("sorting distances... ")
+      lastclk := &time
+      WFlush(win)
+      distsrt := sortf(distlist, 1)
+      report("distance sort")
+      }
+   return
+end
+
+
+
+#  dist(p, q) -- return distance between p and q assuming p ~=== q
+
+procedure dist(p, q)
+   local m, n
+   m := p.id
+   n := q.id
+   if m < n then
+      m :=: n
+   return distlist[((m - 1) * (m - 2)) / 2 + n].d
+end
+
+
+
+#  path() -- generate current path, even if it changes during generation
+
+procedure path()
+   local l, p, q
+   p := q := ptlist[1] | fail
+   l := [p]
+   while (p := p.nxt) ~=== q do
+      put(l, p)
+   suspend !l
+end
+
+
+#  follow(p, q) -- insert q to follow p (erases old path from p, draws new)
+
+procedure follow(p, q)
+   DrawLine(bgwin, p.x, p.y, (p.prv~===\p.nxt).x, p.nxt.y)
+   every drawpt(p | \p.nxt)
+   q.nxt := p.nxt
+   q.prv := p
+   (\p.nxt).prv := q
+   p.nxt := q
+   DrawLine(fgwin, p.x, p.y, q.x, q.y)
+   DrawLine(fgwin, q.x, q.y, (\q.nxt).x, q.nxt.y)
+   return q
+end
+
+
+
+#  flip(p, q) -- link p to q, and their successors to each other
+
+procedure flip(p, q)
+   local a, b
+
+   DrawLine(bgwin, p.x, p.y, p.nxt.x, p.nxt.y)
+   DrawLine(bgwin, q.x, q.y, q.nxt.x, q.nxt.y)
+   # relink half of the chain backwards
+   a := q
+   while a ~=== p do {
+      a.prv :=: a.nxt
+      a := a.nxt
+      }
+   a := p.nxt
+   b := q.prv
+   p.nxt := q
+   q.prv := p
+   a.nxt := b
+   b.prv := a
+   DrawLine(fgwin, p.x, p.y, q.x, q.y)
+   DrawLine(fgwin, a.x, a.y, b.x, b.y)
+   every drawpt(p | q | a | b)
+   return
+end
+
+
+
+#  linkpath(p, q, ...) -- link points p, q, ... in order
+
+procedure linkpath(l[])
+   local i, p, q, v
+   i := p := get(l)
+   v := [fgwin, p.x, p.y]
+   every q := !l do {
+      p.nxt := q
+      q.prv := p
+      p := q
+      put(v, p.x, p.y)
+      }
+   DrawLine ! v
+   every drawpt(i | !l)
+   return
+end
+
+
+
+
+#########################  drawing  #########################
+
+
+
+#  refresh() -- redraw screen to repair segments and points
+
+procedure refresh()
+   fillrect(bgwin)				# erase segs
+   redraw()
+   return
+end
+
+
+
+#  redraw() -- redraw path without erasing
+
+procedure redraw()
+   local p
+
+   every drawpt(!ptlist)
+   every p := !ptlist do
+      DrawLine(fgwin, p.x, p.y, (\p.nxt).x, p.nxt.y)
+   return
+end
+
+
+
+#  erasepath() -- erase path, redraw points if necessary
+
+procedure erasepath()
+   local l, p, v
+
+   v := [bgwin]
+   every p := ptlist[1].prv | path() do
+      put(v, p.x, p.y)
+   DrawLine ! v
+   every drawpt(!ptlist)
+   return
+end
+
+
+
+#  drawpath(win, p, q) -- draw the path from p to q
+#
+#  (of course, depending on the foreground color, this can hide a path, too.)
+
+procedure drawpath(win, p, q)
+   local v
+
+   v := [win, p.x, p.y]
+   while p ~=== q do {
+      p := p.nxt
+      put(v, p.x)
+      put(v, p.y)
+      }
+   DrawLine ! v
+   return
+end
+
+
+
+#  drawpt(p) -- draw the single point p
+
+procedure drawpt(p)
+   FillRectangle(fgwin, p.x - 2, p.y - 2, 5, 5)
+   return
+end
+
+
+
+#  fillrect(win) -- fill the working area
+
+procedure fillrect(win)
+   FillRectangle(win, ax - m + 1, ay - m + 1, aw + 2 * m - 1, ah + 2 * m - 1)
+   return
+end
+
+
+
+#########################  reporting  #########################
+
+
+
+#  listpath() -- list the coordinates of each point on standard output
+
+procedure listpath()
+   local p
+
+   if \havepath then {
+      write("\point list in order of traversal:")
+      every listpt(path())
+      }
+   else {
+      write("\point list (no path established):")
+      every listpt(!ptlist)
+      }
+   return
+end
+
+#  listpt(p) - list one point
+
+procedure listpt(p)
+   write(right(p.id, 3), ".", right(p.x, 5), right(p.y, 5),
+         right((\p.prv).id | "", 6), right((\p.nxt).id | "", 6))
+   return
+end
+
+
+
+#  report(text) -- display statistics on screen and stdout
+#
+#  The statistics include the delta time since lastclk was last set.
+#
+#  Output to stdout is suppressed if the "-q" option was given.
+#  Output to stdout is double spaced if the set of points has changed.
+
+procedure report(text)
+   local p, n, d, s, dt
+
+   dt := ((((&time - lastclk) / 1000.0) || "000") ? (tab(upto(".")) || move(3)))
+   s := right(*ptlist, 4) || " pts   "
+
+   if \havepath then {
+      d := 0
+      every p := !ptlist do
+         d +:= dist(p, p.nxt)
+      d := (d + 500) / 1000
+      s ||:= right("d = " || d, 10)
+      }
+   else
+      s ||:= "          "
+
+   s ||:= right(dt , 8) || " sec   " || text
+
+   status(s)
+   if /opts["q"] then {
+      if \newpts then
+         write()
+      write(s)
+      }
+   newpts := &null
+   return
+end
+
+
+#  status(s) -- write s as a status message
+
+procedure status(s)
+   EraseArea(win, m + bw + m, m + h - fh)
+   GotoXY(win, m + bw + m, m + h - (fh / 4))
+   writes(win, s)
+   return
+end
diff --git a/ipl/gprogs/trkvu.icn b/ipl/gprogs/trkvu.icn
new file mode 100644
index 0000000..9cd3c36
--- /dev/null
+++ b/ipl/gprogs/trkvu.icn
@@ -0,0 +1,695 @@
+############################################################################
+#
+#	File:     trkvu.icn
+#
+#	Subject:  Program to display GPS track logs
+#
+#	Authors:  Gregg M. Townsend
+#
+#	Date:     October 1, 2005
+#
+############################################################################
+#
+#	This file is in the public domain.
+#
+############################################################################
+#
+#	Trkvu displays GPS track logs, using color to indicate various
+#	characteristics such as velocity, direction, or time of day.
+#
+############################################################################
+#
+#	usage:  trkvu file...
+#
+#	Each file argument is a track log uploaded from a GPS receiver.
+#	Lines that end in three decimal values specify latitude, longutude,
+#	and altitude in that order.  Lines with just two values omit the
+#	altitude.  Lines without data indicate breaks between segments. 
+#
+#	Some colorings use timestamps from the track logs.  A timestamp
+#	has the form "mm/dd/yyyy hh:mm:ss" or "yyyy/mm/dd hh:mm:ss" and
+#	precedes the latitude and longitude.
+#
+############################################################################
+#
+#	Track log colorings are selected by pressing a key:
+#
+#	F	color by File
+#	A	color by Age
+#	O	color by Orientation (direction of travel)
+#	V	color by Velocity
+#	I	color by Interval duration (GPS sample rate)
+#	S	color Segments in contrasting colors
+#	Y	color by time of Year
+#	D	color by Day of week
+#	H	color by Hour of day
+#	M	color by Minute (repeating colors every 10 minutes)
+#	T	color by Time of day
+#
+#	Colorings can also be cycled:
+#
+#	SP or CR	cycle to next coloring
+#	BS or DEL	cycle to preceding coloring
+#
+#	A legend explains each coloring.  If it shows individually labeled
+#	color blocks, the colors encode discrete values.  If a spectrum
+#	is shown, the colors vary smoothly over a continuous range.
+#
+#	Some colorings require timestamps.  For these, tracks lacking
+#	timestamps are drawn in gray.
+#
+############################################################################
+#
+#	Zooming and Panning:
+#
+#	To zoom to a particular region, sweep out the region using the
+#	left mouse button.  To cancel a sweep, reduce its width or height
+#	to fewer than ten pixels.
+#
+#	The window may be resized as desired.
+#
+#	The following keyboard commands also affect the display region:
+#
+#	+ or =		zoom in
+#	- or _		zoom out
+#	0 or Home	zoom to initial view
+#	arrow keys	pan the display  (hold Shift key for smaller pan)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  datetime, graphics, mapnav, strings
+#
+############################################################################
+
+
+$include "keysyms.icn"
+
+link datetime
+link graphics
+link mapnav
+link strings
+
+$define BORDER 10	# border widths
+
+
+record view(		# one view of data
+   cs,			# cset of chars to select this view
+   ltitle,		# legend title
+   hproc,		# hue selection procedure
+   lproc)		# legend procedure
+
+record point(		# one point along a track
+   t,			# time at point (real days & fraction since epoch)
+   x, y,		# coordinates of point (longitude, latitude)
+   fhue)		# hue assigned to original source file
+
+
+global viewlist		# list of views (view records)
+global curview		# current selected view
+
+global huelist		# list of ColorValues of 180 hues
+
+global fnlist		# file name list (for F legend)
+global fhlist		# file hue list (for F legend)
+
+global seglist		# list of travel segments
+global tmin, tmax	# earliest and latest time seen
+global xmin, xmax	# westernmost and easternmost longitude seen
+global ymin, ymax	# northernmost and southernmost latitude seen
+
+global lbase		# legend baseline y value
+global lclip		# clipping arguments for legend region
+global mclip		# clipping arguments for map region
+global stdwin		# std bg/fg window
+
+
+
+#  ========================= Overall Control =========================
+
+procedure main(args)
+   local e, v, xywh
+
+   Window("size=800,800", "resize=on", "canvas=hidden",
+      "linewidth=2", "font=sans,bold,12", args)
+   stdwin := Clone("bg=white")
+
+   viewlist := [
+      # sequence here is followed by <SP> and <BS>
+      view('Ff', "File", byfile, flegend),
+      view('Aa', "Age", byage, agelegend),
+      view('Oo', "Orientation", orientation, olegend),
+      view('Vv', "Velocity", velocity, vlegend),
+      view('Ii', "Interval", byinterval, intlegend),
+      view('Ss', "Segments", segments, seglegend),
+      view('Yy', "time of Year", bymonth, monthlegend),
+      view('Dd', "Day", byday, daylegend),
+      view('Hh', "Hour", byhour, hourlegend),
+      view('Mm', "Minute", byminute, minutelegend),
+      view('Tt', "Time", bytime, timelegend),
+      ]
+   while /viewlist[-1] do pull(viewlist)
+
+   seglist := []		# init data structures
+   fnlist := []
+   fhlist := []
+
+   every load(!args)		# load data
+   survey()			# find extremes
+   fnlist := fnsimp(fnlist)	# simplify filename list
+
+   WAttrib("canvas=normal")	# make display visible
+   hueinit()			# init color manager
+   layout()			# lay out display
+   mapinit(draw, , xmin, xmax, ymax, ymin, cos(dtor((ymin + ymax) / 2)))
+
+   if *args > 1 then
+      Enqueue("f")		# show initially by file
+   else if tmax > 0 then
+      Enqueue("a")		# show initially by age
+   else
+      Enqueue("o")		# show initially by orientation
+
+   # ==================== main event loop ====================
+
+   while e := Event() do {
+      if upto((v := \!viewlist).cs, e) then {	# if a view selector
+         curview := v
+         EraseArea()
+         mapgen()				# regenerate map
+         }
+      else case e of {
+         !" \n\r": nextview(+1)			# cycle view forward
+         !"\b\d":  nextview(-1)			# cycle view backward
+         &resize:  { layout(); mapevent(e) }	# resize window
+         default:  { mapevent(e) }		# possible standard action
+         }
+      }
+end
+
+procedure nextview(d)			# advance to next view in sequence
+   local i
+
+   every i := 1 to *viewlist do
+      if curview === viewlist[i] then {
+         i := (i + *viewlist - 1 + d) % *viewlist + 1
+         curview := viewlist[i]
+         mapgen()
+         return
+         }
+end
+
+
+
+#  ========================= Input =========================
+
+procedure load(fname)			# load data from one file
+   local f, h, p, w, t, x, y, a, line, ptlist
+   static n
+   initial n := 0
+
+   f := open(fname) | stop("cannot open ", fname)
+   h := huenum(n +:= 1)
+   put(fnlist, fname)
+   put(fhlist, h)
+   while line := read(f) do {
+      every put(w := [], words(line))
+      if -90.0 <= numeric(w[-3]) <= 90.0 then
+         a := pull(w)			# altitude
+      if x := numeric(w[-1]) & y := numeric(w[-2]) then {
+         t := tcrack(w[-4], w[-3]) | &null
+         /ptlist := []
+         put(ptlist, p := point(t, x, y, h))
+         }
+      else {
+         put(seglist, \ptlist)
+         ptlist := &null
+         next
+         }
+      }
+
+   put(seglist, \ptlist)
+   close(f)
+   if /p then
+      write(&errout, "   no data: ", fname)
+   return
+end
+
+procedure tcrack(date, time)		# translate date + time into real value
+   local day, sec
+   static smul
+   initial smul := 1.0 / (24 * 60 * 60)
+
+   if date[3] == "/" then
+      date := map("CcYy/Mm/Dd", "Mm/Dd/CcYy", date)
+   if date == ("1989/12/31" | "1990/01/01") then
+      return &null
+   *time =  8 | fail
+   *date = 10 | fail
+   day := DateToSec(date) | fail
+   sec := ClockToSec(time) | fail
+   return smul * (day + sec)
+end
+
+procedure survey()			# survey data ranges
+   local p
+
+   xmin := 180
+   xmax := -180
+   ymin := 90
+   ymax := -90
+   tmin := 100 * 365.25
+   tmax := 0
+
+   every p := !!seglist do {
+      tmin >:= \p.t
+      tmax <:= \p.t
+      xmin >:= p.x
+      xmax <:= p.x
+      ymin >:= p.y
+      ymax <:= p.y
+      }
+
+   if xmin > xmax then
+      stop("   nothing to display")	# diagnostic already issued
+
+   if tmin > tmax then
+      tmin := tmax := 0
+
+   return
+end
+
+procedure fnsimp(fnlist)		# simplify filename list
+   local f, i, j, s
+
+   if *fnlist < 2 then fail
+   (coprefix ! fnlist) ? {
+      i := 1
+      while i := upto('/') + 1 do
+         move(1)
+      }
+   (cosuffix ! fnlist) ? {
+      tab(upto('.') | 0)
+      j := -*tab(0)
+      }
+   f := []
+   every put(f, (!fnlist)[i:j])
+   return f
+end
+
+
+
+#  ========================= Color Management =========================
+#
+#  Map colors are taken from the fully saturated color spectrum, spaced
+#  every 2 degrees in HSV space.  This yields 180 different colors, well
+#  within Icon's limit of 256.  The greens are darkened a bit for better
+#  contrast with the white background; but the yellows are not, because
+#  a darkened yellow is really ugly.  (For better contrast, some colorings
+#  use hue 55 instead of 60 for a yellow color.)
+
+procedure hueinit()		# initialize hue table (360 entries)
+   local d, d2, v
+
+   huelist := list(360)
+   every d := 0 to 359 do {
+      d2 := d - d % 2			# use 2-degree quanta
+      if 60 < d2 < 180 then		# darken green region
+         v := integer(100 - 0.8 * (60 - abs(d2 - 120)))
+      else
+         v := 100
+      huelist[d + 1] := HSVValue(d2 || "/100/" || v)
+      }
+   return
+end
+
+procedure sethue(h)		# set & cache color, given hue in degrees >= 0
+   local k
+   static kprev
+
+   if h := integer(h) % 360 then
+      k := huelist[h + 1]
+   else				# use gray for invalid argument
+      k := "gray"
+   Fg(kprev ~===:= k)
+   return
+end
+
+procedure huenum(n)		# return hue from ordered list
+   static predef
+   initial predef := [240, 0, 120, 30, 180, 300, 50, 270, 70, 210, 330]
+   #                  blu red grn org cyan mgnta tan purp grn blu plum
+
+   return predef[n] | (137 * n) % 360
+end
+
+
+
+#  ========================= Map Drawing =========================
+
+procedure layout()			# configure window layout
+   local w, h, lh
+
+   Bg("pale weak yellow")
+   Clip()
+   EraseArea()
+   Bg("white")
+
+   w := WAttrib("width")
+   h := WAttrib("height")
+
+   # set legend size and baseline
+   lh := 2 * BORDER + WAttrib("ascent")
+   lbase := BORDER + lh - BORDER
+
+   # set legend clipping, and clear
+   lclip := [BORDER, BORDER, w - 2 * BORDER, lh]
+   Clip ! ([stdwin] ||| lclip)
+   Clip ! lclip
+   EraseArea()
+
+   # set map clipping, and clear
+   mclip := [BORDER, lh + 2 * BORDER, w - 2 * BORDER, h - lh - 3 * BORDER]
+   Clip ! mclip
+   EraseArea()
+
+   return
+end
+
+procedure draw(win, pjn, a)		# display map using curview
+   local ptlist, h, n, p, q, x1, y1, x2, y2, l
+
+   Clip ! lclip
+   EraseArea()
+   GotoXY(2 * BORDER, lbase)
+   ltext(curview.ltitle)
+   ltext(": ")
+   curview.lproc()
+
+   Clip ! mclip
+   every ptlist := !seglist do {
+      if *Pending() > 0 then break
+      p := &null
+      every q := !ptlist do {
+         l := project(pjn, [q.x, q.y])
+         x2 := integer(get(l))
+         y2 := integer(get(l))
+         x2 <:= -32767
+         y2 <:= -32767
+         x2 >:= 32767
+         y2 >:= 32767
+         if \p then {
+            sethue(curview.hproc(p, q) | &null)
+            DrawLine(x1, y1, x2, y2)
+            }
+         else if *ptlist = 1 then {
+            sethue(curview.hproc(q, q) | &null)
+            FillRectangle(x2 - 1, y2 - 1, 3, 3)
+            }
+         p := q
+         x1 := x2
+         y1 := y2
+         }
+      }
+   return
+end
+
+
+
+#  ========================= Legend Writing =========================
+#
+#  Colors are written via &window, text in black via stdwin.
+
+procedure ltext(s)		# write text
+
+   return WWrites(stdwin, s)
+end
+
+procedure lhue(h, t)		# write hue block with optional caption
+   local x, w
+
+   sethue(h)
+   x := WAttrib("x")
+   w := WAttrib("ascent")
+   FillRectangle(x, lbase + 1, w - 1, -w)
+   GotoXY(x + w, lbase)
+   ltext(\t)
+   return
+end
+
+procedure lspectrum(h1, h2, n)	# write spectrum of 6 colors from h1 to h2
+   local i, m
+
+   /n := 6
+   m := (h2 - h1) / (n - 1.0)
+   every i := 1 to n do
+      lhue(h1 + m * (i - 1))
+   return
+end
+
+
+
+#  ========================= View Procedures =========================
+#
+#  View procedures are paired: a legend procedure draws the legend and a
+#  hue selection procedure that chooses the hue for each segment.  (Hue
+#  procedure return a value in degrees, or they fail, which draws gray.)
+
+
+#  F: color segments by source file, using colors set at load time
+
+procedure flegend()
+   local i
+
+   every i := 1 to *fnlist do
+      lhue(fhlist[i], fnlist[i] || " ")
+   return
+end
+
+procedure byfile(p, q)
+   return q.fhue
+end
+
+
+#  A: color segments by age (relative to range of timestamps seen)
+
+procedure agelegend()
+
+   ltext("oldest")
+   lspectrum(630, 360, 12)
+   ltext("newest")
+   return
+end
+
+procedure byage(p, q)
+
+   # purple oldest, green mid, red newest
+   return 630. - 270. * (\q.t - tmin) / (tmax - tmin)
+end
+
+
+#  O: color segments by orientation (direction of travel)
+
+procedure olegend()
+
+   ltext("N"); lspectrum(270, 180)
+   ltext("E"); lspectrum(180, 90)
+   ltext("S"); lspectrum(90, 0)
+   ltext("W"); lspectrum(360, 270)
+   ltext("N")
+   return
+end
+
+procedure orientation(p, q)
+
+   # blue north, teal east, olive south, red west
+   return 180. + rtod(atan(q.y - p.y, cos(dtor(q.y)) * (q.x - p.x)))
+end
+
+
+#  V: color segments by velocity
+
+procedure vlegend()
+
+   lhue(240, "1 ")
+   lhue(210, "2 ")
+   lhue(180, "3 ")
+   lhue(120, "4 ")
+   lhue( 55, "5 ")
+   lhue( 30, "6 ")
+   lhue(  0, "7 ")
+   lhue(300, "8 ")
+   lhue(270, "9 ")
+   ltext(" mph (x1, x10, ...)")
+   return
+end
+
+procedure velocity(p, q)
+   local dt, dx, dy, d, mph
+   static hues
+   initial hues := [270, 240, 210, 180, 120, 55, 30,  0, 300, 270]
+   #                  0    1    2    3    4   5   6   7    8    9
+   #                      10   20   30   40  50  60  70   80   90
+   #                     100  200  300  400 500 600 700  800  900
+
+   dt := 0 < (\q.t - \p.t) | fail
+   dx := cos(dtor(p.y)) * (q.x - p.x)
+   dy := q.y - p.y
+   d := sqrt(dx ^ 2 + dy ^ 2)
+   mph := integer(2.877 * d / dt + 0.5)
+   while mph > 9 do
+      mph /:= 10
+   return hues[mph + 1]
+end
+
+
+#  I: color segments by length of time interval
+
+procedure intlegend()
+
+   lhue(  0, "0 ")
+   lhue( 30, "1 ")
+   lhue( 55, "2 ")
+   lhue(120, "4 ")
+   lhue(180, "8 ")
+   lhue(220, "16 ")
+   lhue(240, "32 ")
+   lhue(290, "64 sec")
+   return
+end
+
+procedure byinterval(p, q)
+   local dt, i
+   static hues
+   initial hues := [0, 30, 55, 120, 180, 220, 240, 290]
+   #                 0  1   2    4    8   16   32   64
+
+   dt := integer(86400. * (\q.t - \p.t) + 0.5) | fail
+   i := (2 + integer(log(0 < dt, 2))) | 1
+   return hues[i | -1]
+end
+
+
+#  S: emphasize individual segments in contrasting colors.
+
+procedure seglegend()
+
+   lspectrum(137, 12*137, 12)
+   ltext("...")
+   return
+end
+
+procedure segments(p, q)
+   static n
+   initial n := 0
+
+   return n +:= 137
+end
+
+
+#  Y: color segments by time of year as a spectrum
+
+procedure monthlegend()
+
+   ltext("January")
+   lspectrum(525, 195, 12)
+   ltext("December")
+   return
+end
+
+procedure bymonth(p, q)
+
+   # cyan winter, green spring, red summer, blue fall
+   return 540. - (\q.t % 365.25) * (360. / 365.25)
+end
+
+
+#  D: color segments by day of week
+
+procedure daylegend()
+
+   lhue(240, "Sun ")
+   lhue(120, "Mon ")
+   lhue(165, "Tue ")
+   lhue( 55, "Wed ")
+   lhue( 30, "Thu ")
+   lhue(285, "Fri ")
+   lhue(  0, "Sat ")
+   return
+end
+
+procedure byday(p, q)
+   static hues
+   initial hues := [240, 120, 165, 55, 30, 285, 0]
+
+   return hues[1 + ((4 + integer(\q.t)) % 7)]
+end
+
+
+#  H: color segments by hour in the day (0 to 11, repeated)
+
+procedure hourlegend()
+
+   lhue(240, "12 ")
+   lhue(290, "1 ")
+   lhue(350, "2 ")
+   lhue( 30, "3 ")
+   lhue( 80, "4 ")
+   lhue(150, "5 ")
+   lhue(210, "6 ")
+   lhue(270, "7 ")
+   lhue(330, "8 ")
+   lhue( 55, "9 ")
+   lhue(120, "10 ")
+   lhue(180, "11 ")
+   return
+end
+
+procedure byhour(p, q)
+   local h
+   static hues
+   initial hues := [240, 290, 350, 30, 80, 150, 210, 270, 330, 55, 120, 180]
+
+   h := integer(24 * (\q.t - integer(q.t))) | fail
+   return hues[1 + h % 12]
+end
+
+
+#  M: color segments by minute of the hour, mod 10
+
+procedure minutelegend()
+   local i
+
+   every i := 0 to 9 do
+      lhue(huenum(i + 1), ":x" || i || " ")
+   return
+end
+
+procedure byminute(p, q)
+   local t
+
+   t := 24 * 30 * (\p.t + \q.t) | fail		# time in minutes since epoch
+   return huenum(1 + integer(t) % 10)
+end
+
+
+#  T: color segments by a time-of-day spectrum
+
+procedure timelegend()
+
+   ltext("midnight")
+   lspectrum(600, 420, 13)
+   ltext("noon")
+   lspectrum(420, 240, 13)
+   ltext("midnight")
+   return
+end
+
+procedure bytime(p, q)
+
+   # green morning, yellow noon, red afternoon, blue night
+   return 600. - 360. * (\q.t - integer(q.t))
+end
diff --git a/ipl/gprogs/trycolor.icn b/ipl/gprogs/trycolor.icn
new file mode 100644
index 0000000..c74172f
--- /dev/null
+++ b/ipl/gprogs/trycolor.icn
@@ -0,0 +1,96 @@
+############################################################################
+#
+#	File:     trycolor.icn
+#
+#	Subject:  Program to investigate color specifications
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     trycolor repeatedly reads a color specification from standard input
+#  and displays a disc of that color.  A color specification may be in any
+#  of the forms accepted by Icon, for example:
+#
+#     blue
+#     #ffedcb
+#     50010,60422,8571
+#     dark greenish blue
+#
+#  Additionally, the leading '#' may be omitted from hexadecimal forms.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, graphics
+#
+############################################################################
+
+link options
+link optwindw
+link graphics
+
+procedure main(args)
+   local win, gc, line, cval, mono, color, opts, m, w, h, l
+   local r, g, b, rr, gg, bb, x
+
+   opts := options(args, winoptions())
+   /opts["W"] := 300
+   /opts["H"] := 300
+   /opts["M"] := -1
+   win := optwindow(opts, "cursor=off", "echo=off")
+   gc := Clone(win)
+   m := opts["M"]
+   w := opts["W"]
+   h := opts["H"]
+   l := WAttrib(win, "leading")
+   color := opts["F"]
+   mono := WAttrib(win, "depth") == "1"
+   write("gamma=", WAttrib(win, "gamma"))
+   repeat {
+      if *color > 0 then {
+         if Shade(gc, color | (color := "#" || color)) then {
+            EraseArea(gc)
+            FillArc(gc, m, m, w, h)
+            Fg(win, Contrast(win, color))
+            cval := ColorValue(win, color)
+            cval ? {
+               r := tab(many(&digits));  move(1)
+               g := tab(many(&digits));  move(1)
+               b := tab(many(&digits))
+               }
+            rr := hexv(r / 65536.0)
+            gg := hexv(g / 65536.0)
+            bb := hexv(b / 65536.0)
+            CenterString(win, m + w/2, m + h/2 - l, color)
+            CenterString(win, m + w/2, m + h/2, cval)
+            CenterString(win, m + w/2, m + h/2 + l, "#" || rr || gg || bb)
+            }
+         else
+            write("[failed]")
+         }
+      writes("> ")
+      line := read() | break
+      line ? {
+         tab(many(' \t'))
+         color := trim(tab(0))
+         }
+      }
+end
+
+procedure hexv(v)			# two-hex-digit specification of v
+   static hextab
+   initial {
+      every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
+      }
+   return hextab [1 + integer(256 * v)]
+end
diff --git a/ipl/gprogs/tryfont.icn b/ipl/gprogs/tryfont.icn
new file mode 100644
index 0000000..be55a0f
--- /dev/null
+++ b/ipl/gprogs/tryfont.icn
@@ -0,0 +1,110 @@
+############################################################################
+#
+#	File:     tryfont.icn
+#
+#	Subject:  Program to demonstrate X font rankings
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     July 18, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     tryfont repeatedly reads a font specification from standard input
+#  and displays, with their scores, a windowfull of available fonts that
+#  best match that specification.  The window can be resized when tryfont
+#  is paused at a prompt; the new size is used for the next list.
+#
+#     Note that tryfont uses the library procedure BestFont() for ranking;
+#  this can differ from the rankings used by the Icon runtime system's
+#  font selection logic.
+#
+#     tryfont can also be run in ASCII mode, without using X windows, by
+#  passing a file name as a command argument.  The file should contain
+#  a list of X fonts, such as from the xlsfonts program.  The number of
+#  fonts printed on standard output can be specified as a second argument.
+#
+#     For details of font specifications, see BestFont().
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: options, optwindw, xbfont, graphics
+#
+############################################################################
+
+
+link options
+link optwindw
+link xbfont
+link graphics
+
+
+procedure main(args)
+   if *args > 0 & args[1][1] ~== "-" then
+      filemode(args)
+   else
+      windowmode(args)
+end
+
+
+procedure filemode(args)
+   local fname, limit, f, fontlist, request, a
+
+   fname := args[1]
+   limit := integer(args[2]) | 20
+   f := open(fname) | stop("can't open ", fname)
+   every put(fontlist := [], !f)
+   repeat {
+      writes("> ")
+      request := trim(read()) | return
+      if *request = 0 then
+         next
+      every a := RankFonts(fontlist, request) \ limit do
+         write(right(a.val, 5), "\t", a.str)
+      write()
+      }
+end
+
+
+procedure windowmode(args)
+   local opts, win, fwin, request, a, h, y
+
+   opts := options(args, winoptions())
+   /opts["W"] := 900
+   /opts["H"] := 300
+   /opts["M"] := -1
+   win := optwindow(opts, "cursor=off", "echo=off")
+   fwin := Clone(win)
+
+   &error := 1
+   WAttrib(win, "resize=on")
+   &error := 0
+
+   repeat {
+      writes("> ")
+      request := trim(read()) | return
+      if *request = 0 then
+         next
+      h := WAttrib(win, "height")
+      y := 0
+      EraseArea(win)
+      every a := RankFonts(win, request) do {
+         Font(fwin, a.str)
+         y +:= WAttrib(fwin, "fheight") - WAttrib(fwin, "descent")
+         GotoXY(win, 10, y)
+         writes(win, right(a.val, 4), "  ")
+         writes(fwin, a.str)
+         y +:= WAttrib(fwin, "descent")
+         if y >= h then
+            break
+         }
+      }
+end
diff --git a/ipl/gprogs/uix.icn b/ipl/gprogs/uix.icn
new file mode 100644
index 0000000..8cf04d9
--- /dev/null
+++ b/ipl/gprogs/uix.icn
@@ -0,0 +1,223 @@
+############################################################################
+#
+#	File:     uix.icn
+#
+#	Subject:  Program to translate user interfaces
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 31, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#      uix translates a user interface prototype or application
+#   built by xib, the old X-Icon Interface Builder, into a skeletal
+#   application of the form used by vib, the new Visual Interface
+#   Builder.  The resulting file is a working application containing
+#   all the vidgets (buttons, sliders, etc.) from the input file but
+#   none of the user Icon code.  This must be added manually.  Some
+#   of the vidget sizes may be incorrect; load and save the file in
+#   vib to fix this.
+#
+#   usage:  uix [file]
+#
+#      Input is read from the named file, or from standard input if
+#   none is specified.  Output is written to standard output.
+#
+############################################################################
+#
+#  Requires:  Version 9
+#
+############################################################################
+
+$define YOFF 78		# offset incorporated in y values by XIB
+
+$define FONT "lucidasanstypewriter-bold-12"	# VIB Font
+
+record ob(t, c, v, x, y, w, h, l, s, n, i, j, k, etc)
+# type callback var x,y,w,h lbl style number initval min max other
+
+
+#  main program
+
+procedure main(args)
+   local f, line, data, objs, recs, curr, o, fmt, r, c, v, i
+
+   # open file, skip to data
+   if *args = 0 then
+      f := &input
+   else
+      f := open(args[1]) | stop(&progname, ": can't open ", args[1])
+   while line := read(f) | stop(&progname, ": EOF hit before finding data") do
+      if match("# Session Code:", line) then break
+
+   # read data
+   objs := []				# list of objects
+   curr := []				# fields of current object
+   while line := read(f) do {
+      data := line[3:0]
+      # in the following, special case lets Scrollbar consume Slider
+      if data[-5:0] == "_Obj:" & (*curr ~= 1 | *objs == 0) then
+         put(objs, curr := [])
+      put(curr, data)
+      }
+   close(f)
+
+   # define interpretations
+   fmt := table()
+   fmt["Sizer"]		:= "txywh"
+   fmt["Button"]	:= "tcv.xywhl...sn.."
+   fmt["Check"]		:= "tcv.xywh.."
+   fmt["Text_Input"]	:= "tcv.xywh.lin.."
+   fmt["Scrollbar"]	:= "t.cnv.xywh.jkis...cnv.jkxywh..."
+   fmt["Slider"]	:= "tcnv.xywh.jkis..."
+   fmt["Line"]		:= "tcv...xywh....sn"
+   fmt["Rect"]		:= "tcv.xywhn.."
+   fmt["Message"]	:= "tcv.xywhl...."
+   fmt["Radio_Button"]	:= "tcv.xywh...n"
+   fmt["Menu"]		:= "tcv.xywhl..s.."
+
+   # convert object lists into records
+   recs := []				# list of records
+   every o := !objs do {
+      r := ob()				# create empty record
+      f := \fmt[o[1][1:-5]] | {		# find appropriate format
+         write(&progname, ": vidget type ", o[1], " unrecognized")
+         next
+         }
+      f ? while c := move(1) do {	# get next char from format
+         v := get(o) | ""		# get next value, default ""
+         if c ~== "." then
+            r[c] := v			# store in rec field named by format
+         }
+      adjust(r)				# clean up special cases
+      r.etc := o			# save leftovers in "etc" field
+      put(recs, r)			# put record on list
+      }
+
+   # write UI program
+   prologue()
+   write(
+      "#===<<vib:begin>>===\tmodify using vib; do not remove this marker line")
+   write("procedure ui(win, cbk)")
+   write("return vsetup(win, cbk,")
+   every output(!recs)			# output spec for each line
+   write("   )")
+   write("end")
+   write("#===<<vib:end>>===\tend of section maintained by vib")
+end
+
+
+#  adjust(r) -- clean up record fields including type-dependent cases
+
+procedure adjust(r)
+   /r.v := ""				# default varname to "" not &null
+   \r.y -:= YOFF			# subtract xib header from y value
+   r.t := r.t[1:-5]			# chop "_Obj" off name
+   case r.t of {
+      "Sizer": {			# Sizer (overall setup) vidget:
+         r.s := FONT			# add font expected by VIB
+         }
+      "Line": {				# Line vidget:
+         \r.h -:= YOFF			# "height" is really 2nd y coordinate
+         }
+      "Text_Input": {			# Text vidget:
+         r.t := "Text"			# simplify name
+         r.l ||:= "\\\\=" || r.i	# concatenate initial value
+         }
+      "Slider" | "Scrollbar": {		# Slider, Scrollbar:
+         r.l := r.j || "," || r.k || "," || r.i	# add bounds and init value
+         }
+      "Message": {			# Message vidget:
+         r.t := "Label"			# change name
+         }
+      "Radio_Button": {			# Radio_Button vidget:
+         r.t := "Choice"		# simplify name
+         }
+      }
+   return
+end
+
+
+#  prologue() -- write boilerplate prologue to acual spec
+
+procedure prologue()
+every write(![
+   "#  User interface specification translated to vib format by uix",
+   "#  (Load and save this file once in vib to correct size information.)",
+   "#",
+   "#  This is a working program that responds to vidget events by printing",
+   "#  messages.  Use a text editor to replace this skeletal program with your",
+   "#  own code.  Retain the vib section at the end and use vib to make any",
+   "#  changes to the interface.",
+   "#",
+   "#  When a callback is generated, but there is no callback procedure, a",
+   "#  message is printed.  Remove the vecho argument below to prevent this.",
+   "",
+   "link vsetup",
+   "",
+   "procedure main()",
+   "   local vidgets",
+   "",
+   "   vidgets := ui(, vecho)\t\t\t# set up vidgets",
+   "   GetEvents(vidgets[\"root\"], QuitCheck)\t# enter event loop",
+   "end",
+   "",
+   "",
+   ""])
+end
+
+
+#  output(r) -- output one record in vib format
+
+procedure output(r)
+   if /r.t then
+      fail
+   writes("   [\"")
+   writes(r.v, ":", r.t, ":", r.s, ":", r.n, ":")
+   writes(r.x, ",", r.y, ",", r.w, ",", r.h, ":")
+   writes(r.l, "\",", r.c)
+   if r.t == "Menu" then
+      outmenu(r.etc)
+   else if *r.etc > 0 then {
+      writes(",\n      [", image(get(r.etc)))
+      while writes(",", image(get(r.etc)))
+      writes("]")
+      }
+   write("],")
+   return
+end
+
+
+#  outmenu(lst) -- output a list of menu entries
+
+procedure outmenu(lst)
+   local msize
+
+   msize := get(lst)
+   if msize = 0 then
+      return
+   writes(",\n      [")
+   outentry(lst)
+   every 2 to msize do {
+      writes(",")
+      outentry(lst)
+      }
+   writes("]")
+   return
+end
+
+
+#  outentry(lst) -- output menu entry
+
+procedure outentry(lst)
+   writes(image(get(lst)))	# output label
+   get(lst)			# skip unused data
+   get(lst)
+   outmenu(lst)			# output submenu (if any)
+   return
+end
diff --git a/ipl/gprogs/unitgenr.icn b/ipl/gprogs/unitgenr.icn
new file mode 100644
index 0000000..53da108
--- /dev/null
+++ b/ipl/gprogs/unitgenr.icn
@@ -0,0 +1,103 @@
+############################################################################
+#
+#	File:     unitgenr.icn
+#
+#	Subject:  Program to produce unit generators of patterna
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 13, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  BLPs are read from standard input and their unit generators written
+#  to standard output.
+#
+#  The following command line option is supported:
+#
+#	-c	assume complete repeats; default, do not
+#
+############################################################################
+#
+#  Links:  factors, options, patutils, patxform
+#
+############################################################################
+
+link factors
+link options
+link patutils
+link patxform
+
+global switch
+
+procedure main(args)
+   local opts, oldpat, pattern
+
+   opts := options(args, "c")
+   switch := if /opts["c"] then 1 else &null
+
+   while oldpat := read() do {
+      every 1 to 10 do { 			# SAFETY!
+         pattern := rows2pat(unit(pat2rows(oldpat)))
+         if pattern == oldpat then break
+         oldpat := pattern
+         }
+      write(pattern)
+      }
+      
+end
+
+procedure unit(grid)
+
+   grid := grepeat(grid)
+
+   grid := grepeat(protate(grid))
+
+   return protate(grid, -90)
+
+end
+
+procedure grepeat(grid)		#: reduce grid to smallest repeat
+   local i, width, j, periods
+
+   grid := copy(grid)
+
+   periods := []
+
+   width := *grid[1]
+
+   if /switch then {		# assume no partial repeats
+      every i := 1 to *grid do
+         put(periods, xperiod(grid[i]) | width)
+      width >:= lcml ! periods
+      every i := 1 to *grid do
+         grid[i] := left(grid[i], width)
+      return grid
+      }
+   else {
+      every i := 1 to width do {
+         every j := 1 to *grid do {
+            grid[j] == extend(grid[j][1+:i], width) | break next
+            }
+         break
+         }
+      every j := 1 to *grid do
+         grid[j] := left(grid[j], i)
+      return grid
+      }
+         
+end
+
+procedure xperiod(s)
+   local i
+
+   every i := 1 | divisors(*s) do
+      if extend(s[1+:i], *s) == s then return i
+
+   fail
+
+end
diff --git a/ipl/gprogs/viewpane.icn b/ipl/gprogs/viewpane.icn
new file mode 100644
index 0000000..e02a452
--- /dev/null
+++ b/ipl/gprogs/viewpane.icn
@@ -0,0 +1,195 @@
+############################################################################
+#
+#	File:     viewpane.icn
+#
+#	Subject:  Program to view image through a "pane"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 27, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program loads images and uses scroll bars to pan over parts
+#  of an image that is larger than the viewing pane.
+#
+#  This program is intended primarily as an example of a simple
+#  application with a visual interface.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  dialog, vsetup
+#
+############################################################################
+
+link dialog
+link vsetup
+
+global view_xoff, view_yoff			# upper-left corner of pane
+global view_width, view_height			# view-pane dimensions
+global x_fact, y_fact				# image scaling values
+global image_win				# image window
+global image_width, image_height		# image dimensions
+global xpos, ypos				# upper-left corner of image
+global hbar, vbar				# scrolling vidgets
+
+procedure main()
+   local vidgets
+
+   vidgets := ui()				# set up interface
+
+   view_xoff := vidgets["port"].ax + 1		# get pane information
+   view_yoff := vidgets["port"].ay + 1
+   view_width := vidgets["port"].aw - 1
+   view_height := vidgets["port"].ah - 1
+
+   hbar := vidgets["hbar"]			# horizontal scroll bar
+   vbar := vidgets["vbar"]			# vertical scroll bar
+
+   GetEvents(vidgets["root"], , shortcuts)	# enter event loop
+
+end
+
+
+#  Process event for the file menu.
+
+procedure file_cb(vidget, menu)
+
+   case menu[1] of {
+      "open  @O":   image_open()
+      "quit  @Q":   exit()
+      }
+
+   return
+
+end
+
+#  Check for keyboard shortcuts.
+
+procedure shortcuts(e)
+
+   case &meta & map(e) of {			# fold case
+      "o":  image_open()
+      "q":  exit()
+      }
+
+   return
+
+end
+
+#  Open image file.
+
+procedure image_open()
+
+      case OpenDialog() of {
+         "Okay": {
+            WClose(\image_win)
+            image_win := WOpen("image=" || dialog_value, "canvas=hidden") | {
+               Notice("Cannot open image file")
+               fail
+               }
+            setup_win(image_win)
+            return
+            }
+         "Cancel":  fail
+         }
+
+end
+
+#  Process event for horizontal scroll bar.
+
+procedure horiz_cb(vidget, val)
+
+   if /image_win then return			# don't do anything if no image
+
+   xpos := val * x_fact
+
+   copy_image()
+
+   return
+
+end
+
+#  Process event for vertical scroll bar.
+
+procedure vert_cb(vidget, val)
+
+   if /image_win then return			# don't do anything if no image
+
+   ypos := val * y_fact
+
+   copy_image()
+
+   return
+
+end
+
+#  Process event for "hide" button.
+
+procedure hide_cb(vidget, val)
+
+   if /image_win then return			# don't do anything if no image
+
+   if val === 1 then
+      FillRectangle(view_xoff, view_yoff, view_width, view_height)
+   else copy_image()
+
+   return
+
+end
+
+#  Utility procedure for copying image.
+
+procedure copy_image()
+
+   CopyArea(image_win, &window, xpos, ypos, view_width, view_height,
+      view_xoff, view_yoff)
+
+   return
+
+end
+
+#  Procedure to set up window.
+
+procedure setup_win(win)
+
+   EraseArea(view_xoff, view_yoff, view_width, view_height)
+   image_width := real(WAttrib(win, "width"))
+   image_height := real(WAttrib(win, "height"))
+   x_fact := 1.0 - view_width / image_width	# set up x and y factors
+   y_fact := 1.0 - view_height / image_height
+   x_fact <:= 0.0
+   y_fact <:= 0.0
+   x_fact *:= image_width
+   y_fact *:= image_height
+   VSet(hbar, 0.0)				# reset the scroll bars
+   VSet(vbar, 0.0)
+   xpos := ypos := 0
+   copy_image()					# place image
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:lucidasanstypewriter-bold-12::0,0,455,410:View",],
+   ["file:Menu:pull::29,1,36,21:File",file_cb,
+      ["open  @O","quit  @Q"]],
+   ["hbar:Scrollbar:h:1:30,362,300,18:0.0,1.0,0.5",horiz_cb],
+   ["hide:Button:regular:1:382,60,45,20:Hide",hide_cb],
+   ["line:Line:solid:1:0,25,455,25:",],
+   ["port:Rect::1:30,60,300,300:",],
+   ["vbar:Scrollbar:v:1:332,60,18,300:0.0,1.0,0.5",vert_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprogs/vqueens.icn b/ipl/gprogs/vqueens.icn
new file mode 100644
index 0000000..585a682
--- /dev/null
+++ b/ipl/gprogs/vqueens.icn
@@ -0,0 +1,222 @@
+############################################################################
+#
+#	File:     vqueens.icn
+#
+#	Subject:  Program to display solutions to the n-queens problem
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 5, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Adapted from a text-display version by Steve Wampler.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+global solution
+global black_queen, white_queen
+
+$define Edge	 4
+$define Offset  40
+$define Size	44
+
+global queens
+
+procedure main(args)
+   local i, opts, wsize, bqueen, wqueen
+
+   opts := options(args,"n+")
+   queens := \opts["n"] | 8
+   if queens <= 0 then stop("-n needs a positive numeric parameter")
+   wsize := queens * Size + 2 * Offset
+
+
+   WOpen("size=" || wsize || "," || wsize, "label=" || queens ||
+      "-queens") | stop("*** cannot open window")
+   black_queen := WOpen("canvas=hidden", "size=41,41") |
+      stop("*** cannot open window for black queen")
+   white_queen := WOpen("canvas=hidden", "size=41,41") |
+      stop("*** cannot open window for white queen")
+
+   DrawImage(black_queen, 0, 0,
+      "41,c1,_
+      66666666666666666666666666666666666666666_
+      66666666666666666666666666666666666666666_
+      66666666666666666666666666666666666666666_
+      66666666666664003666666663004666666666666_
+      66666666666650000466666640000566666666666_
+      66666666666640000366666630000466666666666_
+      66666666666660000566666650000666666666666_
+      66666666666665224666666664225666666666666_
+      66663346666666644666666664466666666433666_
+      66620004666666631666666661366666664000266_
+      66600002666666640666666660466666662000066_
+      66600003666666650466666640566666663000066_
+      66640026666666660166666610666666666200466_
+      66666651666666660046666400666666661566666_
+      66666662266666660026666200666666622666666_
+      66666666036666660004663000666666306666666_
+      66666666403666640000220000466663046666666_
+      66666666620266620000000000266620266666666_
+      66666666650002100000000000012000566666666_
+      66666666663000000000000000000003666666666_
+      66666666666000000000000000000006666666666_
+      66666666666300000000000000000036666666666_
+      66666666666500000000000000000056666666666_
+      66666666666610000000000000000166666666666_
+      66666666666630000000000000000366666666666_
+      66666666666652222222222222222566666666666_
+      66666666666664444444444444444666666666666_
+      66666666666640000000000000000466666666666_
+      66666666666651000000000000001566666666666_
+      66666666666664000000000000004666666666666_
+      66666666666651000000000000001566666666666_
+      66666666666640000000000000000466666666666_
+      66666666666664444444444444444666666666666_
+      66666666653222222222222222222223566666666_
+      66666666600000000000000000000000066666666_
+      66666666400000000000000000000000046666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666300000000000000000000000036666666_
+      66666666666666666666666666666666666666666_
+      ")
+
+   DrawImage(white_queen, 0, 0,
+      "41,c1,_
+      00000000000000000000000000000000000000000_
+      00000000000000000000000000000000000000000_
+      00000000000026630000000036620000000000000_
+      00000000000166662000000266661000000000000_
+      00000000000266663000000366662000000000000_
+      00000000000066661000000166660000000000000_
+      00000000000014420000000024410000000000000_
+      00033200000000220000000022000000002330000_
+      00466620000000350000000053000000026664000_
+      00666640000000260000000062000000046666000_
+      00666630000000162000000261000000036666000_
+      00266400000000065000000560000000004662000_
+      00000150000000066200002660000000051000000_
+      00000044000000066400004660000000440000000_
+      00000006300000066620036660000003600000000_
+      00000002630000266664466662000036200000000_
+      00000000464000466666666664000464000000000_
+      00000000166645666666666666546661000000000_
+      00000000036666666666666666666630000000000_
+      00000000006666666666666666666600000000000_
+      00000000003666666666666666666300000000000_
+      00000000001666666666666666666100000000000_
+      00000000000566666666666666665000000000000_
+      00000000000366666666666666663000000000000_
+      00000000000144444444444444441000000000000_
+      00000000000022222222222222220000000000000_
+      00000000000266666666666666662000000000000_
+      00000000000156666666666666651000000000000_
+      00000000000026666666666666620000000000000_
+      00000000000156666666666666651000000000000_
+      00000000000266666666666666662000000000000_
+      00000000000022222222222222220000000000000_
+      00000000134444444444444444444431000000000_
+      00000000666666666666666666666666000000000_
+      00000002666666666666666666666666200000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000003666666666666666666666666300000000_
+      00000000000000000000000000000000000000000_
+      00000000000000000000000000000000000000000_
+      ")
+
+   DrawBoard()
+
+   solution := list(queens)	# ... and a list of column solutions
+
+   every q(1)			# start by placing queen in first column
+
+   until WQuit()
+
+end
+
+# q(c) - place a queen in column c.
+#
+procedure q(c)
+   local r
+   static up, down, rows
+   initial {
+      up := list(2 * queens - 1, 0)
+      down := list(2 * queens - 1, 0)
+      rows := list(queens, 0)
+      }
+   every 0 = rows[r := 1 to queens] = up[queens+r-c] = down[r+c-1] &
+      rows[r] <- up[queens+r-c] <- down[r+c-1] <- 1        do {
+         solution[c] := r	# record placement.
+         if c = queens then show()
+         else q(c + 1)		# try to place next queen.
+         }
+end
+
+# show the solution on a chess board.
+#
+procedure show()
+   local i, j, queen
+
+   every i := 1 to *solution do {
+      j := solution[i] 
+      queen := if (i + j) % 2 = 0 then black_queen else white_queen
+      CopyArea(queen, &window, , , , , Offset + (i - 1) * Size + 1,
+         Offset + (j - 1) * Size + 1)
+      }
+
+   WDelay(500)
+
+   while *Pending() > 0 do {
+      case Event() of {
+         "q":  exit()
+         "p":  until Event() === "c"
+         }
+      }
+
+   every i := 1 to *solution do {
+      j := solution[i] 
+      if (i + j) % 2 = 1 then Fg("black") else Fg("white")
+      FillRectangle(Offset + (i - 1) * Size, Offset + (j - 1) * Size,
+         Size, Size)
+      }
+
+   return
+
+end
+
+procedure DrawBoard()
+   local i, j
+
+   every i := 0 to queens - 1 do
+      every j := 0 to queens - 1 do
+         if (i + j) % 2 = 1 then
+            FillRectangle(Offset + i * Size, Offset + j * Size,
+               Size, Size)
+   DrawRectangle(Offset - 1, Offset - 1, queens * Size + 1,
+      queens * Size + 1)
+   DrawRectangle(Offset - Edge - 1, Offset - Edge - 1,
+      queens * Size + 2 * Edge + 1, queens * Size + 2 * Edge + 1)
+
+   return
+
+end
diff --git a/ipl/gprogs/webimage.icn b/ipl/gprogs/webimage.icn
new file mode 100644
index 0000000..2b913fc
--- /dev/null
+++ b/ipl/gprogs/webimage.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     webimage.icn
+#
+#	Subject:  Program to produce Web page for image files
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes the names of image files on the command line and
+#  writes a Web page that embeds each image.
+#
+#  The following options are supported:
+#
+#	-a s	alignment, default "bottom"
+#	-t s	title for page; default "untitled"
+#	-n	include file names; default no names
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  options, wopen
+#
+############################################################################
+
+link options
+link wopen
+
+record dim(w, h)
+
+procedure main(args)
+   local name, opts, title, dim, align, names
+
+   opts := options(args, "t:a:n")
+   title := \opts["t"] | "untitled"
+   align := \opts["a"] | "bottom"
+   names := opts["n"]
+
+   write("<html><head><title>", title, "</title></head><body>")
+
+   every name := !args do {
+      dim := image_size(name) | {
+         write(&errout, "*** cannot open image file ", image(name))
+         next
+         }
+      write(
+         if \names then name else "",
+         "<p><img src=\"",
+         name,
+         "\" width=\"",
+         dim.w,
+         "\" height=\"",
+         dim.h,
+         "\" align=\"",
+         align,
+         "\"></p>"
+         )
+      }
+   write("</body></html>")
+
+end
+
+procedure image_size(name)			#: size of GIF file
+   local win, size
+
+   win := WOpen("canvas=hidden", "image=" || name) | fail
+
+   size := dim(WAttrib(win, "width"), WAttrib(win, "height"))
+
+   WClose(win)
+
+   return size
+
+end
diff --git a/ipl/gprogs/wevents.icn b/ipl/gprogs/wevents.icn
new file mode 100644
index 0000000..383feeb
--- /dev/null
+++ b/ipl/gprogs/wevents.icn
@@ -0,0 +1,140 @@
+############################################################################
+#
+#	File:     wevents.icn
+#
+#	Subject:  Program to report Icon window events
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     wevents reports all the events delivered to an Icon window.
+#  Each event produces a single line of output.  The program terminates
+#  after receiving and reporting a ^C, ^D, or DELETE key event.
+#
+#     Each event is reported both in Icon terms and in terms of its
+#  internal representation.  The output fields on each line are:
+#
+#	&interval (interval since previous event, in milliseconds)
+#	&control, &meta, &shift (modifier keys: c, m, or s if pressed)
+#	event returned by Event: keyword name, if any, or else image
+#	&x, &y (usually coordinates, but new size for resize event)
+#
+#	image() of the first value on the event queue
+#	hex dump of the second value (modifier flags and x coordinate)
+#	hex dump of the third value (encoded interval and y coordinate)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: hexcvt, options, optwindw
+#
+############################################################################
+
+link hexcvt, options, optwindw
+
+$include "keysyms.icn"
+
+procedure main(args)
+   local w, q, e, xhex, yhex, eimage
+
+   w := optwindow(options(args, winoptions()))
+   WAttrib(w, "resize=on")
+
+   repeat {
+      q := Pending(Active())	# wait until event is queued
+      eimage := right(image(q[1]), 10) | "******"
+      xhex := hexstring(q[2], 8) | "********"
+      yhex := hexstring(q[3], 8) | "********"
+      e := Event(w)
+      write(
+         r(&interval, 5), " ",
+         if &control then "c" else "-",
+         if &meta then "m" else "-",
+         if &shift then "s" else "-",
+         " ", right(evname(e), 10),
+         " @", r(&x, 4), ",", l(&y, 6),
+         eimage, "  ",
+         left(xhex, 4), " ", right(xhex, 4), "  ",
+         left(yhex, 4), " ", right(yhex, 4),
+         )
+      if e === ("\^C" | "\^D" | "\177") then
+         break
+      if e === &resize & &x < 0 & &y < 0 then
+         break
+      }
+end
+
+
+# evname(e) -- translate e into text representation
+
+procedure evname(e)
+   return case e of {
+      &lpress:		"&lpress"
+      &mpress:		"&mpress"
+      &rpress:		"&rpress"
+      &lrelease:	"&lrelease"
+      &mrelease:	"&mrelease"
+      &rrelease:	"&rrelease"
+      &ldrag:		"&ldrag"
+      &mdrag:		"&mdrag"
+      &rdrag:		"&rdrag"
+      &resize:		"&resize"
+      Key_PrSc:		"Key_PrSc"
+      Key_ScrollLock:	"Key_ScrollLock"
+      Key_Pause:	"Key_Pause"
+      Key_Insert:	"Key_Insert"
+      Key_Home:		"Key_Home"
+      Key_PgUp:		"Key_PgUp"
+      Key_End:		"Key_End"
+      Key_PgDn:		"Key_PgDn"
+      Key_Left:		"Key_Left"
+      Key_Up:		"Key_Up"
+      Key_Right:	"Key_Right"
+      Key_Down:		"Key_Down"
+      Key_F1:		"Key_F1"
+      Key_F2:		"Key_F2"
+      Key_F3:		"Key_F3"
+      Key_F4:		"Key_F4"
+      Key_F5:		"Key_F5"
+      Key_F6:		"Key_F6"
+      Key_F7:		"Key_F7"
+      Key_F8:		"Key_F8"
+      Key_F9:		"Key_F9"
+      Key_F10:		"Key_F10"
+      Key_F11:		"Key_F11"
+      Key_F12:		"Key_F12"
+      default:		image(e)
+      }
+end
+
+
+#  r(v, n) -- right-justify image of v in at least n characters
+
+procedure r(v, n)
+   local s
+   s := image(v)
+   if *s < n then
+      s := right(s, n)
+   return s
+end
+
+
+#  l(v, n) -- left-justify image of v in at least n characters
+
+procedure l(v, n)
+   local s
+   s := image(v)
+   if *s < n then
+      s := left(s, n)
+   return s
+end
diff --git a/ipl/gprogs/wheel.icn b/ipl/gprogs/wheel.icn
new file mode 100644
index 0000000..8d1eec1
--- /dev/null
+++ b/ipl/gprogs/wheel.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     wheel.icn
+#
+#	Subject:  Program to show wheel of colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     wheel displays a disk made of randomly colored sectors.  In addition
+#  to the usual window options, the number of sectors may be given.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, random
+#
+############################################################################
+
+link graphics
+link random
+
+$define BevelWidth 2
+$define WindowMargin 10
+
+procedure main(args)
+   local win, gc, w, h, m, a, da, n, ov, i, t
+
+   win := Window("size=400,400", args)
+   n := integer(args[1]) | 18
+
+   m := WindowMargin
+   w := WAttrib("width") - 2 * m
+   h := WAttrib("height") - 2 * m
+   randomize()
+
+   gc := []
+   every 1 to n do
+      put(gc, Shade(Clone(win), ?65535 || "," || ?65535 || "," || ?65535))
+   if *gc = 0 then
+      stop("can't allocate any colors")
+   if n >:= *gc then
+      write(&errout, "using only ", n, " colors")
+
+   da := 2 * &pi / n			# change in angle
+   a := -&pi / 2 - da			# current angle
+   ov := &pi / 1000			# small overlap
+
+   every i := 1 to n do
+      FillArc(gc[i], m, m, w, h, a +:= da, da + ov)
+   WDone(win)
+end
diff --git a/ipl/gprogs/wif2isd.icn b/ipl/gprogs/wif2isd.icn
new file mode 100644
index 0000000..a5a05a0
--- /dev/null
+++ b/ipl/gprogs/wif2isd.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     wif2isd.icn
+#
+#	Subject:  Program to convert WIFs to ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  The following option is supported:
+#
+#	-n s	name; default "untitled"
+#
+#  Note:  The output is an xencoded ISD. 
+#
+#  There is a problem where there is treadling with multiple treadles
+#  and no liftplan.  *Presumably* that treadling can be used like a
+#  liftplan, but without, necessarily, a direct tie-up.  This problem
+#  problem has not been addressed yet.
+#
+#  If there is a liftplan, then a direct tie-up is implied by the
+#  wording in the WIF documentation.  However, that's in the interpretation
+#  of the draft.  The tie-up produced here is the one given in the
+#
+#  If there is a liftplan and a treadling with multiple treadles,
+#  the treadling is ignored.
+#
+#  Also not handled is the possibility of multiple shafts per thread.
+#  This could be dealt with as for the liftplan.  The idea is that
+#  instead of a threading corresponding to a single shaft, there are
+#  some number of different shaft patterns, like there are liftplan
+#  patterns.
+#
+#  The liftplan is represented as concatenated rows of shaft patterns in
+#  the order they first appear.  Thus, the symbols used for them can be
+#  reconstructed with the ISD is processed.
+#
+#  This program does not attempt to detect or correct errors in WIFs,
+#  but it does try to work around some common problems.
+#
+############################################################################
+#
+#  Links:  options, wifisd
+#
+############################################################################
+
+link options
+link wifisd
+
+global data_default
+global data_entries
+global sections
+global wif
+
+procedure main(args)
+   local opts, title, palette
+
+   opts := options(args, "n:")
+
+   title := \opts["n"] | "untitled"
+
+   wif2isd(&input, title)
+
+end
diff --git a/ipl/gprogs/wifs2pdb.icn b/ipl/gprogs/wifs2pdb.icn
new file mode 100644
index 0000000..a3dc896
--- /dev/null
+++ b/ipl/gprogs/wifs2pdb.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     wifs2pdb.icn
+#
+#	Subject:  Program to create palette database from WIFs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 15, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This is a crude version; it does not bother with actually parsing WIF
+#  files and it assumes a color range of 2^16.
+#
+############################################################################
+#
+#  Links:  basename, palettes, xcode
+#
+############################################################################
+
+link basename
+link palettes
+link xcode
+
+global PDB_
+
+procedure main(args)
+   local file, wifname, input, clist, line, range, i
+
+   every file := !args do {
+      wifname := basename(file, ".wif")
+      input := open(file) | {
+         write(&errout, "*** cannot open ", image(file))
+         next
+         }
+      clist := []
+      range := &null
+      while line := trim(map(read(input))) do {
+         if line == "[color table]" then {
+            while line := trim(read(input)) do {
+               if *line = 0 then break
+               line ?:= {
+                  if ="[" then break
+                  tab(upto('=') + 1)
+                  tab(0)
+                  }
+               put(clist, line)
+               }
+            }
+         else if line == "[color palette]" then {
+            while line := trim(map(read(input))) do {
+               if *line = 0 then break
+               line ? {
+                  if ="[" then break
+                  else if ="range=" then {
+                     tab(upto(',') + 1)
+                     range := tab(0) + 1
+                     break
+                     }
+                  }
+               }
+            }
+         }
+      close(input)
+
+      if (\range ~= 65536) then {		# adjust color values
+         every i := 1 to *clist do
+            clist[i] := color_range(clist[i], range) | {
+               write(&errout, "*** bad color specification")
+               break break
+               }
+         }
+      makepalette(wifname, clist) |
+         write(&errout, "*** cannot make palette for ", image(wifname))
+       }
+
+   xencode(PDB_, &output)
+
+end
diff --git a/ipl/gprogs/xbm2pat.icn b/ipl/gprogs/xbm2pat.icn
new file mode 100644
index 0000000..c8dc413
--- /dev/null
+++ b/ipl/gprogs/xbm2pat.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     xbm2pat.icn
+#
+#	Subject:  Program to convert XBM file to pattern specification
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program converts an XBM file to a pattern specification.
+#
+############################################################################
+#
+#  Links: patutils
+#
+############################################################################
+
+link patutils
+
+procedure main(args)
+   local input, rlist
+
+   input := open(args[1]) | stop("*** cannot open image file")
+
+   rlist := []
+   every put(rlist, xbm2rows(input))
+   write(rows2pat(rlist),"	# ", args[1])
+
+end
diff --git a/ipl/gprogs/xformpat.icn b/ipl/gprogs/xformpat.icn
new file mode 100644
index 0000000..1c24735
--- /dev/null
+++ b/ipl/gprogs/xformpat.icn
@@ -0,0 +1,52 @@
+############################################################################
+#
+#	File:     xformpat.icn
+#
+#	Subject:  Program to apply transformation to patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 12, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program takes patterns from standard input and applies a
+#  transformation to each one, writing the results to standard output.
+#  The transformation to be applied is given in terms of command-line
+#  arguments, with the transformation first, followed by any arguments,
+#  as in
+#
+#	xformpat center 32 32
+#
+#  which would attempt to produce a 32x32 centered pattern from each
+#  pattern in standard input.
+#
+#  Warning:  Some transformations can fail.  In cae of failure, no
+#  pattern is written.
+#
+############################################################################
+#
+#  Links:  patxform
+#
+############################################################################
+
+invocable all
+
+link patxform
+
+procedure main(args)
+   local xform, rows
+
+   xform := proc("p" || args[1]) | stop("** invalid transformation")
+
+   while rows := pat2rows(readpatt()) do {
+      get(args)			# a trick here; there's always an extra
+      push(args, rows)
+      write(rows2pat(xform ! args))
+      }
+
+end
diff --git a/ipl/gprogs/xgamma.icn b/ipl/gprogs/xgamma.icn
new file mode 100644
index 0000000..54eca83
--- /dev/null
+++ b/ipl/gprogs/xgamma.icn
@@ -0,0 +1,133 @@
+############################################################################
+#
+#	File:     xgamma.icn
+#
+#	Subject:  Program to configure X color correction
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 14, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Xgamma sets the root window properties that provide device-independent
+#  color under X windows.  Icon derives the default value of the "gamma"
+#  attribute from these properties.
+#
+#  Ideally, color properties would be set automatically based on 
+#  specifications provided by the manufacturer of the monitor.
+#  Lacking such specifications, xgamma synthesizes intensity ramps
+#  for an ideal monitor characterized by a given gamma value.
+#
+#  The phosphor colors, which must also be set, are set to those of a
+#  Sony Trinitron monitor based on values from the X11R5 distribution.
+#
+#  There are three ways to call xgamma:
+#  
+#	xgamma m.n	set color properties using gamma value m.n
+#	xgamma none	remove color properties
+#	xgamma		report gamma attribute inferred by Icon
+#
+#  A pipe to "xcmsdb" is opened, so that program must be in the current
+#  search path.
+#
+#  The default gamma attribute calculated by Icon does not always exactly
+#  match the value set by xgamma.  The reason for this is unclear.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics under X11R5
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+
+link wopen
+
+global ofile
+
+procedure main(args)
+   local gamma
+
+   if *args = 0 then {
+      WOpen("canvas=hidden", "size=200,100") | stop("can't open window")
+      write(left(WAttrib("gamma") + 0.005, 4))
+      return
+      }
+
+   if map(args[1]) == ("none" | "off" | "remove") then {
+      system("xcmsdb -remove")
+      return
+      }
+
+   gamma := real(args[1]) | 2.5
+   ofile := open("xcmsdb", "wp") | stop("can't open pipe to xcmsdb")
+
+   write(ofile, "SCREENDATA_BEGIN        0.3")
+   header()
+   matrices()
+   ramps(gamma)
+   write(ofile, )
+   write(ofile, "SCREENDATA_END")
+end
+
+
+procedure header()
+   every write(ofile, ![
+      "",
+      "    NAME                Unknown monitor",
+      "    PART_NUMBER         3",
+      "    MODEL               Unknown",
+      "    SCREEN_CLASS        VIDEO_RGB",
+      "    REVISION            2.0",
+      ])
+end
+
+
+procedure matrices()
+   # Trinitron specs from X11R5 contrib/clients/xcrtca/monitors
+   every write(ofile, "    ", \![
+      "COLORIMETRIC_BEGIN",
+      "    XYZtoRGB_MATRIX_BEGIN",
+      "         3.061645878834450   -1.278267953801873   -0.444951165661258",
+      "        -1.032702121385028    1.976844500877421    0.008133037520752",
+      "         0.057063919003669   -0.199057800043321    0.779596768525705",
+      "    XYZtoRGB_MATRIX_END",
+      "    RGBtoXYZ_MATRIX_BEGIN",
+      "         0.422396751969335    0.297093836421011    0.237981555762915",
+      "         0.220555266059938    0.660453956058605    0.118990777881458",
+      "         0.025397273061447    0.146890261130091    1.295677359153649",
+      "    RGBtoXYZ_MATRIX_END",
+      "COLORIMETRIC_END",
+      ])
+end
+
+
+procedure ramps(gamma)
+   write(ofile, "    INTENSITY_PROFILE_BEGIN 0 3")
+   every hue("RED" | "GREEN" | "BLUE", gamma)
+   write(ofile, "    INTENSITY_PROFILE_END")
+end
+
+
+procedure hue(c, gamma)
+   local i, x, v
+   static hextab
+   initial every put((hextab := []), !"0123456789abcdef" || !"0123456789abcdef")
+
+   write(ofile, "    INTENSITY_TBL_BEGIN    ", c, "    256")
+   every i := 0 to 255 do {
+      x := hextab[i + 1]
+      v := (i / 255.0) ^ gamma
+      if v < 0.0001 then		# avoid "e" notation
+         v := 0.0
+      write(ofile, "            0x", x, x, " ", left(v, 8, "0"))
+      }
+   write(ofile, "    INTENSITY_TBL_END")
+end
diff --git a/ipl/gprogs/xpmtoims.icn b/ipl/gprogs/xpmtoims.icn
new file mode 100644
index 0000000..2b4c1be
--- /dev/null
+++ b/ipl/gprogs/xpmtoims.icn
@@ -0,0 +1,102 @@
+############################################################################
+#
+#	File:     xpmtoims.icn
+#
+#	Subject:  Program to make Icon images from XPM files
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Usage:  xpmtoims [-d] [-gn | -cn] [file...]
+#
+#  Xpmtoims reads XPM files and writes Icon image strings.
+#  -cn or -gn selects the color palette used; -c1 is the default.
+#  If -d is given, each image is displayed in a window after conversion.
+#
+#  Output is a file of Icon source code suitable for use via $include.
+#  Each image is a string constant with a comment.
+#  Multiple images are separated by commas.
+#
+#  (A window is always required, whether or not anything is displayed,
+#   so that the XPM colors can be converted by the window system.)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: graphics, imscolor, options
+#
+############################################################################
+
+link graphics, imscolor, options
+
+global opts, pal, nwritten
+
+procedure main(args)
+   local fname, f
+
+   # Open the window and process options.
+   Window("size=100,20", args)
+   opts := options(args, "dg+c+")
+   pal := ("c" || \opts["c"]) | ("g" || \opts["g"]) | "c1"
+   PaletteChars(pal) | stop("invalid palette ", pal)
+   ColorValue("navy") |
+      write(&errout, "warning: no X color names, conversion is risky")
+
+   # Convert the file.
+   nwritten := 0
+   if *args = 0 then
+      dofile(&input, "[stdin]")
+   else
+      while fname := get(args) do
+         if f := open(fname) then {
+            dofile(f, fname)
+            close(f)
+            }
+         else {
+            write(&errout, fname, ": can't open")
+            }
+end
+
+
+#  dofile(f, fname) -- process one file.
+
+procedure dofile(f, fname)
+   local s, e
+
+   # Convert the file
+   s := XPMImage(f, pal) | {
+      write(&errout, fname, ": cannot decode")
+      return
+      }
+
+   # Add spacing if this isn't the first image.
+   if (nwritten +:= 1) > 1 then
+      write(",\n")
+
+   # Write the image.
+   write("# xpmtoims -", pal, " ", fname)
+   imswrite(, s)
+   flush(&output)
+
+   # If requested, display the image.
+   if \opts["d"] then {
+      WAttrib("width=" || imswidth(s), "height=" || imsheight(s))
+      EraseArea(0, 0)
+      DrawImage(0, 0, s)
+      while e := Event() do case e of {
+         QuitEvents():	exit()		# quit on "q" etc
+         !" \t\r\n":	break		# continue on "\r" etc
+         }
+      }
+   return
+end
diff --git a/ipl/gprogs/zoomtile.icn b/ipl/gprogs/zoomtile.icn
new file mode 100644
index 0000000..1489660
--- /dev/null
+++ b/ipl/gprogs/zoomtile.icn
@@ -0,0 +1,70 @@
+############################################################################
+#
+#	File:     zoomtile.icn
+#
+#	Subject:  Program to show a tile magnified
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 28, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This program provides an optionally magnified view of a tile.
+#
+#  File names are given on command line. Image files are written to
+#  <basename>_zoom.gif.
+#
+#  Options are:
+#
+#	-z i	zoom factor, default 8
+#	-g	provide grid; only supported if zoom factor > 2
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  basename, options, patutils, win
+#
+############################################################################
+
+link basename
+link options
+link patutils
+link win
+
+procedure main(args)
+   local i, x, y, opts, magnif, pattern, dims, row, pixel, width, height, glist
+   local name, input
+
+   opts := options(args, "z+g")
+   magnif := \opts["z"] | 8
+
+   every name := !args do {
+      input := open(name) | stop("Cannot open ", name)
+      pattern := readpatt(input) | stop("*** no tile specification")
+      close(input)
+   dims := tiledim(pattern)
+   width := magnif * dims.w
+   height := magnif * dims.h
+   win(width, height)
+   glist := []
+   if \opts["g"] & (magnif > 2) then {
+      every y := 0 to height by magnif do
+         DrawLine(0, y, width, y)
+      every x := 0 to width by magnif do
+         DrawLine(x, 0, x, height)
+      }
+   DrawTile(0, 0, pattern, , magnif)
+      WriteImage(basename(name, ".blp") || "_zoom.gif")
+      WClose(&window)
+      &window := &null
+      }
+
+end