Initial upstream version 9.4.3upstream/9.4.3

140 files changed, 28214 insertions, 0 deletions

diff --git a/ipl/gprocs/attribs.icn b/ipl/gprocs/attribs.icn
new file mode 100644
index 0000000..612eca6
--- /dev/null
+++ b/ipl/gprocs/attribs.icn
@@ -0,0 +1,127 @@
+############################################################################
+#
+#	File:     attribs.icn
+#
+#	Subject:  Procedure to set attributes via dialog
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a dialog in which the user can change
+#  the most commonly used graphics attributes.
+#
+#  Problems:  If a text-entry field is not long enough to hold the current
+#  value for an attribute, the attribute has to be edited.  Also, a
+#  slider is not the best way of changing the gamma attribute -- it's
+#  not possible to set a precise value.  A slider was used mostly for
+#  demonstration purposes.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  dsetup
+#
+############################################################################
+
+link dsetup				# dialog setup
+
+procedure attribs(win)		#: set graphics attributes via dialog
+   static atts
+
+   initial atts := table()		# table of vidget IDs
+
+   /win := &window
+
+   # Assign values from current attributes.
+
+   atts["1_fg"] := Fg(win)
+   atts["2_bg"] := Bg(win)
+   atts["3_font"] := Font(win)
+   atts["4_linewidth"] := WAttrib(win, "linewidth")
+   atts["5_pattern"] := WAttrib(win, "pattern")
+   atts["linestyle"] := WAttrib(win, "linestyle")
+   atts["fillstyle"] := WAttrib(win, "fillstyle")
+   atts["gamma"] := WAttrib(win, "gamma")
+
+   # Call up the dialog.
+
+      repeat {
+   
+      attributes(win, atts) == "Okay" | fail
+
+      # Set attributes from table.
+   
+      Fg(win, atts["1_fg"]) | {
+         Notice("Invalid foreground color.")
+         next
+         }
+      Bg(win, atts["2_bg"]) | {
+         Notice("Invalid background color.")
+         next
+         }
+      Font(win, atts["3_font"]) | {
+         Notice("Invalid font.")
+         next
+         }
+      WAttrib(win, "linewidth=" || integer(atts["4_linewidth"])) | {
+         Notice("Invalid linewidth.")
+         next
+         }
+      WAttrib(win, "pattern=" || atts["5_pattern"]) | {
+            Notice("Invalid pattern.")
+            next
+            }
+      WAttrib(win, "linestyle=" || atts["linestyle"])
+      WAttrib(win, "fillstyle=" || atts["fillstyle"])
+      WAttrib(win, "gamma=" || atts["gamma"])
+
+      return
+
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure attributes(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["attributes:Sizer::1:0,0,370,400:attributes",],
+   ["0.5:Label:::105,204,21,13:0.5",],
+   ["1.0:Label:::135,203,21,13:1.0",],
+   ["1_fg:Text::35:10,20,339,19:        fg: \\=",],
+   ["2.0:Label:::199,203,21,13:2.0",],
+   ["2_bg:Text::35:10,52,339,19:        bg: \\=",],
+   ["3.0:Label:::261,204,21,13:3.0",],
+   ["3_font:Text::35:11,80,339,19:      font: \\=",],
+   ["4.0:Label:::324,204,21,13:4.0",],
+   ["4_linewidth:Text::3:11,110,115,19:line width: \\=",],
+   ["5_pattern:Text::35:11,140,339,19:   pattern: \\=",],
+   ["button1:Button:regular::206,350,60,30:Cancel",],
+   ["fill label:Label:::202,241,70,13:fill style",],
+   ["fillstyle:Choice::3:195,262,85,63:",,
+      ["solid","textured","masked"]],
+   ["gamma:Slider:h:1:97,174,253,20:0.5,4.0,1.0",],
+   ["glabel:Label:::11,176,84,13:     gamma: ",],
+   ["line label:Label:::100,241,70,13:line style",],
+   ["linestyle:Choice::3:96,262,78,63:",,
+      ["solid","striped","dashed"]],
+   ["okay:Button:regular:-1:106,350,60,30:Okay",],
+   ["tick1:Line:::117,196,117,201:",],
+   ["tick2:Line:::146,195,146,200:",],
+   ["tick3:Line:::209,195,209,200:",],
+   ["tick4:Line:::272,195,272,200:",],
+   ["tick5:Line:::335,195,335,200:",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/autopost.icn b/ipl/gprocs/autopost.icn
new file mode 100644
index 0000000..138814b
--- /dev/null
+++ b/ipl/gprocs/autopost.icn
@@ -0,0 +1,71 @@
+############################################################################
+#
+#	File:     autopost.icn
+#
+#	Subject:  Procedures to activate PostScript recorder
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 11, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   These procedures, when linked with an unsuspecting Icon program,
+#   cause psrecord (q.v) to begin recording PostScript commands when
+#   an X window is opened.  This is done by overloading the built-in
+#   "open" function.
+#
+#   The results of this may or may not be usable depending on how the
+#   original program is coded.  Psrecord cannot emulate all the X calls
+#   and works best with programs designed for it.
+#
+#   "stop" and "exit" are also overloaded to try and terminate the
+#   PostScript file properly.  Other program exit paths, notably a
+#   return from the main procedure, are not caught.
+#
+############################################################################
+#
+#  Links:  psrecord
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link psrecord
+
+invocable "open", "stop", "exit"
+
+procedure open(args[])
+   local f
+   static realfunc
+   initial realfunc := proc("open", 0)
+
+   f := (realfunc ! args) | fail
+   if args[2] ? upto('gx') then
+      PSEnable(f)
+   return f
+end
+
+procedure stop(args[])
+   local f
+   static realfunc
+   initial realfunc := proc("stop", 0)
+
+   PSDone()
+   return realfunc ! args
+end
+
+procedure exit(args[])
+   local f
+   static realfunc
+   initial realfunc := proc("exit", 0)
+
+   PSDone()
+   return realfunc ! args
+end
diff --git a/ipl/gprocs/barchart.icn b/ipl/gprocs/barchart.icn
new file mode 100644
index 0000000..5522ebb
--- /dev/null
+++ b/ipl/gprocs/barchart.icn
@@ -0,0 +1,212 @@
+############################################################################
+#
+#	File:     barchart.icn
+#
+#	Subject:  Procedures for dynamically growing barchart
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures draw barcharts that can grow dynamically.
+#
+#	barchart(win, x, y, dx, dy, sf, n, l, w, b) creates a barchart.
+#
+#	setbar(bc, n, v)	sets the value of a bar.
+#
+#	rebar(bc, sf)		redraws a barchart with a new scaling factor.
+#
+############################################################################
+#
+#   barchart(win, x, y, dx, dy, sf, n, l, w, b) -- establish a barchart
+#
+#	win      window
+#	x,y      position of base of first bar
+#	dx,dy    distance to base of second bar (either dx or dy should be
+#		  zero)
+#	sf       scaling (pixels per unit of value, + or -, need not be
+#		  integer)
+#	n        number of bars
+#	l,w      length (maximum) and width of one bar
+#	b        logarithmic base, if bars are to be scaled logarithmically
+#
+#	barchart() establishes structures for building a barchart.  Any of the
+#	eight possible orthogonal orientations can be selected depending on the
+#	signs of dx, dy, and sf.
+#
+#	The absolute value of sf establishes a linear scaling from barchart
+#	values to number of pixels.  Scaling is handled such that a value of 1
+#	makes the first mark on a bar and then each increment of sf lengthens
+#	the bar by one pixel.  If a bar would exceed the limit then the entire
+#	chart is rescaled so that only half the range is then used.
+#
+#   setbar(bc, n, v) - set bar n of barchart bc to represent value v
+#
+#	It is assumed that v>0 and that bars never shrink; but they may grow.
+#
+#   rebar(bc, sf) - redraw barchart with new scaling factor sf.
+#
+#	sf is assumed to be of the same sign as the previous scaling factor.
+#
+#   Example:
+#
+#	Suppose "scores" is a list of scores ranging from 0 to 100.
+#	This code fragment dynamically draws a histogram using 21 bins.
+#
+#	The call to barchart() specifies:
+#	    The lower left-hand corner of the barchart is (10, 190).
+#	    The next bar is 10 pixels to its right, which would be (20, 190).
+#	    The bars grow upward, to smaller y values, so the scaling factor
+#	    is negative; each score will grow its bar by 5 pixels.
+#	    Each bar grows to a maximum length of 180 pixels; the width is 8.
+#	    No base is given, so scaling is linear.
+#
+#	bc := barchart(win, 10, 190, 10, 0, -5, 21, 180, 8)
+#	b := list(21, 0)		# histogram bins
+#	every n := !scores do {
+#	    i := n / 5			# bin (and bar) number
+#	    b[i] +:= 1			# increment bin count
+#	    setbar(bc, i, b[i])		# update display
+#	    }
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record BC_rec(win, x, y, dx, dy, sf, n, l, w, b, len, val, round)
+
+procedure barchart(win, x, y, dx, dy, sf, n, l, w, b)	#: draw barchart
+   local bc
+   bc := BC_rec(win, x, y, dx, dy, sf, n, l, w, b)
+   bc.len := list(n, 0)
+   bc.val := list(n)
+   if sf > 0 then
+      bc.round := 0.99999
+   else
+      bc.round := -0.99999
+   rebar(bc, sf)				# clear area
+   return bc
+end
+
+
+## setbar(bc, n, v) - set bar n of barchart bc to represent value v
+#
+#  It is assumed that v>0 and that bars never shrink; but they may grow.
+
+procedure setbar(bc, n, v)			#: set bar value on barchart
+   local x, y, o, oldlen, newlen, incr
+
+   v := log(v, \bc.b)
+   oldlen := bc.len[n] | fail
+   newlen := integer(v * bc.sf + bc.round)
+
+   if abs(newlen) > bc.l then {
+      # need to rescale first
+      rebar(bc, 0.5 * bc.sf * real(bc.l) / real(abs(newlen-1)))
+      return setbar(bc, n, v)
+      }
+
+   # lengthen the bar
+   if (incr := newlen - oldlen) ~= 0 then {
+      if bc.dx ~= 0 then {
+
+         # horizontal baseline
+         x := bc.x + (n - 1) * bc.dx
+         y := bc.y + oldlen
+         if incr < 0 then
+            FillRectangle(bc.win, x, y + incr, bc.w, -incr)
+         else
+            FillRectangle(bc.win, x, y, bc.w, incr)
+         }
+
+      else {
+
+         # vertical baseline
+         x := bc.x + oldlen
+         y := bc.y + (n - 1) * bc.dy
+         if incr < 0 then
+            FillRectangle(bc.win, x + incr, y, -incr, bc.w)
+         else
+            FillRectangle(bc.win, x, y, incr, bc.w)
+         }
+      bc.len[n] := newlen
+      bc.val[n] := v
+      }
+   return
+end
+
+
+## rebar(bc, sf) - redraw barchart with new scaling factor sf.
+#
+#  sf is assumed to be of the same sign as the previous scaling factor.
+
+procedure rebar(bc, sf)				#: redraw barchart
+   local i, l, x, y, dx, dy
+
+   if bc.sf > 0 then
+      l := bc.l
+   else
+      l := -bc.l
+   x := bc.x
+   y := bc.y
+
+   if bc.dx ~= 0 then {
+      dx := bc.n * bc.dx
+      dy := l
+      }
+   else {
+      dx := l
+      dy := bc.n * bc.dy
+      }
+
+   # force all values positive (negative is wrong, but works under OpenWindows!)
+   if dx < 0 then {
+      x +:= dx
+      dx := -dx
+      }
+   if dy < 0 then {
+      y +:= dy
+      dy := -dy
+      }
+   EraseArea(bc.win, x, y, dx, dy)
+
+   bc.len := list(bc.n, 0)
+   bc.sf := sf
+   every i := 1 to *bc.len do
+      setbar(bc, i, \bc.val[i])
+   return
+end
+
+
+#  ## test program
+#  #
+#  #  usage:  barchart [dx [dy [sf]]]
+#  #
+#  #  background is deliberately different in order to see what gets cleared
+#
+#  procedure main(args)
+#     local dx, dy, sf, win, n, l, bc, i
+#     dx := args[1] | 5
+#     dy := args[2] | 0
+#     sf := args[3] | -1
+#     win := open("bars", "g", "width=500", "height=500")
+#     l := list(50, 0)
+#     bc := barchart(win, 250, 250, dx, dy, sf, *l, 200, 4)
+#     Fg(win, "papayawhip")
+#     FillRectangle(win, 0, 0, 500, 500)
+#     Fg(win, "black")
+#     every 1 to 5000 do {
+#        i := ?5 + ?5 + integer(10 * log(1+20*?0))	# nonuniform random bar
+#        setbar(bc, i, l[i] +:= 1)
+#        flush(win)
+#        }
+#     while not upto('qQ', reads(win))
+#     end
diff --git a/ipl/gprocs/bevel.icn b/ipl/gprocs/bevel.icn
new file mode 100644
index 0000000..fa9c849
--- /dev/null
+++ b/ipl/gprocs/bevel.icn
@@ -0,0 +1,534 @@
+############################################################################
+#
+#	File:     bevel.icn
+#
+#	Subject:  Procedures for drawing beveled objects
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures draw objects having a raised or sunken appearance.
+#
+#	BevelReset(win)				sets/resets shading colors.
+#
+#	BevelCircle(win, x, y, r, bw)		draws a beveled circle.
+#
+#	BevelDiamond(win, x, y, r, bw)		draws a beveled diamond.
+#
+#	BevelTriangle(win, x, y, r, o, bw)	draws a beveled triangle.
+#
+#	BevelSquare(win, x, y, r, bw)		draws a beveled square.
+#
+#	FillSquare(win, x, y, r)		fills a square.
+#
+#	FillDiamond(win, x, y, r)		fills a diamond.
+#
+#	FillTriangle(win, x, y, r, o)		fills a triangle.
+#
+#	RidgeRectangle(win, x, y, w, h, bw)	draws a ridged rectangle.
+#
+#	GrooveRectangle(win, x, y, w, h, bw)	draws a grooved rectangle.
+#
+#	BevelRectangle(win, x, y, w, h, bw)	draws a beveled rectangle.
+#
+#	DrawRidge(win, x1, y1, x2, y2, w)	draws a ridged line.
+#
+#	DrawGroove(win, x1, y1, x2, y2, w)	draws a grooved line.
+#
+############################################################################
+#
+#  These procedures allow the drawing of buttons and other objects
+#  with a three-dimensional appearance.  They are intended to be
+#  used like other graphics primitives (DrawRectangle() etc.).
+#  However, this abstraction fails if the background color changes
+#  or if clipping is set, due to the use of cached graphics contexts.
+#
+#  BevelReset(win) -- set/reset colors for beveling
+#	This procedure is called automatically by the others.
+#	It can be called explicitly if the background color is changed.
+#
+#  BevelCircle(win, x, y, r, bw) -- draw beveled circle
+#  BevelDiamond(win, x, y, r, bw) -- draw beveled diamond
+#  BevelTriangle(win, x, y, r, o, bw) -- draw beveled triangle
+#  BevelSquare(win, x, y, r, bw) -- draw beveled square
+#	These procedures draw a figure centered at (x,y) and having
+#	a "radius" of r.  bw is the bevel width, in pixels.
+#       o is the triangle orientation: "n", "s", "e", or "w".
+#
+#  FillSquare(win, x, y, r) -- fill square centered at (x,y)
+#  FillDiamond(win, x, y, r) -- fill diamond centered at (x,y)
+#  FillTriangle(win, x, y, r, o) -- fill triangle centered at (x,y)
+#	These procedures complement the beveled outline procedures
+#	by filling a figure centered at (x,y).  Fillcircle is already
+#	an Icon function and so is not included here.
+#
+#  RidgeRectangle(win, x, y, w, h, bw) -- draw ridged rectangle
+#  GrooveRectangle(win, x, y, w, h, bw) -- draw grooved rectangle
+#  BevelRectangle(win, x, y, w, h, bw) -- draw beveled rectangle
+#	These procedures draw a rectangle with the given external
+#	dimensions and border width.  Beveled rectangles are raised
+#	if bw > 0 or sunken if bw < 0.
+#
+#  DrawRidge(win, x1, y1, x2, y2, w) -- draw a ridged line
+#  DrawGroove(win, x1, y1, x2, y2, w) -- draw a grooved line
+#	These procedures draw a groove or ridge of width 2 at any angle.
+#	If w = 0, a groove or ridge is erased to the background color.
+#
+#  For BevelSquare() and FillSquare(), the width drawn is 2 * r + 1,
+#  not just 2 * r.  This is necessary to keep the visual center at the
+#  specified (x, y) and is consistent with the other centered procedures
+#  and the built-in function FillCircle.
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+$include "vdefns.icn"
+
+link graphics
+
+
+global bev_table
+record bev_record(shadow, hilite)
+
+
+#  BevelReset(win) -- set/reset colors for beveling
+#
+#  Called automatically the first time a beveling procedure is called;
+#  must also be called explicitly if the background color is changed.
+#  (Pale, weak background colors work best with beveling.)
+
+procedure BevelReset(win)	#: set colors for beveled drawing
+   local b, h, l, s, hilite, shadow, lhilite, lshadow
+
+   /win := &window
+   /bev_table := table()
+
+   if b := \bev_table[win] then {
+      Uncouple(b.hilite)
+      Uncouple(b.shadow)
+      b := &null
+      }
+
+   if WAttrib(win, "depth") >= 4 then {
+
+      HLS(ColorValue(Bg(win))) ? {
+         h := tab(many(&digits))
+         move(1)
+         l := tab(many(&digits))
+         move(1)
+         s := tab(0)
+         }
+   
+      case l of {
+          0 <= l < 10 & l:	  { lshadow := 25;	lhilite := 50 }
+         10 <= l < 25 & l:	  { lshadow := 0;	lhilite := l + 25 }
+         25 <= l < 75 & l:	  { lshadow := l - 25;	lhilite := l + 25 }
+         75 <= l < 90 & l:	  { lshadow := l - 25;	lhilite := 100 }
+         default:		  { lshadow := 50;	lhilite := 75 }
+         }
+      s /:= 2
+   
+      shadow := Clone(win, "fg=" || HLSValue(h || ":" || lshadow || ":" || s),
+         "linewidth=1", "linestyle=solid", "fillstyle=solid", "drawop=copy")
+      hilite := Clone(shadow,
+         "fg=" || HLSValue(h || ":" || lhilite || ":" || s))
+      b := bev_record(\shadow, \hilite)
+      }
+
+   if /b then {
+      shadow := Clone(win,
+         "linewidth=1", "linestyle=solid", "fillstyle=solid", "drawop=copy")
+      hilite := Clone(shadow, "fillstyle=textured", "pattern=gray")
+      b := bev_record(shadow, hilite)
+      }
+
+   bev_table[win] := bev_record(shadow, hilite)
+   return win
+end
+
+
+#  bev_lookup(win) -- look up and return bev_record for a window.
+#
+#  (Internal procedure)
+
+procedure bev_lookup(win)
+   local b, dx, dy
+   b := \(\bev_table)[win] | bev_table[BevelReset(win)]
+   dx := "dx=" || WAttrib(win, "dx")
+   dy := "dy=" || WAttrib(win, "dy")
+   every WAttrib(b.shadow | b.hilite, dx, dy)
+   return b
+end
+
+
+#  BevelCircle(win, x, y, r, bw) -- draw beveled circle
+
+procedure BevelCircle(win, x, y, r, bw)		#: draw beveled circle
+   local b, upper, lower, a
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelCircle((\&window | runerr(140)), win, x, y, r)
+   b := bev_lookup(win)
+
+   /r := 6
+   /bw := 2
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   a := -&pi / 8
+   while (bw -:= 1) >= 0 do {
+      DrawCircle(lower, x, y, r, a, &pi)
+      DrawCircle(upper, x, y, r, a + &pi, &pi)
+      r -:= 1
+      }
+   return win
+end
+
+
+#  BevelDiamond(win, x, y, r, bw) -- draw beveled diamond
+
+procedure BevelDiamond(win, x, y, r, bw)	#: draw beveled diamond
+   local b, upper, lower
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelDiamond((\&window | runerr(140)), win, x, y, r)
+   b := bev_lookup(win)
+
+   /r := 6
+   /bw := 3
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   while (bw -:= 1) >= 0 do {
+      DrawLine(lower, x - r, y, x, y + r, x + r, y)
+      DrawLine(upper, x - r, y, x, y - r, x + r, y)
+      r -:= 1
+      }
+   return win
+end
+
+
+#  BevelTriangle(win, x, y, r, o, bw) -- draw beveled triangle
+
+procedure BevelTriangle(win, x, y, r, o, bw)
+   local b, upper, lower
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelTriangle((\&window | runerr(140)), win, x, y, r, o)
+   b := bev_lookup(win)
+
+   /r := 6
+   /bw := 2
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   while (bw -:= 1) >= 0 do {
+      case o of {
+         default: {  #"n"
+            DrawLine(lower, x - r, y + r, x + r, y + r, x, y - r)
+            DrawLine(upper, x - r, y + r, x, y - r)
+            }
+         "s": {
+            DrawLine(lower, x, y + r, x + r, y - r)
+            DrawLine(upper, x, y + r, x - r, y - r, x + r, y - r)
+            }
+         "e": {
+            DrawLine(lower, x - r, y + r, x + r, y)
+            DrawLine(upper, x - r, y + r, x - r, y - r, x + r, y)
+            }
+         "w": {
+            DrawSegment(lower, x - r, y, x + r, y + r, x + r, y + r, x + r, y-r)
+            DrawLine(upper, x - r, y, x + r, y - r)
+            }
+         }
+      r -:= 1
+      }
+   return win
+end
+
+
+#  BevelSquare(win, x, y, r, bw) -- draw beveled square
+
+procedure BevelSquare(win, x, y, r, bw)		#: draw beveled square
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelSquare((\&window | runerr(140)), win, x, y, r)
+   /r := 6
+   return BevelRectangle(win, x - r, y - r, 2 * r + 1, 2 * r + 1, bw)
+end
+
+
+#  RidgeRectangle(win, x, y, w, h, bw) -- draw ridged rectangle
+
+procedure RidgeRectangle(win, x, y, w, h, bw)	#: draw ridged rectangle
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return RidgeRectangle((\&window | runerr(140)), win, x, y, w, h)
+   /bw := 2
+   return GrooveRectangle(win, x, y, w, h, -bw)
+end
+
+
+#  GrooveRectangle(win, x, y, w, h, bw) -- draw grooved rectangle
+
+procedure GrooveRectangle(win, x, y, w, h, bw)	#: draw grooved rectangle
+   local abw
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return GrooveRectangle((\&window | runerr(140)), win, x, y, w, h)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   /bw := 2
+   if bw >= 0 then
+      bw := (bw + 1) / 2
+   else
+      bw := -((-bw + 1) / 2)
+   abw := abs(bw)
+
+   BevelRectangle(win, x, y, w, h, -bw)
+   BevelRectangle(win, x + abw, y + abw, w - 2 * abw, h - 2 * abw, bw)
+   return win
+end
+
+
+#  BevelRectangle(win, x, y, w, h, bw) -- draw beveled rectangle
+#
+#  bw is the border width (>0 for raised bevel, <0 for sunken bevel).
+#  (x,y,w,h) bounds the entire beveled rectangle, not the usable area inside.
+
+procedure BevelRectangle(win, x, y, w, h, bw)	#: draw beveled rectangle
+   local b, upper, lower, xx, yy
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return BevelRectangle((\&window | runerr(140)), win, x, y, w, h)
+   b := bev_lookup(win)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   /bw := 2
+   if bw >= 0 then {
+      upper := b.hilite
+      lower := b.shadow
+      }
+   else {
+      upper := b.shadow
+      lower := b.hilite
+      bw := -bw
+      }
+
+   xx := x + w
+   yy := y + h
+   FillRectangle(lower, x, yy, w, -bw, xx, y, -bw, h)
+
+   while (bw -:= 1) >= 0 do {
+      DrawLine(upper, x, yy -:= 1, x, y, xx -:= 1, y)
+      x +:= 1
+      y +:= 1
+      }
+
+   return win
+end
+
+
+#  DrawRidge(win, x1, y1, x2, y2, w) -- draw a ridged line
+#
+#  If w is negative, a groove is drawn instead.
+
+procedure DrawRidge(win, x1, y1, x2, y2, w)	#: draw ridged line
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return DrawRidge((\&window | runerr(140)), win, x1, y1, x2, y2)
+   /w := 2
+
+   DrawGroove(win, x1, y1, x2, y2, -w)
+   return win
+end
+
+
+#  DrawGroove(win, x1, y1, x2, y2, w) -- draw a grooved line
+#
+#  If w > 0, draw groove of width 2.
+#  If w = 0, erase groove/ridge of width 2.
+#  If w < 0, draw ridge of width 2.
+#
+#  Horizontal and vertical grooves fill the same pixels as lines drawn
+#  linewidth=2.  Angled grooves are not necessarily the same, though.
+
+procedure DrawGroove(win, x1, y1, x2, y2, w)	#: draw grooved line
+   local a, n, b, upper, lower, fg
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return DrawGroove((\&window | runerr(140)), win, x1, y1, x2, y2)
+
+   /w := 2
+   x1 := integer(x1)
+   y1 := integer(y1)
+   x2 := integer(x2)
+   y2 := integer(y2)
+
+   if w ~= 0 then {			# if really drawing
+      b := bev_lookup(win)
+      upper := b.shadow
+      lower := b.hilite
+      }
+   else {
+      fg := Fg(win)			# if erasing, draw in bg color
+      Fg(win, Bg(win))
+      upper := lower := win
+      }
+
+   a := atan(y2 - y1, x2 - x1)
+   if a < 0 then
+      a +:= &pi
+   n := integer(8 * a / &pi)
+
+   if w < 0 then			# if groove/ridge swap
+      upper :=: lower
+   if n = 2 then			# if tricky illumination angle
+      upper :=: lower
+
+   if 2 <= n <= 5 then {		# approximately vertical
+      DrawLine(upper, x1 - 1, y1, x2 - 1, y2)
+      DrawLine(lower, x1, y1, x2, y2)
+      }
+   else {				# approximately horizontal
+      DrawLine(upper, x1, y1 - 1, x2, y2 - 1)
+      DrawLine(lower, x1, y1, x2, y2)
+      }
+
+   Fg(win, \fg)				# restore foreground if changed
+   return win
+end
+
+
+#  FillSquare(win, x, y, r) -- fill square centered at (x,y)
+
+procedure FillSquare(win, x, y, r)		#: draw filled square
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then
+      return FillSquare((\&window | runerr(140)), win, x, y)
+   return FillRectangle(win, x - r, y - r, 2 * r + 1, 2 * r + 1)
+end
+
+
+#  FillDiamond(win, x, y, r) -- fill diamond centered at (x,y)
+
+procedure FillDiamond(win, x, y, r)		#: draw filled diamond
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then
+      return FillDiamond((\&window | runerr(140)), win, x, y)
+   return FillPolygon(win, x - r, y, x, y + r + 1, x + r + 1, y, x, y - r - 1)
+end
+
+
+#  FillTriangle(win, x, y, r, o) -- fill triangle centered at (x,y)
+#
+#  r is "radius" (1/2 of side of enclosing square)
+#  o is orientation ("n", "s", "e", "w")
+
+procedure FillTriangle(win, x, y, r, o)		#: draw filled triangle
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then
+      return FillTriangle((\&window | runerr(140)), win, x, y, r)
+   return case o of {
+      default:  #"n"
+         FillPolygon(win, x - r - 1, y + r + 1, x, y - r, x + r + 1, y + r + 1)
+      "s":
+         FillPolygon(win, x - r, y - r, x, y + r, x + r, y - r)
+      "e":
+         FillPolygon(win, x - r, y - r, x + r, y, x - r, y + r)
+      "w":
+         FillPolygon(win, x + r + 1, y - r - 1, x - r, y, x + r + 1, y + r + 1)
+      }
+end
+
diff --git a/ipl/gprocs/bitplane.icn b/ipl/gprocs/bitplane.icn
new file mode 100644
index 0000000..71e3d52
--- /dev/null
+++ b/ipl/gprocs/bitplane.icn
@@ -0,0 +1,341 @@
+############################################################################
+#
+#	File:     bitplane.icn
+#
+#	Subject:  Procedures for bitplane manipulation
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures allow a window to be treated as a series of
+#	overlapping, independent layers, subject to some fairly severe
+#	restrictions.
+#
+#	AlcPlane(W n)		allocates planes.
+#
+#	FrontPlane(W bp, color)	moves a layer to the front.
+#
+#	BackPlane(W bp, color)	moves a layer to the back.
+#
+#	PlaneOp(W bp, op)	initializes layer operations.
+#
+#	Deplane(W color)	restores a window to normal.
+#
+############################################################################
+#
+#     These procedures allow drawing and erasing in individual bitplanes of
+#  a window.  One way to use bitplanes is to think of them as transparent
+#  panes in front of a solid background.  Each pane can be drawn with a
+#  single color, obscuring the panes beyond (and the background).  A pane
+#  can also be erased, wholly or selectively, exposing what is beyond; and
+#  a pane need not be visible to be drawn or erased.  Panes can be restacked
+#  in a different order, and the color of a pane (or the background) can be
+#  changed.
+#
+#     For example, the pane in back could be drawn with a city map.  The
+#  pane in front of that could be used to lay out bus routes, and the paths
+#  could be erased and rerouted without having to redraw the map.  Using a
+#  third plane in front of those, buses could be moved along the routes
+#  without having to redraw either the routes or the map behind them.
+#
+#     Bitplanes that are allocated together and interact with each other
+#  form a bitplane group.  A bitplane group need not fill the window;
+#  indeed, it can be used in discontiguous portions of a window or even
+#  in multiple windows on the same display.  On the other hand, multiple
+#  bitplane groups can be used different parts of the same window.
+#
+#     Bitplanes are implemented using Icon's mutable colors, and they
+#  are gluttonous of color map entries.  A set of n bitplanes requires
+#  at least 2^n color map entries, so the practical limit of n is 5 or 6.
+#  On the other hand, sets of 2 or 3 bitplanes are relatively cheap and
+#  using several of them is not unreasonable.
+#
+#     Each bitplane group is identified by a base index b, which is the
+#  index of the mutable color representing the background.  The individual
+#  bitplanes are referenced as b+1, b+2, b+4 etc. using powers of two.
+#  Other indices between b and b+2^n (exclusive) control the colors used
+#  used when multiple bitplanes are drawn.  The FrontPlane and BackPlane
+#  procedures provides simple control of these, and more sophisticated
+#  effects (such as making a bitplane partially transparent) are possible
+#  by setting them individually.
+#
+#
+#
+#  AlcPlane([win,] n) -- alc colors for n bitplanes
+#
+#     AlcPlane allocates a set of 2^n mutable colors chosen to be suitable
+#  for the bitplane manipulations described below.  The colors are
+#  consecutively indexed, and the base value b (the most negative index
+#  value) is returned.  The base color is initialized to the current
+#  background color, and the others are initialized to the foreground color.
+#
+#     A sequence of AlcPlane calls with different values of n is more
+#  likely to succeed if the larger sets are allocated first.
+#
+#
+#
+#  FrontPlane([win,] bp, color) -- move indexed plane to "front"
+#
+#     FrontPlane sets the pixels in a bitplane to the given color and
+#  moves the bitplane in front of the others in the set.  The color is
+#  optional.
+#
+#     bp is the index (base+1, base+2, base+4, or whatever) denoting a
+#  particular bitplane.  The move-to-the-front effect is accomplished by
+#  calling Color() for all colors in the bitplane group whose index
+#  after subtracting the base includes the particular bit.
+#
+#
+#
+#  BackPlane([win,] bp, color) -- move indexed plane to "back"
+#
+#     BackPlane sets the pixels in a bitplane to the given color and
+#  moves the bitplane in back of the others in the set.  The color is
+#  optional.
+#
+#     bp is the index (base+1, base+2, base+4, or whatever) denoting a
+#  particular bitplane.  The move-to-the-back effect is accomplished by
+#  calling Color() for all colors in the bitplane group whose index
+#  after subtracting the base includes the particular bit.
+#
+#     A plane can be effectively rendered invisible by calling
+#  BackPlane(win, bp, base);  this moves it to the back and sets
+#  its color to the color of the background plane.
+#
+#
+#
+#  PlaneOp([win,] bp, op) -- set graphics context for plane operation
+#
+#     PlaneOp initializes the graphics context for drawing or erasing in
+#  a particular bitplane.  bp is a bitplane index, as for FrontPlane;
+#  multiple bits can be set to draw or erase several bitplanes
+#  simultaneously.  op is usually one of two strings:
+#
+#	"set"	to draw the bits in a bitplane
+#	"clear"	to erase the bits in a bitplane
+#
+#  Subsequent drawing operations will affect only the bits in the selected
+#  bitplane.  Foreground operations are used for both drawing and erasure:
+#  use FillRectangle, not EraseArea.
+#
+#     After calling PlaneOp with "set" or "clear", be SURE to draw only
+#  in portions of the screen previously initialized with pixel values
+#  from the same bitplane group.  Drawing anywhere else is liable to
+#  produce strange, unwanted results.  Deplane (below) resets the window
+#  for normal operation.
+#
+#     The op parameter can also be "copy", in which case the previous
+#  contents of the window are immaterial and the drawn pixels are
+#  initialized with the bitplanes specified.
+#
+#
+#  Deplane([win,] color) -- restore normal drawop and set foreground
+#
+#     Deplane is called to restore normal drawing operations after setting
+#  or clearing bits in a particular bitplane.  The foreground color can be
+#  changed optionally.
+#
+#
+#
+#  Example:
+#
+#	b := AlcPlane(win, 3)			# get 3 planes
+#	Color(win, b, "white")			# background will be white
+#	FrontPlane(win, 1, "gray")		# city map will be gray
+#	FrontPlane(win, 2, "navy")		# routes will be dark blue
+#	FrontPlane(win, 4, "red")		# buses will be red
+#	Fg(win, b)
+#	DrawRectangle(win, x, y, w, h)		# initialize background
+#	PlaneOp(win, b+1, "set")
+#	drawmap()				# draw map
+#	repeat {
+#	   PlaneOp(win, b+2, "clear")
+#	   DrawRectangle(x, y, w, h)		# clear old routes
+#	   PlaneOp(win, b+2, "set")
+#	   drawroutes()				# draw new routes
+#	   while routes_ok() do
+#	      runbuses()			# run buses using plane b+4
+#	   }
+#
+#
+#
+#  Caveats
+#
+#     AlcPlane must repeatedly ask for new mutable colors until it gets a
+#  set that is suitable.  Unwanted colors cannot be returned or freed, so
+#  some color table entries are usually wasted.
+#
+#     No more than 7 bitplanes can be requested, and even that is chancy.
+#
+#     These routines will be confused by multiple displays.  Multiple
+#  windows on a single display, or multiple bitplane sets in a window,
+#  are no problem.
+#
+#     These routines depend on the internals of Icon, specifically the
+#  mapping of window-system pixel values to mutable color indices.
+#
+#     The use of unusual "and" and "or" drawops makes the code hard to
+#  understand.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+global Plane_Mask
+
+
+#  AlcPlane(win, n) -- allocate 2^n colors for bitplanes and return base b
+
+procedure AlcPlane(win, n)		#: allocate colors for bitplane
+   local ncolors, mask, b, seqlen, prev, fg, clist
+
+   if type(win) ~== "window" then {
+      n := win
+      win := &window
+      }
+
+   if n < 1 | n > 7 then
+      runerr(205, n)
+   fg := Fg(win)
+
+   ncolors := 2 ^ n
+   mask := ncolors - 1
+
+   # need to get ncolors colors in sequence, with the last one having the
+   # low order n bits (of the actual pixel value) set
+
+   # alternatives on Color are in case current fg/bg would cause failure
+
+   b := NewColor(win, fg | "black") | fail
+   clist := [b]
+   seqlen := 1
+   while seqlen < ncolors | iand(-1 - b, mask) ~= mask do {
+      prev := b
+      b := NewColor(win, fg | "black") | fail
+      push(clist, b)
+      if prev - b ~= 1 then
+         seqlen := 1
+      else
+         seqlen +:= 1
+      }
+
+   # discard unwanted colors
+   every 1 to ncolors do
+      pop(clist)
+   if *clist > 0 then {
+      push(clist, win)
+      FreeColor ! clist
+      }
+
+   # set base color to background and return result
+   Color(win, b, Bg(win) | "white")
+   /Plane_Mask := table()
+   every Plane_Mask [b to b + mask] := mask
+   return b
+end
+
+
+
+#  FrontPlane(win, bp, color) -- move indexed plane to "front", set color
+
+procedure FrontPlane(win, bp, color)	#: move bitplane to front
+   local mask, base, bits, i
+
+   if type(win) ~== "window" then {
+      win :=: bp :=: color
+      win := &window
+      }
+
+   mask := \Plane_Mask[bp] | runerr(205, bp)
+   base := iand(icom(mask), bp)
+   bits := bp - base
+   /color := bp
+   every i := base to base + mask do
+      if iand(i, bits) = bits then
+         Color(win, i, color)
+   return win
+end
+
+
+
+#  BackPlane(win, bp, color) -- move indexed plane to "back", set color
+
+procedure BackPlane(win, bp, color)	#: move bitplane to back
+   local mask, base, bits, i
+
+   if type(win) ~== "window" then {
+      win :=: bp :=: color
+      win := &window
+      }
+
+   mask := \Plane_Mask[bp] | runerr(205, bp)
+   base := iand(icom(mask), bp)
+   bits := bp - base
+   Color(win, bp, \color)			# set color if specified
+   every i := base to base + mask do
+      if iand(i, bits) = bits & i ~= bp then
+         Color(win, i, ixor(i, bits))		# set color as if plane unset
+   return win
+end
+
+
+
+#  PlaneOp(win, bp, op) -- set graphics context for plane operation
+
+procedure PlaneOp(win, bp, op)		#: set context for bitplane operation
+   local mask, base, bits, i
+
+   if type(win) ~== "window" then {
+      win :=: bp :=: op
+      win := &window
+      }
+
+   mask := \Plane_Mask[bp] | runerr(205, bp)
+   base := iand(icom(mask), bp)
+   bits := bp - base
+
+   case op of {
+      "copy": {
+         WAttrib(win, "drawop=copy")
+         Fg(win, bp)
+         }
+      "set": {
+         i := base + bits
+         WAttrib(win, "drawop=and")
+         Fg(win, i)
+         }
+      "clear": {
+         i := base + (mask - bits)
+         WAttrib(win, "drawop=or")
+         Fg(win, i)
+         }
+      default:
+         runerr(205, op)
+      }
+   return win
+end
+
+
+
+#  Deplane(win, color) -- restore normal drawop and set fg to color
+
+procedure Deplane(win, color)
+
+   if type(win) ~== "window" then {
+      color := win
+      win := &window
+      }
+   WAttrib(win, "drawop=copy")
+   Fg(win, \color)
+   return win
+end
diff --git a/ipl/gprocs/button.icn b/ipl/gprocs/button.icn
new file mode 100644
index 0000000..6b9b176
--- /dev/null
+++ b/ipl/gprocs/button.icn
@@ -0,0 +1,183 @@
+############################################################################
+#
+#	File:     button.icn
+#
+#	Subject:  Procedures for pushbutton sensors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement pushbuttons using the "evmux" event
+#	multiplexor instead of the usual vidget library.
+#
+#	button(win, label, proc, arg, x, y, w, h)
+#					establishes a pushbutton.
+#
+#	buttonrow(win,x,y,w,h,dx,dy, label,proc,arg, label,proc,arg, ...)
+#					establishes a row of buttons.
+#
+#	buttonlabel(handle, label)	changes a button label.
+#
+############################################################################
+#
+#   It is assumed that buttons do not overlap, and that fg, bg, and font
+#   do not change beyond the initial call.  These restrictions can be
+#   accommodated if necessary by using a window clone.
+#
+#   button(win, label, proc, arg, x, y, w, h)
+#
+#	establishes a button of size (w,h) at (x,y) and returns a handle.
+#	"label" is displayed as the text of the button.
+#	When the button is pushed, proc(win, arg) is called.
+#
+#	If proc is null, the label is drawn with no surrounding box, and
+#	the button is not sensitive to mouse events.  This can be used to
+#	insert a label in a row of buttons.
+#
+#   buttonlabel(handle, label)
+#
+#	changes the label on a button.
+#
+#   buttonrow(win,x,y,w,h,dx,dy, label,proc,arg, label,proc,arg, ...)
+#
+#	establishes a row (or column) of buttons and returns a list of handles.
+#	Every button has size (w,h) and is offset from its predecessor by
+#	(dx,dy).
+#
+#	(x,y) give the "anchor point" for the button row, which is a corner
+#	of the first button.  x specifies the left edge of that button unless
+#	dx is negative, in which case it specifies the right edge.  Similarly,
+#	y is the top edge, or the bottom if dy is negative.
+#
+#	One button is created for each argument triple of label,proc,arg.
+#	An extra null argument is accepted to allow regularity in coding as
+#	shown in the example below.
+#
+#	If all three items of the triple are null, a half-button-sized
+#	gap is inserted instead of a button.
+#
+#   Example:
+#
+#	Draw a pushbutton at (x,y) of size (w,h);
+#	then change its label from "Slow" to "Reluctant"
+#	When the button is pushed, call setspeed (win, -3).
+#
+# 		b := button (win, "Slow", setspeed, -3, x, y, w, h)
+#   		buttonlabel (b, "Reluctant")
+#
+#	Make a set of buttons extending to the left from (490,10)
+#
+#		blist := buttonrow(win, 490, 10, 50, 20, -60, 0,
+#		    "fast", setspeed, +3,
+#		    "med", setspeed, 0,
+#		    "slow", setspeed, -3,
+#		    )
+#
+############################################################################
+#
+#  Links: evmux, graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  evmux.icn
+#
+############################################################################
+
+
+link evmux
+link graphics
+
+$define BORDER 2	# border width
+
+record Button_Rec(win, label, proc, arg, x, y, w, h)
+
+procedure button(win, label, proc, arg, x, y, w, h)
+   local r
+
+   r := Button_Rec(win, label, proc, arg, x, y, w, h)
+   buttonlabel(r, label)
+   if \proc then {
+      BevelRectangle(win, x, y, w, h, BORDER)
+      sensor(win, &lpress, Exec_Button, r, x, y, w, h)
+      }
+   return r
+end
+
+procedure buttonrow(win, x, y, w, h, dx, dy, args[])
+   local hlist, label, proc, arg
+
+   if dx < 0 then x -:= w
+   if dy < 0 then y -:= h
+   hlist := []
+   repeat {
+      label := get(args) | break
+      proc := get(args) | break
+      arg := get(args) | break
+      if label === proc === arg === &null then {
+         x +:= dx / 2
+         y +:= dy / 2
+         }
+      else {
+         put(hlist, button(win, label, proc, arg, x, y, w, h))
+         x +:= dx
+         y +:= dy
+         }
+      }
+   return hlist
+end
+
+procedure buttonlabel(r, s)
+   r.label := s
+   if /r.proc then
+      EraseArea(r.win, r.x, r.y, r.w, r.h)	# borderless button
+   else
+      EraseArea(r.win, r.x+BORDER, r.y+BORDER, r.w-2*BORDER, r.h-2*BORDER)
+   CenterString(r.win, r.x + r.w/2, r.y + r.h/2, r.label)
+   return
+end
+
+procedure Exec_Button(win, r, x, y)
+   local e, b, t
+
+   WAttrib(win, "drawop=reverse")
+   FillRectangle(win, r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h -2*BORDER)
+   BevelRectangle(win, r.x, r.y, r.w, r.h, b := -BORDER)
+
+   while e := Event(win) do {
+      x := &x
+      y := &y
+      case e of {
+         &ldrag: {			# drag
+            t := (if ontarget(r, x, y) then -BORDER else BORDER)
+            if b ~===:= t then {
+               BevelRectangle(win, r.x, r.y, r.w, r.h, b)
+               FillRectangle(win,
+                  r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h - 2*BORDER)
+               }
+            }
+         &lrelease: {			# release leftbutton
+            if b < 0 then {
+               BevelRectangle(win, r.x, r.y, r.w, r.h, BORDER)
+               FillRectangle(win,
+                  r.x + BORDER, r.y + BORDER, r.w - 2*BORDER, r.h - 2*BORDER)
+               WAttrib(win, "drawop=copy")
+               r.proc(win, r.arg)
+               }
+            else
+               WAttrib(win, "drawop=copy")
+            return
+            }
+         }
+      }
+end
diff --git a/ipl/gprocs/cardbits.icn b/ipl/gprocs/cardbits.icn
new file mode 100644
index 0000000..4c961fb
--- /dev/null
+++ b/ipl/gprocs/cardbits.icn
@@ -0,0 +1,602 @@
+############################################################################
+#
+#	File:     cardbits.icn
+#
+#	Subject:  Procedure for constructing playing card images
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#	cardbits() returns an image for use in drawing playing cards.
+#
+############################################################################
+#
+#     cardbits() returns a bilevel image used by the drawcard() library
+#  procedure (q.v.).  The image contains many small subimages for use in
+#  constructing playing cards.  The images were collected from the
+#  individual X bitmaps of the highly recommended "Spider" solitaire game
+#  that is included as a sample program with the XView toolkit for
+#  X-windows.
+#
+#  Overall structure: 160w x 432h bilevel bitmap.
+#	Red area: union of two rectangles (0,0,160,188) (0,404,117,28)
+#	Black area: union of two rectangles (0,188,160,216) (117,404,43,28)
+#
+#  Pips: 16x20 heart, diamond, club, spade at (144, {0,94,188,282})
+#			 rotated versions    at (144, {20,114,208,302})
+#  Small pips:  9x14 H, D, C, S	     at (148, {40,134,228,322})
+#			 rotated versions    at (148, {54,148,242,336})
+#  Large spade, for the Ace: 43x56 at (117,376)
+#  Ranks: 9x14 A,2,3,4,5,6,7,8,9,J,Q,K  at ({0,12,24,...,144}, 376)
+#			rotated versions at ({0,12,24,...,144}, 390)
+#			both rows duplicated at ({0,...144}, {404,418})
+#  Faces: 48x94 images including 1-pixel-wide frame.
+#	Three columns (J,Q,K) of four rows (H,D,C,S)
+#	at ({0,48,96},{0,94,188,282}).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  drawcard.icn
+#
+############################################################################
+
+#  Original copyrights are as follows; permissions appear at end of file.
+#
+#  (c) Copyright 1989, Donald R. Woods and Sun Microsystems, Inc.
+#  (c) Copyright 1990, David Lemke and Network Computing Devices Inc.
+#  Copyright 1990 Heather Rose and Sun Microsystems, Inc.
+
+procedure cardbits()
+return \
+"160,#_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+00008080000008018000200554018000CA64CA61_
+38388076DB6DB0018E0E20CEAC018000656AD4C1_
+7C7C8055555560019F1F11CD560187073264C981_
+FEFE83228A28C001BFBF91DAAE018F8F996AD303_
+FEFE84A104108001BFBF901516019FDFCC60C617_
+FFFE82F104113839BFFF933A0E019FDFCFFFFC37_
+FFFEBE9FFFFE7C7DBFFF973E75019FFFCFFFF857_
+7FFCEACAAAAAFEFF9FFF277045019FFFC8055097_
+7FFCAA2FFFFCFEFF9FFF206E7D018FFF85E55137_
+3FF8AACAA004FFFF8FFE2CCC75018FFF84C5513F_
+1FF0AA8AAF1AFFFF87FC5D9E7E8187FF04A5516B_
+0FE0D6FAA0A67FFD83F85D80468183FE09C551AB_
+0FE082554F3E7FFD83F88300868181FC0802A96B_
+07C0C5954C3A3FF981F137028E8181FC1032A93F_
+0380FE354E3E1FF180E1FF818F4180F81B12A897_
+0380822A80A20FE180E00D810F41807004E15657_
+0100FF2A80620FE180403FC40F41897004015937_
+01008155404207C188407AC397418F2007815697_
+0000FFD540030381B600FFE313A186240E075A87_
+0000BCD521B2C381AA03F5613BA18D09081AA707_
+01009E54D0432101DD0FFFF02FA18BF61475FEC7_
+0100CF2A50E29101AA3FCD5857A186883FFFFFF7_
+0380A79FA804F001B61FCEAFADD18184C000073F_
+0380B3C9AAAB5801C80FFB555DD1824191448F39_
+07C0E9EA75554601FE0FF1EAF2D18EA67FFF1EE7_
+0FE0ACFF6A0B2FC1B735FB3F91519A9C00803FDF_
+0FE09A66F8E65679A0F0B6248E29977E7FFE73B7_
+1FF0CBF56FBCF5AFABD4B1E47C998AF32244F3D9_
+3FF8E71DE3F3D995F667381FE64987739189EEED_
+7FFCFC6D580D5A4BD27A1803E22586DDCA53FC77_
+7FFCF187D7F5F4A5AA5D5B67F2259F7FE997393B_
+FFFEC6475D5D59B3D267FEAFD333FAD675AF3C9D_
+FFFEB8A6F5D5B249E23BAD4F5129EB6E742EEE4F_
+FEFECD157D5F5597F325EC9D3921EAD7BA5FF727_
+FEFEC4A7B7F6ED3BF93ACE9EE955DB7BFA59AF93_
+7C7CD6553084B275BD2ACE3BD959B2DD9DB9D5C9_
+3838D2AD55552CF9DF357639B913EB6B9DB7FAE5_
+0000DB96F2A7AFF3AF2D677BB99DDAD7EE7F1F73_
+0000D99751445975D7356B776895B77FFE6626F9_
+0000DDE6508F3AB1AB2ABF677C85EEDC6667F35D_
+0C60C496B9501D399536B7F9648FDDB2666E09AF_
+1EF0F2C5D89F1AB58B2AB5E76C95BB67F67FFDF7_
+1FF0BC4299501C73A53D599D74A5F6CFFF7FFAED_
+1FF08F62A81F1AB9932F5E77A489ADD912244ADB_
+0FE0E3F278902EF5913379DCBCC9D7A894948AED_
+0FE0B8F3F9CFE78FBD1DE773DC5FADAB794F6ADB_
+07C0F1E7F39FCF1DFA3BCEE7B8BDDB56F29ED5B5_
+0380AF74091E4FC7933D3B9ECC89B751292915EB_
+03809D58F81546F19125EE7AF4C9DB5224489BB5_
+0100CE380A99423DA52EB99ABCA5B75FFEFFF36F_
+0100AD58F91BA34FA936E7AD54D1EFBFFE6FE6DD_
+00009CB80A9D6923F1269FED6CA9F59076664DBB_
+00008D5CF10A67BBA13EE6FD54D5BACFE6663B77_
+0000AE9A228AE99BA916EED6ACEB9F64667FFEED_
+0000CFF5E54F69DBB99DDEE6B4F5CEF8FE77EB5B_
+01009F34AAAAB54BC89D9C6EACFBA75FEDB9D6D7_
+0100AE4D210CAA6B9A9BDC7354BD93AB9DB9BB4D_
+0380DCB76FEDE523AA9779735C9FC9F59A5FDEDB_
+0380E9AAFABEA8B3849CB937A4CFE4EFFA5DEB57_
+07C0924DABAF651D948AF2B5DC47F277742E76D7_
+0FE0CD9ABABAE263CCCBF57FE64BB93CF5AE6B5F_
+0FE0A52FAFEBE18FA44FE6DABA55DC9CE997FEF9_
+1FF0D25AB01AB63FA447C0185E4BEE3FCA53BB61_
+1FF0A99BCFC7B8E79267F81CE66FB7779189CEE1_
+1EF0F5AF3DF6AFD3993E278D2BD59BCF2244CF51_
+0C609E6A671F66599471246D0F05EDCE7FFE7EE9_
+000083F4D056FF358A89FCDFACEDFBFC01003959_
+00008062AAAE57978B4F578FF07FE778FFFE6571_
+0000801AD55593CD8BBAAADFF0139CF122898241_
+0000800F2015F9E58BB5F573F86DFCE000032181_
+00008089470A54F385EA1AB3FC55EFFFFFFC1161_
+00008084C20B2A7985F40FFFF0BBE37FAE286FD1_
+000081C34D84AB3D85DC86AFC055E0E5581090B1_
+000081C0C002ABFF85C8C7FF006DE15AE0702461_
+000083E04202AA8182E9C35E0211E96A81E004F1_
+000087F0460154FF82F023FC0201EC9A80200E91_
+000087F04501544182F081B00701EA6A87200E01_
+00008FF87C72AC7F82F181FF8701E91548D81F01_
+00009FFC5C32A9A3817140EC8F81FC954C083F81_
+0000BFFE7CF2AA41816100C11FC1D69540103F81_
+0000BFFE65055F6B816201BA1FC1D58AA3907FC1_
+0000FFFF58F55155817E79BA3FE1D68AA520FFE1_
+0000FFFF2005535580AE33347FF1FC8AA321FFF1_
+0000FF7F3FFFF45580BE7604FFF9EC8AA7A1FFF1_
+0000FF7F5555535780A20EE4FFF9E90AA013FFF9_
+0000BE3E7FFFF97D80AE7CE9FFFDEA1FFFF3FFF9_
+00009C1C88208F4180705CC9FFFDEC3FFFF3FBF9_
+00008001082085218068A809FDFDE8630633FBF9_
+00008003145144C180755B89FDFDC0CB5699F1F1_
+00008006AAAAAA01806AB388F8F98193264CE0E1_
+0000800DB6DB6E01803573047071832B56A60001_
+0000801000000101802AA0040001865326530001_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+0100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+010081A222222C0180000149F105800E76EDCE01_
+038080D55555588180800194B7C9808736ED9C01_
+038088E2222230818080032279098083860C3801_
+07C084488888E1C181C00541588981C1FFFFF001_
+0FE086755555C1C181C00980BFE981C0FFFFF003_
+0FE0C528888983E183E00B77EC8983E0C002B007_
+1FF0E5321FFF07F187F017885E4987F0C042A807_
+3FF8A495FFFE07F187F027EF97F987F0FC3EA805_
+7FFCEA93FC020FF98FF84F730F498FF8C282A807_
+3FF8F65FF0F21FFD9FFC5FD71B259FFCFA7EAA05_
+1FF09DDFD10A3FFFBFFE9F1017FDBFFEBA3AAB07_
+0FE09DDF507A1FFD9FFCBF201DA59FFCA222A985_
+0FE0F65550B20FF98FF97DAC17C38FF8A202A947_
+07C0EAB5507907F187F27A900EFF87F0A402A8A5_
+0380A4AAA00107F187F2FD8009C187F0A702A89F_
+0380E52AA02283E183E2FA9F1B4183E0A002A847_
+0100E555404D81C181C5F5CC38E181C0A022AE23_
+0100A6555C3101C189C5EAC062A1C1C3D7C2A911_
+0000E455660200819C89F5E0C8F1E0849183AF0D_
+0000E8555B0E0081AA8BEB21A3D1F08528066107_
+0100A0D55506000DF70BDC9E9FF9B00C441C1E85_
+0100E0AAA54140D7AA13FFA2FFA99037C7F064C5_
+0380FFFFFAAAA0AB9817DFFFFDDDD0D338039967_
+0380C8C63F555D57AC17ABFFEAF5F3DCC7FC66F7_
+07C0E5AD6AAABF6BAA1FF77F77FFDDDE38038DCF_
+0FE0F318C7FF7AD5D53BFAAAAFEB9DBF87FC3BAD_
+0FE0FFFFFFFE34B9D2FD7FDDFF5FBBBEF803D717_
+1FF0FF0003DE259DA35FAFFFFAFDF776EFFEEEB5_
+3FF8C1FFFFAC4DB3DEAED5FFD5DFBE76BBBBDC57_
+7FFCDBC631DCCF33B597FAAAAFCF9CF6EEEEBAB5_
+3FF8D7EB5BFDD8E7E2D7FFD5F26FD9F6BBBB6917_
+1FF0CEB98D7DDE37D5573E7FF2A7F3D6EEEEDAB5_
+0FE0DF75FD9D978D88B7064FF237D7F6BBBDEC4F_
+0FE0FAAAACB92DE5D56E6E4F2FF39F16EEEBDAAD_
+07C0FDCB56D828F3A23E6CDC315BBFF6BBB6E91D_
+0380EACFEB992D59D55F8C9B5549F816EEEEDAAF_
+0380F7A7357B2E2D88AAFE9B519DBFF6BBDBEC55_
+0100AB252AAFAD57D54EABF84EBD9016EEBBDABD_
+0100DE74355B5E8BA275FAAFB92FDFF6BB6CE917_
+0000AAAAAAAA5F55D58C0FEAC55FF816EED77AAF_
+0100F4AADFF85F2388AAF01FD56FD7F6BDAB7C77_
+0100A9CBFAAA5BD5D58A9FE0C55F9C56EB5D9AAD_
+0380D29ADFFB59E9A371403EB96FB7F6B6A2ED35_
+0380B29A536FDB95D49D5F829D5FFBB6ED59EEEF_
+07C0E73D1C9B5F2BCEA35AFAA36BB75EDADB73B5_
+0FE0F23D5FFD5E27D66AADDAAB359A5EB146BD2D_
+07C0E47ABFFABC4FACD55BB5566BB4BD628D7A59_
+0380D4FAD938BCE7D6C55F5AC573ADCEDB5B7AED_
+0380A9DBF6CA594DFAB941FAB92BF7779AB76DDF_
+0100979ADFFB594BF69D7C028EC5ACB7456D6FED_
+0100ABDA555FD395FAA307F951ABB559BAD76A39_
+0000C4FA1FFB552FF6ABF80F5511EE3ED5BD6FEB_
+0000AAFA55555555FAA357F031ABF55EEB77681F_
+0000D17ADAAC2E7BF49DF55FAE45E89736DD6FFB_
+0000EAB5F554A4D5BD721FD572ABBD5BDD776809_
+0100B474DEACE5EFB98AD97F5511AA37DBDD6FFD_
+01009AB499D7F35792AAD931FAABF55B7777681F_
+0380CF141B6AD3BFDA8C3B367C45B8976DDD6FFD_
+0380A7B49D35555FCFF4F27676ABB55BD77768F9_
+07C0B1E9B9BFAEFBEC4FF260ED11F237BDDD6FEB_
+0FE0EC7BBEB19D73E54FFE7CEAABAD5B77776BCF_
+07C0E71BBFDAD7EBF64FABFFEB47E896DDDD6F9B_
+0380CCF33B8C63DBF3F5555FE9ADAD5D77776F39_
+0380CDB235FFFF83FBABFFAB757BEA3BDDDD6E7D_
+0100B9A47BC000FFBF5FFFF5FAC5AD777FF76EEF_
+01009D2C7FFFFFFFFAFFBBFEBF4BE8EBC01F7DDD_
+0000AB5EFFE318CFD7F5555FDCABB5DC3FE1FDB9_
+0000D6FD5556B5A7FFEEFEEFF855F3B1C01C7BBB_
+0000EABAAAFC6313AF57FFD5E835EF663FE33BCF_
+0000D505555FFFFFBBBFFFFBE819E699C01CCB0B_
+0000EB0282A5550795FF45FFC855A3260FE3EC09_
+0000B00060AAAB059FF9793BD0EFA1783822300D_
+0000810070DAAA178BC584D7D155E0866014A10F_
+000081004066AA278F1307AF9139B0F5C1892107_
+000083808C3AAA6585460357A391889543EBC383_
+00008381B202AAA7871C33AFA381C47544050381_
+000087C1440554A782D8F95F47C1E215400507C1_
+00008FE080055525839001BF4FE1F91540E50FE1_
+00008FE09E0AAD57FF70095E4FE1A51540250FE1_
+00009FF04D0AAA6FC3E835BE9FF1E29540451FF1_
+0000BFF85E0AFBB9A5B804FD3FF9A19544453FF9_
+0000FFFC508BFBB9BFE808F97FFDE0D55C5D7FFD_
+0000BFF84F0FFA6FA4D8EBFA3FF9A0557E5F3FF9_
+00009FF0403FC95792F0CEF21FF1E01541431FF1_
+00008FE07FFFA9259FE9F7E40FE1A0157C3F0FE1_
+00008FE0FFF84CA7927A11E80FE1E01542030FE1_
+000087C1911114A39137EED007C1E00D400307C1_
+00008383AAAAAE6197FD01900381C00FFFFF0381_
+0000838711111221911A82A00381800FFFFF8381_
+0000810C44444711909E44C00101801C3061C101_
+0000811AAAAAAB0193ED298001018039B76CE101_
+0000803444444581A08F928000018073B76E7001_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+000086820820B00180000292ECC180036B6AAB61_
+038083820820E38180E00329EFE180E1B556D6C1_
+07C081EDB6DBC7C181F00244AFE181F0DB6AAD81_
+0FE080C208218FE183F80292A6C383F86D56DB81_
+0FE0807FFFFF0FE183F80329F60383F8377EF683_
+0FE0803555560FE183F803CFB66783F818000E47_
+07C0801AAAAC07C181F00220D7F581F00FFFFD4D_
+3BB8800FFFFC3BB98EEE03EF57F58EEE0FFFFD9B_
+7FFC800FFFFC7FFD9FFF02E673659FFF0D4004B7_
+FFFE880AA004FFFFBFFF87AE5B05BFFF95400461_
+FFFE9C0AAE3CFFFFBFFF8A405BB5BFFF955F1CFF_
+FFFEBE0AA674FFFFBFFF92684BFFBFFF9540A405_
+7D7CBA0ABE7C7FFD9FFF273079FB9FFF154F1E05_
+3938AA0AA02439398E4E4F202DF38E4E15464C05_
+0380BA0AA024010180409D202DCF8040154E5C05_
+0380AA0AA1E4038180E1390424D980E015402405_
+07C0BA0AA044038180E273BC7EF180E07540E405_
+0000AA3AA1B407C181F267B0F6E181F05D404405_
+0000BA2EA04700018004EFC1F271800057420405_
+0000AA2BB8E480018004DC435B7180005541E805_
+0000BA3AA70680018004F17F0F3980003560C80F_
+07C0AA1EACE0E0018004E45429B980007C701813_
+0380BA3221F1F8018104DD00FC9D8001FFDC3727_
+0380AA6BFF9FFE018283C3B784CD8007DE07E9E5_
+3938BAE2223FFF8186C3627C8FEF801ED79F1CE7_
+7D7CABF888BFFFE18926376DDA27C07AE9FA19F5_
+FFFEBBBE227FDFF9B6CF1DD77333E1EAC462DCEF_
+FFFEABCF88FEBFFFAA9BF8BA3FBBB77ED60619D5_
+FFFEBA63E3F5F7FFA531AFD7FBE99EF6C39E1CBD_
+7FFCAB31FFEB367F95F9F4EF556D957EEBFED57D_
+3BB8BA783EF6363FBA19AC39EEF792EAC1FA1AED_
+07C0EB1C00EAF7BFC5F9DC11555F996AD5E21DD5_
+0FE0FBCE38D5E3DFB3F1ACE2BBBB91FEC046CFBD_
+0FE0EB9E38EF9CFFCF63F8E3555590F6FADD0F6D_
+0FE0FBC6D6D77F7FAEB76B5AEEEF967ED03B0AF5_
+07C0EBF3EEAEEBBFD95E3BBB5555907ACF556DBD_
+0380FBE3D6D5DDDFB7AF2B5BBBBB9826D41B07B5_
+0000EBF710ABAAFFE85B3843555595A1D3AD85BD_
+0000FBF338D7777BD3B018E2EEEF9414650AB59D_
+0000EBF987EB2A7DE470180557F59A1194ED82DD_
+0380FBF98C9DC9FDA9E81887B81F9A6C094AC2DD_
+07C08FFB9086FFF9EBD999C5C0039D0B353D5ACD_
+07C0F8F9B6B667FDABA99AA703019D06824AC16D_
+03808EFDA632D7FFD7501775031B9EB56DD5616D_
+0D60FEF9A082CFCFACE02A2A301F9E86B2BAAD6D_
+1FF08DFBBDDEEFD9D8063C9E300D9E835B6D60BD_
+1FF09BF77BBDDFB1B00C793C601BBD06B6DAC179_
+1FF0F3F341059F7FF80C54540735B6B55D4D6179_
+0D60FFEB4C65BF71D8C0AEE80AEBB686ABB6AD79_
+0000BFE66D6D9F1F80C0E55995D5B683524160B9_
+03809FFF6109DFF1C003A3999BD7B35ABCACD0B9_
+0000BF93B9319FDFF81DE1181795BB4352903659_
+0000BE54D7E19FD7AFEAA0180E27BB41B7298859_
+0000DEEEEB1CCFDFF77747180DCBB9AD50A62829_
+0000FF55D508EFD7AAAAC21CDA17BDA1B5CB85A9_
+0380FBBBAB6BC7DFDDDDDAD4F5EDADE0D82B6419_
+0000FDD77577CFD7AAAADDDC7A9BBDB6AAF35E09_
+0D60FEFEEB6B63DFF7775AD6ED75AF50DC0B7E69_
+1FF0FF39F71C79D7AAAAC71FC6F3B6F0BB5F6F09_
+1FF0FBC7AB1C73DFDDDD47358FCDBDF362037F89_
+1FF0FDEF570038D7FAAA883B9FA3ABB847AB5699_
+0D60FC6C6F7C1E5DEF779C35985DB7585F835749_
+0380FE6CD7FF8CD5B6AAF72F9FA9BEAB7FD77EA9_
+07C0FFEFAFC7C65D97DFEBF58CA5BD3879C36F79_
+07C0FFFD7F11F3D5DDFC5D1FD955AB98606B7EED_
+03809FFBFE447DDDCCCEEBB8F36DF73B46235787_
+000087FFFD111FD5E45BB6EC6491AF985F975E03_
+000081FFFC44475DF7F13E46C361E738F9EB7801_
+0000807FF9FFD655B321EDC3C141A797E07BE001_
+0000801F8F844C5DB93F00BB2081E4EC3BFF8001_
+00008007073578559D942A272001C8180E3E0001_
+0000800160E55C5D9CF0FE8F2001F01306AC0001_
+00008001271DD4558EDAC23B2001A01782AA0001_
+00008000E205745D8E4F83F72001A02042EA0001_
+000083E02D855C55876F0DE64F81A02202BA0F81_
+000081C02205505D8F7E3DCE4701A02702AE0701_
+000081C0278550559B24209C8701A02402A80701_
+000080802405505DF3B404B90201A03A72A80201_
+00009C9C24055055CFB404F27271A03262A87271_
+0000BFFE3E7D505DDF9E0CE4FFF9A078F2A8FFF9_
+0000FFFF2E65507DFFD21649FFFDA02502A9FFFD_
+0000FFFF3C755039ADDA0251FFFDFF38FAA9FFFD_
+0000FFFF20055011A0DA75E1FFFD862002A9FFFD_
+0000BFFE3FFFF001A6CE6740FFF9ED2002B0FFF9_
+00009DDC3FFFF001AFEAF7C07771D9BFFFF07771_
+000083E035555801AFEB04400F81B2BFFFF00F81_
+000087F06AAAAC01E66DF3C01FC1E27000181FC1_
+000087F0FFFFFE01C06F94C01FC1C16F7EEC1FC1_
+000087F184104301C36549401FC181DB6AB61FC1_
+000083E3DB6DB78187F522400F8181B556DB0F81_
+000081C7041041C187F794C00701836B6AAD8701_
+0000800D0410416183374940000186D556D6C001_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+0100FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+010082410410A001800010B496018040EAEEBAB9_
+038081638E39C201800008194E0180E075D77571_
+038080F7DF7D820180000BB2260180E03AEEBAE5_
+07C08067DF7D070180200B34150581F01DD775CB_
+0FE080210412070180200AB80D0581F00FFFFF8F_
+0FE0803FFFFC0F818070087C750B83F80FFFFF0F_
+1FF0803FFFFC0F8180700F62450B87FC0AA8010B_
+3FF8A02001541FC180F80E7E7D0B8FFE0AA8F10B_
+7FFCF03E79543FE180F80DCC5D119FFF0AAB090F_
+7FFCD82105547FF181FC10DC7A8B9FFF0AA8790F_
+FFFE8C2FB954FFF983FE1F804A8FBFFF8AA8B10B_
+FFFE84269D54FFF987FF1DC18A85BFFF8AA8790F_
+FFFEA42FB955FFFD8FFF9FC08A85BFFF8AA8008B_
+FFFEA4210155FFFD9FFFC3A00A8DBFFF8AA80395_
+7D7C94210155FFFD9FFFC1639A879F5F0AA8990B_
+393894218155FFFD9FFFC1D19D4D8E4E0AA9210F_
+03809436B554FAF99FFFC3302D4780E00AA8DF0B_
+07C0A43C1D5472719FFFC2A82D4D81F00AA80E0F_
+0000A423615407018FAF8444554780000EE8020F_
+0000A42081540F8187270AABAF4D80003BBC020B_
+07C0A4E1C15600018070111113E780002EEB060B_
+038095600355000180F82EAAABED80003BBFFC0F_
+3938955AAD5500018000264446678001F800039F_
+7D7C94A5D3AB8001800041AAAE7D800706DB6DB1_
+FFFEB47FFFFFE001800094911C1780197400027F_
+FFFEB5C40000BC0184018C6AA8BD80ED77FFFFD9_
+FFFEB547FFFFB3018E028A244B37816727BBB4CF_
+FFFEE6AF555507C19502801EB37D873306EEF955_
+7FFCE6ADFFFF6739BB876147E4F7899977FBB033_
+7FFCE6A100016E77956FB0C2A1FDBCCD77BFFE39_
+3FF8C552B8314CE3CE7DDCB491E7E66724A8264D_
+1FF0C556843A1DC7A5DCF60493CDBF3106724AE7_
+0FE0C55687F2D38FB9B66D088F9793DD75ACF1B3_
+0FE0C5284FE2D29DFF6B32C88F3DACB77471B199_
+07C0C6A94FDA9D79ABC5BDB9CE67A18924DBD2EF_
+0380C6AB544222B1B0A5BEDFFCCDB3270404F6A1_
+0380E6AB52242773B155A769CD87AD89FFF93E7D_
+0100E6944005AF97CDB5A3988D1DA122D55A4E27_
+0100E754BFFDBEBF932B29E88B37B388EAAE9393_
+0000FF55BFFD3C5DB5166CE49A2DAD225DDBA4CB_
+01009155AAAC787DD60CCE74BF47A198AEE8C967_
+0100FF5E2AA87C5F9730803EA38DF2B2355A3271_
+03808A62555B5EE9B07FFFFFFF87BC9C9AA88CBF_
+0380FEA2D63B4FBF9084444445ADB1A42FFA2539_
+07C08B5ED77A4769BFFFFFFFFFA7BA570C99DA4D_
+0FE0FEA109C842BF98EAAAAAAB8D9CF94B694F9D_
+1FF0FD421390857FB1D555555719B9F296D29F39_
+1FF096E25EEB7AD1E5FFFFFFFFFDB25B9930EA5D_
+1FF0FDF2DC6B457FB5A2222221099CA45FF4258D_
+0D60977ADAAA4651E1FFFFFFFE0DFD311559393D_
+0100FA3E15547AFFB1C57C010CE98E4C5AAC4D4F_
+0380BE1E3555AA89E2FD2E73306BE69317751985_
+0000BA3CBFFDAAFFB459273668ADD325DBBA44B5_
+0000FD7DBFFD2AE7ECD11794D4C9C9C9755711CD_
+0380E9F5A0022967B8B119C5ADB3E4725AAB4485_
+0100CEE4244AD567E1B396E5AA8DBE7C9FFF91B5_
+0D608D44422AD563B33FFB7DA50D856F2020E4CD_
+1FF09EB95BF29563E6739DBDA3D5F74BDB249185_
+1FF0B94B47F214A3BCF1134CD6FF998D8E2EED35_
+1FF0F1CB4FE16AA3E9F110B66D9DCD8F35AEBBC9_
+0FE0E3B85C216AA3B3C9206F3BA5E7524E608CFD_
+07C0C7328C1D4AA3E7892D3BBE73B2641524E667_
+0380EE7680008567BF85430DF6A99C7FFDEEB33D_
+03809CE6FFFFB567EF27E286E1DDCC0DDFEE9991_
+010083E0AAAAF567BECD780140A9AA9F7760CCE1_
+010080CDFFFFE2ADECD224514071F32DDDE4E681_
+0000803D000023ADBD15563180219BFFFFEEB701_
+00008007FFFFFE2DE83889290001FE40002E9801_
+00008001D5CBA529BE75558200018DB6DB60E001_
+00008000AAB55AA9E66222640001F9C0001F8001_
+00008000AAC006A9B7D555741F01F03FFDDC0001_
+000080006A838725E7C888880E01D060D7740001_
+000081F02A810425B2F5D550E4E1D0403DDC0001_
+000080E02A86C425E2AA2221F5F1F04017700001_
+00008E4E2AB83C25B2B41543FFF9F07015500F81_
+00009F5F2AAD6C29E2B40CC3FFF9D0FB15500701_
+0000BFFFAA818429B2B98B83FFF9F08495507271_
+0000BFFFAA808429E159C683FFF9D0991550FAF9_
+0000BFFFAA808425B15005C3FFF9A9C01551FFFD_
+0000BFFFAA9DF425A15103F9FFF1D1001551FFFD_
+00009FFF2AB96421A15183B8FFE1F09E1551FFFD_
+00009FFF2A9DF431F15201F87FC1D08D1551FFFD_
+00008FFE2AA0841BD15E3B083F81F09E1550FFF9_
+000087FC2A9E7C0F88BA33B01F01F090D550FFF9_
+000083F82A800405D0BE7E701F01D08F15507FF1_
+000081F03FFFFC01D0A246F00E01D08015503FE1_
+000081F03FFFFC01D0AE3E100E01F0FFFFF01FC1_
+000080E048208401A0B01D500401F1FFFFF00F81_
+000080E0BEFBE601A0A82CD00401D3AEEBB80F81_
+00008041BEFBEF0180644DD00001A75D775C0701_
+000080439C71C6818072981000018EAEEBAE0701_
+000080050820824180692D0800019D5D77570201_
+0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF_
+00000000001EF1C781E67C3E7FCF8FF707FCF838_
+00000000001EF3E783F6FE7F7FDFCFF787FDFC38_
+00000400000E67730337C7E3E0F8E037870F8E38_
+0000040000076633033783C1B0106036C383066C_
+000004000003E633033783E3B00067B6C1C3006C_
+00000E000001E6330337837F180F6FF661E3806C_
+00000E000001E6330337C73E181FFC7663F1C06C_
+00000E000003E6330337FE7F0C38F8263720E0C6_
+00001F00000366FB0337BCE38C307806360070FE_
+00001F00000767FB0F3780C18C30780FFE0038FE_
+00003F80000667B30F3782C18630782FFE081CC6_
+00003F80000E67739F37C7E38638FC76071F0F83_
+00007FC0001EFFE1FBF6FE7F061FCFEF03FBFF83_
+0000FFE0001EF5C0F1E67C3E060F87CF01F3FF83_
+0000FFE0001EF1D1E33C7C3E0C0F87C079F3FF83_
+0001FFF0001EF3FBF37EFE7F0C1FCFE07BFBFF83_
+0003FFF8000CE7773B67C7E38C38FC70371F8783_
+0003FFF8000CC6F61B6683C18C30683FFA0DC0C6_
+0007FFFC000DCFF61B6603C18630603FF80CE0FE_
+000FFFFE000D8FB01B667BE386306036300C70FE_
+001FFFFF000F86301B66FF7F0638E836309C38C6_
+003FFFFF800F06301B67C73E033FDC7331F81C6C_
+007FFFFFC00F06301B67837F03379FE330F00E6C_
+00FFFFFFE00F86301B6783E381B01BC1B070066C_
+01FFFFFFF00DC6301B6783C181B05801B03B066C_
+03FFFFFFF80CE7701B67C7E3E0F8F800F61F8E38_
+07FFFFFFFC1EF3E03F7EFE7F7FDFDFE0F7FDFC38_
+07FFFFFFFC1EF1C03F3C7C3E7FCF9FE077FCF838_
+0FFFFFFFFE1EF1C781E67C3E7FCF8FF707FCF838_
+0FFFFFFFFE1EF3E783F6FE7F7FDFCFF787FDFC38_
+1FFFFFFFFF0E67730337C7E3E0F8E037870F8E38_
+1FFFFFFFFF076633033783C1B0106036C383066C_
+1FFFFFFFFF03E633033783E3B00067B6C1C3006C_
+3FFFFFFFFF81E6330337837F180F6FF661E3806C_
+3FFFFFFFFF81E6330337C73E181FFC7663F1C06C_
+3FFFFFFFFF83E6330337FE7F0C38F8263720E0C6_
+3FFFFFFFFF8366FB0337BCE38C307806360070FE_
+3FFFFFFFFF8767FB0F3780C18C30780FFE0038FE_
+1FFFFFFFFF0667B30F3782C18630782FFE081CC6_
+1FFFFFFFFF0E67739F37C7E38638FC76071F0F83_
+0FFFDF7FFE1EFFE1FBF6FE7F061FCFEF03FBFF83_
+0FFF8E3FFE1EF5C0F1E67C3E060F87CF01F3FF83_
+07FF0E1FFC1EF1D1E33C7C3E0C0F87C079F3FF83_
+03FE0E0FF81EF3FBF37EFE7F0C1FCFE07BFBFF83_
+00F80E03E00CE7773B67C7E38C38FC70371F8783_
+00000E00000CC6F61B6683C18C30683FFA0DC0C6_
+00001F00000DCFF61B6603C18630603FF80CE0FE_
+00001F00000D8FB01B667BE386306036300C70FE_
+00003F80000F86301B66FF7F0638E836309C38C6_
+00003F80000F06301B67C73E033FDC7331F81C6C_
+00007FC0000F06301B67837F03379FE330F00E6C_
+0000FFE0000F86301B6783E381B01BC1B070066C_
+0001FFF0000DC6301B6783C181B05801B03B066C_
+0003FFF8000CE7701B67C7E3E0F8F800F61F8E38_
+00000000001EF3E03F7EFE7F7FDFDFE0F7FDFC38_
+00000000001EF1C03F3C7C3E7FCF9FE077FCF838_
+"
+end
+
+
+# The following notices accompanied the original Spider source from which
+# these bitmaps were taken.
+
+
+# Copyright 1990 Heather Rose and Sun Microsystems, Inc.
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that copyright
+# notice and this permission notice appear in supporting documentation, and
+# that the names of Donald Woods and Sun Microsystems not be used in
+# advertising or publicity pertaining to distribution of the software without
+# specific, written prior permission.  Heather Rose and Sun Microsystems not
+# be used in								[_sic_]
+# advertising or publicity pertaining to distribution of the software without
+# specific, written prior permission.  Heather Rose and Sun Microsystems make
+# no representations about the suitability of this software for any purpose.
+# It is provided "as is" without express or implied warranty.
+#
+# THE ABOVE-NAMED DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN NO EVENT
+# SHALL HEATHER ROSE OR SUN MICROSYSTEMS BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE,
+# DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+# TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
+# OF THIS SOFTWARE.
+#
+# Author:
+#		Heather Rose
+#		hrose@sun.com
+#
+#		Sun Microsystems, Inc.
+#		2550 Garcia Avenue
+#		Mountain View, CA  94043
+
+
+# Copyright 1990 David Lemke and Network Computing Devices
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of Network Computing Devices not be
+# used in advertising or publicity pertaining to distribution of the
+# software without specific, written prior permission.  Network Computing
+# Devices makes no representations about the suitability of this software
+# for any purpose.  It is provided "as is" without express or implied
+# warranty.
+#
+# NETWORK COMPUTING DEVICES DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS
+# SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
+# IN NO EVENT SHALL NETWORK COMPUTING DEVICES BE LIABLE FOR ANY SPECIAL,
+# INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
+# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE
+# OR PERFORMANCE OF THIS SOFTWARE.
+#
+# Author:
+#		Dave Lemke
+#		lemke@ncd.com
+#
+#		Network Computing Devices, Inc
+#		350 North Bernardo Ave
+#		Mountain View, CA 94043
+#
+#	@(#)copyright.h	2.2	90/04/27
+
+
+# Copyright (c) 1989, Donald R. Woods and Sun Microsystems, Inc.
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that copyright
+# notice and this permission notice appear in supporting documentation, and
+# that the names of Donald Woods and Sun Microsystems not be used in
+# advertising or publicity pertaining to distribution of the software without
+# specific, written prior permission.  Donald Woods and Sun Microsystems make
+# no representations about the suitability of this software for any purpose.
+# It is provided "as is" without express or implied warranty.
+#
+# THE ABOVE-NAMED DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN NO EVENT
+# SHALL DONALD WOODS OR SUN MICROSYSTEMS BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE,
+# DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+# TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
+# OF THIS SOFTWARE.
+#
+# History: Spider is a solitaire card game that can be found in various books
+# of same; the rules are presumed to be in the public domain.  The author's
+# first computer implementation was on the Stanford Artificial Intelligence Lab
+# system (SAIL).  It was later ported to the Xerox Development Environment.
+# The card images are loosely based on scanned-in images but were largely
+# redrawn by the author with help from Larry Rosenberg.
+#
+# This program is written entirely in NeWS and runs on OPEN WINDOWS 1.0.
+# It could be made to run much faster if parts of it were written in C, using
+# NeWS mainly for its display and input capabilities, but that is left as an
+# exercise for the reader.  Spider may also run with little or no modification
+# on subsequent releases of OPEN WINDOWS, but no guarantee is made on this
+# point (nor any other; see above!).  To run Spider, feed this file to 'psh'.
+#
+# Author:	Don Woods
+#		woods@sun.com
+#
+#		Sun Microsystems, Inc.
+#		2550 Garcia Avenue
+#		Mountain View, CA  94043
diff --git a/ipl/gprocs/cells.icn b/ipl/gprocs/cells.icn
new file mode 100644
index 0000000..4bd59f0
--- /dev/null
+++ b/ipl/gprocs/cells.icn
@@ -0,0 +1,191 @@
+############################################################################
+#
+#	File:     cells.icn
+#
+#	Subject:  Procedures for creating and coloring panels of cells
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 16, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures create an manipulate panels of cells.
+#
+#	makepanel(n, m, size, fg, bg, pg)
+#		makes a panel in a hidden window with nxm cells of the
+#		given size, default 10.  fg, bg, and pg are the
+#		colors for the window and panel backgrounds. fg
+#		and bg default to black and white, respectively.
+#		If pg is not given a patterned background is used.
+#
+#	matrixpanel(matrix, size, fg, bg, pg)
+#		same as makepanel(), except matrix determines the
+#		dimensions.
+#
+#	clearpanel(panel)
+#		restores the panel to its original state as made by
+#		makepanel.
+#
+#	colorcell(panel, n, m, color)
+#		colors the cell (n,m) in panel with color. 
+#
+#	colorcells(panel, tier)
+#		is like colorcell(), except it operates on a tie-up
+#		record.
+#
+#	cell(panel, x, y)
+#		returns Cell() record for the cell in which x,y
+#		lies.  If fails if the point is out of bounds.
+#
+#	tiercells(panel, matrix)
+#		is like colorcell(), except all cells are colored
+#		using a matrix of colors.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+record Cell(n, m, color)
+record Panel(window, n, m, size, fg, bg, pg)
+
+procedure makepanel(n, m, cellsize, fg, bg, pg)		#: make panel of cells
+   local window, x, y, width, height, panel
+
+   /fg := "black"
+   /bg := "white"
+
+   /cellsize := 10
+
+   width := (n * cellsize) + 1
+   height := (m * cellsize) + 1
+
+   window := WOpen("width=" || width, "height=" || height,
+      "fg=" || fg, "bg=" || bg, "canvas=hidden") | fail
+
+   panel := Panel(window, n, m, cellsize, fg, bg, pg)
+
+   clearpanel(panel)
+
+   return panel
+
+end
+
+procedure clearpanel(panel)
+   local width, height, x, y
+   
+   if \panel.pg then {			# default is textured
+      WAttrib(panel.window, "fillstyle=textured")
+      Pattern(panel.window, "checkers")
+      Bg(panel.window, "very dark gray")
+      }
+   else Fg(panel.window, panel.fg)
+
+   width := WAttrib(panel.window, "width")
+   height := WAttrib(panel.window, "height")
+
+   every x := 0 to width by panel.size do
+      DrawLine(panel.window, x, 0, x, height)
+
+   every y := 0 to height by panel.size do
+      DrawLine(panel.window, 0, y, width, y)
+
+   WAttrib(panel.window, "fillstyle=solid")
+
+   return panel
+
+end
+
+procedure matrixpanel(matrix, cellsize, fg, bg, pg)
+
+   return makepanel(*matrix[1], *matrix, cellsize, fg, bg)
+
+end
+
+procedure colorcell(panel, n, m, color)		#: color cell in panel
+   local cellsize
+
+   if not(integer(n) & integer(m)) then
+      stop("Non-integer value to colorcell(). n=", image(n), " m=", image(m))
+
+   cellsize := panel.size
+
+   Fg(panel.window, color)
+
+   FillRectangle(panel.window, (n - 1) * cellsize + 1, (m - 1) * cellsize + 1,
+       cellsize - 1, cellsize - 1)
+
+   return panel
+ 
+end
+
+procedure colorcells(panel, matrix)		#: color all cells in panel
+   local i, j, n, m, cellsize
+
+   cellsize := panel.size
+
+   m := *matrix
+   n := *matrix[1]
+
+   every i := 1 to m do {
+      every j := 1 to n do {
+         # fudge 0/1 matrix
+         if matrix[i, j] === "1" then matrix[i, j] := "white"
+         else if matrix[i, j] === "0" then matrix[i, j] := "black"
+         Fg(panel.window, matrix[i, j])
+            stop("Fg() failed in colorcells() with matrix[" ||
+              i || "," || j || "]=" || matrix[i, j] || ".")
+         FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
+            cellsize - 1, cellsize - 1)
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure tiercells(panel, tier)		#: color all cells in panel
+   local i, j, n, m, cellsize, matrix
+
+   cellsize := panel.size
+
+   m := tier.shafts
+   n := tier.treadles
+   matrix := tier.matrix
+
+   every i := 1 to m do {
+      every j := 1 to n do {
+         if matrix[i, j] === "1" then Fg(panel.window, "white")
+         else Fg(panel.window, "black")
+         FillRectangle(panel.window, (j - 1) * cellsize + 1, (i - 1) * cellsize + 1,
+            cellsize - 1, cellsize - 1)
+         }
+      }
+
+   return panel
+ 
+end
+
+procedure cell(panel, x, y)
+   local n, m
+
+   n := x / panel.size + 1
+   m := y / panel.size + 1
+
+   if (n > panel.n) | (m > panel.m) then fail
+
+   return Cell(n, m, Pixel(panel.window, x, y))
+
+end
diff --git a/ipl/gprocs/clip.icn b/ipl/gprocs/clip.icn
new file mode 100644
index 0000000..a3b9538
--- /dev/null
+++ b/ipl/gprocs/clip.icn
@@ -0,0 +1,78 @@
+############################################################################
+#
+#	File:     clip.icn
+#
+#	Subject:  Procedures for clipboard operations
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  XCopy(window, x, y, w, h) copies an area of window to the clipboard.
+#
+#  XCut(window, x, y, w, h) copies an area of window to the clipboard and
+#  erases it from window.
+#
+#  XPaste(window, x, y) copies the clipboard to position x,y in window.
+#
+#  NewClip(w, h) is a utility procedure that discards the old clipboard and
+#  creates a new one of the specified dimensions.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  xcompat
+#
+############################################################################
+
+link xcompat
+
+global Clipboard
+
+procedure NewClip(w, h)
+
+   close(\Clipboard)
+
+   Clipboard := XBind(, , "width=" || w, "height=" || h) |
+      stop("*** cannot create clipboard")
+
+   return
+
+end
+
+procedure XCopy(window, x, y, w, h)
+
+   NewClip(w, h)
+
+   CopyArea(window, Clipboard, x, y, w, h)
+
+   return
+
+end
+
+procedure XCut(window, x, y, w, h)
+
+   XCopy(window, x, y, w, h)
+
+   EraseArea(window, x, y, w, h)
+
+   return
+
+end
+
+procedure XPaste(window, x, y)
+
+   CopyArea(Clipboard, window, , , , , x, y)
+
+   return
+
+end
diff --git a/ipl/gprocs/clipping.icn b/ipl/gprocs/clipping.icn
new file mode 100644
index 0000000..5220690
--- /dev/null
+++ b/ipl/gprocs/clipping.icn
@@ -0,0 +1,135 @@
+############################################################################
+#
+#	File:     clipping.icn
+#
+#	Subject:  Procedures for clipping lines
+#
+#	Authors:  William S. Evans and Gregg M. Townsend
+#
+#	Date:     June 16, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	ClipLine(W, L, x, y, w, h) clips the multisegment line specified
+#	by coordinates in L to the region (x, y, w, h), which defaults
+#	to the clipping region of the window W.  ClipLine() returns a
+#	list of coordinates suitable for calling DrawSegment().  If no
+#	segments remain after clipping, ClipLine() fails.
+#
+#	Coalesce(L) connects adjoining segments from a DrawSegment()
+#	argument list such as is produced by ClipLine().  Coalesce()
+#	returns a list of DrawLine() lists.
+#
+#	DrawClipped(W, x1, y1, x2, y2, ...) draws a line using ClipLine()
+#	with the clipping region of the window W.  DrawClipped() is
+#	superior to DrawLine() only when lines with extremely large
+#	coordinate values (beyond +/-32767) are involved.
+#
+############################################################################
+
+ 
+#  DrawClipped(W, x1, y1, x2, y2, ...) -- draw line using ClipLine()
+
+procedure DrawClipped(a[])		#: draw line with clipping
+   local win
+
+   if type(a[1]) == "window" then
+      win := pop(a)
+   else
+      win := &window
+
+   DrawSegment ! push(ClipLine(win, a), win)
+   return win
+end
+
+
+#  ClipLine(W, L, x, y, w, h) -- clip polyline to region, returning segments.
+#
+#  Cyrus-Beck parametric line clipping with Liang-Barsky
+#  optimizations for axis-aligned rectangular clipping regions.
+
+procedure ClipLine(win, L, x, y, w, h)	#: clip line for DrawSegment
+   local i, ret, tin, tout, delx, dely, x0, x1, xmax, y0, y1, ymax
+
+   if (type(win) == "list") then		# window param is optional
+      return ClipLine(&window, win, L, x, y, w)
+
+   /x := WAttrib(win, "clipx") - WAttrib(win, "dx")
+   /y := WAttrib(win, "clipy") - WAttrib(win, "dy")
+   /w := WAttrib(win, "clipw")
+   /h := WAttrib(win, "cliph")
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+   xmax := x + w
+   ymax := y + h
+
+   ret := []
+   x1 := L[1]
+   y1 := L[2]
+
+   every i := 3 to *L by 2 do {
+      x0 := x1
+      y0 := y1
+      x1 := L[i]
+      y1 := L[i + 1]
+      tin := 0.0
+      tout := 1.0
+
+      delx := real(x1 - x0)
+      if delx < 0.0 then {
+         tin <:= (xmax - x0) / delx
+         tout >:= (x - x0) / delx
+         }
+      else if delx > 0.0 then {
+         tin <:= (x - x0) / delx
+         tout >:= (xmax - x0) / delx
+         }
+      else
+         x <= x0 <= xmax | next
+      if tout < tin then next
+   
+      dely := real(y1 - y0)
+      if dely < 0.0 then {
+         tin <:= (ymax - y0) / dely
+         tout >:= (y - y0) / dely
+         }
+      else if dely > 0.0 then {
+         tin <:= (y - y0) / dely
+         tout >:= (ymax - y0) / dely
+         }
+      else
+         y <= y0 <= ymax | next
+      if tout < tin then next
+
+      put(ret, x0 + tin*delx, y0 + tin*dely, x0 + tout*delx, y0 + tout*dely)
+      }
+
+   if *ret > 0 then
+      return ret
+   else
+      fail
+end
+
+
+#  Coalesce(L) -- connect adjoining segments
+
+procedure Coalesce(L)			#: connect adjoining segments
+   local i, all, seg, x1, y1, x2, y2
+
+   all := []
+   every i := 1 to *L by 4 do {
+      x1 := L[i]
+      y1 := L[i + 1]
+      if x1 ~=== x2 | y1 ~=== y2 then
+         put(all, seg := [x1, y1])
+      put(seg, x2 := L[i + 2], y2 := L[i + 3])
+      }
+
+   return all
+end
diff --git a/ipl/gprocs/clrnames.icn b/ipl/gprocs/clrnames.icn
new file mode 100644
index 0000000..80b110e
--- /dev/null
+++ b/ipl/gprocs/clrnames.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     clrnames.icn
+#
+#	Subject:  Procedure to generate color names
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure generates all the color names in the Icon portable color
+#  naming system.  Not all names produce unique colors.
+#
+############################################################################
+
+procedure clrnames()
+   static lightness, saturation, hue1, hue2
+
+   hue2 := ["black", "gray", "white", "pink", "violet",
+      "brown", "red", "orange", "yellow", "green", "cyan",
+      "blue", "purple", "magenta"]
+   hue1 := hue2 ||| ["blackish", "grayish", "whitish", "pinkish",
+      "violetish", "brownish", "reddish", "orangish", "yellowish",
+      "greenish", "cyanish", "bluish", "purplish", "magentaish"]
+   saturation := ["weak", "moderate", "strong", "vivid"]
+   lightness := ["very light", "light", "medium", "dark", "very dark"]
+
+   suspend !lightness || " " || !saturation || " " || !hue2
+   suspend !lightness || " " || !saturation || " " || !hue1 || " " || !hue2
+
+end
diff --git a/ipl/gprocs/clrutils.icn b/ipl/gprocs/clrutils.icn
new file mode 100644
index 0000000..9dcbed6
--- /dev/null
+++ b/ipl/gprocs/clrutils.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     clrutils.icn
+#
+#	Subject:  Procedures to convert color formats
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures convert between comma-separated Icon color
+#  specifications and a record with r, g, and b fields.
+#
+############################################################################
+
+record RGB(r, g, b)
+
+procedure colortorgb(color)		#: rgb record for color
+   local rgb
+
+   rgb := RGB()
+
+   color ? {
+      rgb.r := tab(upto(',')) | fail
+      move(1)
+      rgb.g := tab(upto(',')) | fail
+      move(1)
+      rgb.b := tab(0)
+      }
+
+   return rgb
+
+end
+
+procedure rgbtocolor(rgb)
+
+   return rgb.r || "," || rgb.g || "," || rgb.b
+
+end
diff --git a/ipl/gprocs/color.icn b/ipl/gprocs/color.icn
new file mode 100644
index 0000000..615ca05
--- /dev/null
+++ b/ipl/gprocs/color.icn
@@ -0,0 +1,526 @@
+############################################################################
+#
+#	File:     color.icn
+#
+#	Subject:  Procedures dealing with colors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures deal with colors in various ways.
+#
+#	ScaleGamma(v, g)	scales a number with gamma correction.
+#
+#	Blend(k1, k2, ...)	generates a sequence of colors.
+#
+#	Contrast(win, k)	returns "white" or "black" contrasting with k.
+#
+#	Shade(win, k)		sets Fg(), with dithering on a bilevel screen.
+#
+#	RandomColor(W, p)	returns a randomly chosen color from a palette.
+#
+#	PaletteGrays(W, p)	returns the gray entries of a palette.
+#
+#	RGBKey(W, p, r, g, b)	returns the palette key closest to (r,g,b).
+#
+#	HSVKey(W, p, h, s, v)	returns the palette key closest to (h/s/v).
+#
+#	HSV(k)			returns the h/s/v interpretation of a color.
+#
+#	HSVValue(hsv)		returns the ColorValue() of an h/s/v string.
+#
+#	HLS(k)			returns the h:l:s interpretation of a color.
+#
+#	HLSValue(hls)		returns the ColorValue() of an h:l:s string.
+#
+############################################################################
+#
+#  ScaleGamma(v, g) nonlinearly scales the number v (between 0.0 and 1.0)
+#  to an integer between 0 and 65535 using a gamma correction factor g.
+#  the default value of g is 2.5.
+#
+#  Blend(color1, color2, color3,...) generates ColorValue(color1), then
+#  some intermediate shades, then ColorValue(color2), then some more
+#  intermediate shades, and so on, finally generating the color value of
+#  the last argument.  An integer argument can be interpolated at any
+#  point to set the number of steps (the default is four) from one color
+#  to the next.
+#
+#  Contrast(win, colr) returns either "white" or "black", depending
+#  on which provides the greater contrast with the specified color.
+#
+#  Shade(win, colr) sets the foreground for an area filling operation.
+#  On a color screen, Shade() sets the foreground color and returns the
+#  window.  On a bilevel monochrome screen, Shade() sets the foreground
+#  to a magic-square dithering pattern approximating the luminance of the
+#  color specified.  If the environment variable XSHADE is set to "gray"
+#  (or "grey") then Shade simulates a multilevel grayscale monitor.
+#  If it is set to any other value, Shade simulates a bilevel monitor.
+#
+#  RandomColor(win, palette) returns a randomly chosen color from the
+#  given image palette, excluding the "extra" grays of the palette, if
+#  any.  (Colors are selected from a small finite palette, rather than
+#  from the entire color space, to avoid running out of colors if a
+#  large number of random choices are desired.)  The default palette
+#  for this procedure is "c6".
+#
+#  PaletteGrays([win,] palette) is like PaletteChars but it returns only
+#  the characters corresponding to shades of gray.  The characters are
+#  ordered from black to white, and in all palettes the shades of gray
+#  are equally spaced.
+#
+#  RGBKey([win,] palette, r, g, b) returns a palette key given the
+#  three color components as real number from 0.0 to 1.0.
+#  HSVKey([win,] palette, h, s, v) returns a palette key given a
+#  hue, saturation, and value as real numbers from 0.0 to 1.0.
+#
+#  HSV() and HSVValue() convert between Icon color strings and strings
+#  containing slash-separated HSV values with maxima of "360/100/100".
+#  HSV(k) returns the h/s/v interpretation of an Icon color specification;
+#  HSVValue(hsv) translates an h/s/v value into an Icon r,g,b value.
+#
+#  HLS() and HLSValue() convert between Icon color strings and strings
+#  containing colon-separated HLS values with maxima of "360:100:100".
+#  HLS(k) returns the h:l:s interpretation of an Icon color specification;
+#  HLSValue(hls) translates an h:l:s value into an Icon r,g,b value.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+#   ScaleGamma(v, g) -- scale fraction to int with gamma correction.
+
+procedure ScaleGamma(v, g)		#: scale with gamma correction
+   /g := 2.5
+   return integer(65535 * v ^ (1.0 / g))
+end
+
+
+#  Blend(color1, color2, ...) -- generate sequence of colors
+
+procedure Blend(args[])			#: generate sequence of colors
+   local win, n, s, a, i, f1, f2, r1, g1, b1, r2, g2, b2, r3, g3, b3
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   n := 4
+   if type(args[1]) == "window" then
+      win := get(args)
+   else
+      win := &window
+
+   while a := get(args) do
+      if integer(a) >= 0 then
+         n := integer(a)
+      else {
+         s := ColorValue(win, a) | fail
+         s ? {
+            r2 := tab(many(&digits));  move(1)
+            g2 := tab(many(&digits));  move(1)
+            b2 := tab(many(&digits))
+            }
+         if /r1 then
+            suspend s
+         else
+            every i := 1 to n do {
+               f2 := real(i) / real(n)
+               f1 := 1.0 - f2
+               r3 := integer(f1 * r1 + f2 * r2)
+               g3 := integer(f1 * g1 + f2 * g2)
+               b3 := integer(f1 * b1 + f2 * b2)
+               suspend r3 || "," || g3 || "," || b3
+               }
+         r1 := r2
+         g1 := g2
+         b1 := b2
+         }
+end
+
+
+#  Contrast(win, color) -- return "white" or "black" to maximize contrast
+
+procedure Contrast(win, color)		#: choose contrasting color
+   static l, type
+   initial {
+      l := ["white", "black"]
+      type := proc("type", 0)	# protect attractive name
+      }
+       
+   if type(win) == "window" then
+      return l[1 + PaletteKey(win, "g2", color)]
+   else
+      return l[1 + PaletteKey("g2", win)]
+end
+
+
+#  Shade(win, color) -- approximate a shade with a pattern if bilevel screen
+
+procedure Shade(win, color)		#: dither shade using pattern
+   local r, g, b
+   static dmat, env, type
+
+   initial {
+      env := ("" ~== map(getenv("XSHADE")))
+      type := proc("type", 0)	# protect attractive name
+      }
+
+   if type(win) ~== "window" then {
+      color := win
+      win := &window
+      }
+   if WAttrib(win, "depth") ~== "1" & /env then {
+      Fg(win, color) | fail
+      return win
+      }
+   (ColorValue(win, color) | fail) ? {
+      r := tab(many(&digits));  move(1)
+      g := tab(many(&digits));  move(1)
+      b := tab(many(&digits))
+      }
+   g := integer(0.30 * r + 0.59 * g + 0.11 * b)
+
+   if \env == ("gray" | "grey") then {
+      Fg(win, g || "," || g || "," || g)
+      return win
+      }
+
+   /dmat := [
+      "4,15,15,15,15",
+      "4,15,15,13,15",
+      "4,11,15,13,15",
+      "4,10,15,13,15",
+      "4,10,15,5,15",
+      "4,10,7,5,15",
+      "4,10,7,5,14",
+      "4,10,7,5,10",
+      "4,10,5,5,10",
+      "4,10,5,5,2",
+      "4,10,4,5,2",
+      "4,10,0,5,2",
+      "4,10,0,5,0",
+      "4,8,0,5,0",
+      "4,8,0,1,0",
+      "4,8,0,0,0",
+      "4,0,0,0,0",
+      ]
+   WAttrib(win, "fillstyle=textured")
+   g := g / 3856 + 1
+   Pattern(win, dmat[g])
+   return win
+end
+
+
+#   RandomColor(win, palette) -- choose random color
+
+procedure RandomColor(win, palette)	#: choose random color
+   local s, n
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      palette:= win			# window allowed but ignored
+   /palette := "c6"
+
+   s := PaletteChars(palette)
+   palette ?
+      if ="c" & any('23456') then {
+         n := integer(move(1))
+         s := s[1 +: n * n * n]
+         }
+   return PaletteColor(palette, ?s)
+
+end
+
+
+#  PaletteGrays(win, palette) -- return grayscale entries from palette.
+
+procedure PaletteGrays(win, palette)	#: grayscale entries from palette
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if (type(win) ~== "window") then
+      palette := win				# window not needed
+
+   palette := string(palette) | runerr(103, palette)
+
+   if palette ? ="g" then
+      return PaletteChars(palette)
+
+   return case palette of {
+      "c1":	"0123456"
+      "c2":	"kxw"
+      "c3":	"@abMcdZ"
+      "c4":	"0$%&L*+-g/?@}"
+      "c5":	"\0}~\177\200\37\201\202\203\204>\205\206\207\210]_
+                  \211\212\213\214|"
+      "c6":	"\0\330\331\332\333\334+\335\336\337\340\341V\342\343\344\345_
+                  \346\201\347\350\351\352\353\254\354\355\356\357\360\327"
+      default:	fail
+      }
+end
+
+
+#  RGBKey(win, palette, r, g, b) -- find key given real-valued color
+
+procedure RGBKey(win, palette, r, g, b)	#: return palette key for color
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then	# allow unused window argument
+      win :=: palette :=: r :=: g :=: b
+   r := integer(r * 65535.99)
+   g := integer(g * 65535.99)
+   b := integer(b * 65535.99)
+   return PaletteKey(palette, r || "," || g || "," || b)
+end
+
+
+#  HSVKey(win, palette, h, s, v) -- find nearest key from h,s,v in [0.0,1.0]
+#
+#  HSV conversion based on Foley et al, 2/e, p.593
+
+procedure HSVKey(win, palette, h, s, v)	#: nearest key from HSV specification
+   local i, f, p, q, t, r, g, b
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then	# allow unused window argument
+      win :=: palette :=: h :=: s :=: v
+
+   if s = 0.0 then			# achromatic case
+      return RGBKey(palette, v, v, v)
+
+   h *:= 6.0				# hue [0.0 - 6.0)
+   if h >= 6.0 then
+      h := 0.0
+
+   i := integer(h)
+   f := h - i
+   p := v * (1.0 - s)
+   q := v * (1.0 - f * s)
+   t := v * (1.0 - (1.0 - f) * s)
+
+   case i of {
+      0: { r := v;  g := t;  b := p }	# red - yellow
+      1: { r := q;  g := v;  b := p }	# yellow - green
+      2: { r := p;  g := v;  b := t }	# green - cyan
+      3: { r := p;  g := q;  b := v }	# cyan - blue
+      4: { r := t;  g := p;  b := v }	# blue - magenta
+      5: { r := v;  g := p;  b := q }	# magenta - red
+      }
+
+   return RGBKey(palette, r, g, b)
+end
+
+
+#  HSV(k) -- return h/s/v interpretation of color spec.
+#
+#  h is hue (0 <= h < 360)
+#  s is saturation (0 <= s <= 100)
+#  v is value (0 <= v <= 100)
+#
+#  based on Foley et al, 2/e, p.592
+
+procedure HSV(k)			#: HSV interpretation of color
+   local r, g, b, h, s, v, min, max, d
+
+   (ColorValue(k) | fail) ? {
+      r := tab(many(&digits)) / 65535.0
+      move(1)
+      g := tab(many(&digits)) / 65535.0
+      move(1)
+      b := tab(many(&digits)) / 65535.0
+      }
+
+   min := r;  min >:= g;  min >:= b		# minimum
+   max := r;  max <:= g;  max <:= b		# maximum
+   d := max - min				# difference
+
+   v := max					# value is max of all values
+   if max > 0 then
+      s := d / max				# saturation is (max-min)/max
+   else
+      s := 0.0
+
+   if s = 0 then
+      h := 0.0					# use hue 0 if unsaturated
+   else if g = max then
+      h := 2 + (b - r) / d			# yellow through cyan
+   else if b = max then
+      h := 4 + (r - g) / d			# cyan through magenta
+   else if g < b then
+      h := 6 + (g - b) / d			# magenta through red
+   else
+      h := (g - b) / d				# red through yellow
+
+   return integer(60 * h + 0.5) || "/" ||
+      integer(100 * s + 0.5) || "/" || integer(100 * v + 0.5)
+end
+
+
+#  HSVValue(hsv) -- return ColorValue of h/s/v string
+#
+#  h is hue (0 <= h <= 360)
+#  s is saturation (0 <= s <= 100)
+#  v is value (0 <= v <= 100)
+#
+#  based on Foley et al, 2/e, p.593
+
+procedure HSVValue(hsv)			#: color value of HSV specification
+   local h, s, v, r, g, b, i, f, p, q, t
+
+   hsv ? {
+      h := tab(many(&digits)) / 360.0 | fail
+      ="/" | fail
+      s := tab(many(&digits)) / 100.0 | fail
+      ="/" | fail
+      v := tab(many(&digits)) / 100.0 | fail
+      pos(0) | fail
+      }
+   if (h | s | v) > 1 then fail
+
+   if s = 0.0 then {			# achromatic case
+      v := integer(65535 * v + 0.499999)
+      return v || "," || v || "," || v
+      }
+
+   h *:= 6.0				# hue [0.0 - 6.0)
+   if h >= 6.0 then
+      h := 0.0
+
+   i := integer(h)
+   f := h - i
+   p := v * (1.0 - s)
+   q := v * (1.0 - f * s)
+   t := v * (1.0 - (1.0 - f) * s)
+
+   case i of {
+      0: { r := v;  g := t;  b := p }	# red - yellow
+      1: { r := q;  g := v;  b := p }	# yellow - green
+      2: { r := p;  g := v;  b := t }	# green - cyan
+      3: { r := p;  g := q;  b := v }	# cyan - blue
+      4: { r := t;  g := p;  b := v }	# blue - magenta
+      5: { r := v;  g := p;  b := q }	# magenta - red
+      }
+
+   return integer(65535 * r + 0.499999) || "," ||
+      integer(65535 * g + 0.499999) || "," || integer(65535 * b + 0.499999)
+end
+
+
+#  HLS(k) -- return h:l:s interpretation of color spec.
+#
+#  h is hue (0 <= h < 360)
+#  l is lightness (0 <= l <= 100)
+#  s is saturation (0 <= s <= 100)
+#
+#  based on Foley et al, 2/e, p.595
+
+procedure HLS(k)			#: HLS interpretation of color
+   local r, g, b, h, l, s, min, max, delta
+
+   (ColorValue(k) | fail) ? {
+      r := tab(many(&digits)) / 65535.0
+      move(1)
+      g := tab(many(&digits)) / 65535.0
+      move(1)
+      b := tab(many(&digits)) / 65535.0
+      }
+
+   min := r;  min >:= g;  min >:= b	# minimum
+   max := r;  max <:= g;  max <:= b	# maximum
+   delta := max - min			# difference
+
+   l := (max + min) / 2			# lightness
+
+   if max = min then 
+      h := s := 0			# achromatic
+
+   else {
+
+      if l <= 0.5 then
+         s := delta / (max + min)	# saturation
+      else
+         s := delta / (2 - max - min)
+
+      if r = max then
+         h := (g - b) / delta		# yellow through magenta
+      else if g = max then
+         h := 2 + (b - r) / delta	# cyan through yellow
+      else # b = max
+         h := 4 + (r - g) / delta	# magenta through cyan
+      if h < 0 then
+         h +:= 6			# ensure positive value
+      }
+
+   return integer(60 * h + 0.5) || ":" ||
+      integer(100 * l + 0.5) || ":" || integer(100 * s + 0.5)
+end
+
+
+#  HLSValue(hls) -- return ColorValue of h:l:s string
+#
+#  h is hue (0 <= h <= 360)
+#  l is lightness (0 <= l <= 100)
+#  s is saturation (0 <= s <= 100)
+#
+#  based on Foley & Van Dam, 1/e, p.619
+
+procedure HLSValue(hls)			#: color value of HLS specification
+   local h, l, s, r, g, b, m1, m2
+
+   hls ? {
+      h := tab(many(&digits)) / 360.0 | fail
+      =":" | fail
+      l := tab(many(&digits)) / 100.0 | fail
+      =":" | fail
+      s := tab(many(&digits)) / 100.0 | fail
+      pos(0) | fail
+      }
+   if (h | l | s) > 1 then fail
+
+   if l <= 0.5 then
+      m2 := l * (1 + s)
+   else
+      m2 := l + s - (l * s)
+   m1 := 2 * l - m2
+
+   if s = 0.0 then
+      r := g := b := l			# achromatic
+   else {
+      r := hls_rgb_val(m1, m2, h + 0.3333333)
+      g := hls_rgb_val(m1, m2, h)
+      b := hls_rgb_val(m1, m2, h - 0.3333333)
+      }
+
+   return integer(65535 * r + 0.499999) || "," ||
+      integer(65535 * g + 0.499999) || "," || integer(65535 * b + 0.499999)
+end
+
+procedure hls_rgb_val(n1, n2, hue)	# helper function for HLSValue
+   hue *:= 6
+   if hue >= 6 then
+      hue -:= 6
+   else if hue < 0 then
+      hue +:= 6
+   if (hue < 1) then
+      return n1 + (n2 - n1) * hue
+   else if (hue < 3) then
+      return n2
+   else if (hue < 4) then
+      return n1 + (n2 - n1) * (4 - hue)
+   else
+      return n1
+end
diff --git a/ipl/gprocs/colorway.icn b/ipl/gprocs/colorway.icn
new file mode 100644
index 0000000..1324286
--- /dev/null
+++ b/ipl/gprocs/colorway.icn
@@ -0,0 +1,470 @@
+############################################################################
+#
+#	File:     colorway.icn
+#
+#	Subject:  Procedures to manipulate color ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Note:  This file contains procedures that can be linked by programs
+#  to add a visual interface, including programs that have one of their
+#  own.
+#
+#  These procedures support the interactive creation and modification of
+#  color ways.  ("Color way" is a the term used in the fashion industry for
+#  a list of colors used in coordination for fabric design or other
+#  decorative purposes.  Think color scheme if you like.)
+#
+############################################################################
+#
+#  A color way is represented by a list of color specifications.  A
+#  color specification consists of a name and an associated color.
+#  Color ways are presented in alphabetical order of their color names,
+#  with the name at the left and a swatch for the corresponding color
+#  at the right of the name.
+#
+#  The "edit" button is used to switch between two modes:  control and
+#  edit.
+#
+#  In the control mode, the interface menus and the "edit" button
+#  are available. The "File" menu provides for creating a new color
+#  way, loading an existing color way from a file, and saving the
+#  current color way.  (Only one color way can be manipulated at a time.)
+#  A new color way starts empty.  There also is an item to pick a colorway
+#  file (which must have suffix "cw").
+#
+#  The "Ways" menu allows adding and deleting color specifications from
+#  the current color way.  When adding, a name dialog is presented first,
+#  followed by a color dialog.  Color specifications are added until
+#  the user cancels one of the dialogs.  When deleting, all of the
+#  current color specifications are listed by name, and more than one
+#  can be selected for deletion.
+#
+#  In the edit mode, changes can be made to the current color way.  This is
+#  done in the window displaying the current color way.   Clicking on a name
+#  in the color way window produces a dialog to change that name.  (The new
+#  name cannot be one already in use in the color way.)  Clicking on a
+#  color swatch to the right of a name beings up a color dialog for selecting
+#  a new color for that name.  (The same color can appear in more than one
+#  color specification.)
+#
+#  In the editing mode, pressing the meta key while clicking on a
+#  line of the color way causes the color to be deleted.
+#
+#  The editing mode is exited by typing a "q" in the color way display
+#  window.
+#
+#  Shortcuts exist for all interface features.   @E is a shortcut for
+#  entering the edit mode.
+#
+#  Note:  The current mode is shown by the "edit" button, which is high-
+#  lighted when in the edit mode.  There nonetheless can be confusion about
+#  the current mode.
+#
+#  Unimplemented feature:  Prompting user to save color way that has been
+#  modified since last save.
+#
+############################################################################
+#
+#  See also:  cw.icn
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX for "pick feature"
+#
+############################################################################
+#
+#  Links:  interact, io, lists, strings, tables, vsetup, xcode
+#
+############################################################################
+
+link interact
+link io
+link lists
+link strings
+link tables
+link vsetup
+link xcode
+
+global cw_active			# edit-mode switch
+global cw_active_vidget		# edit-mode vidget 
+global cw_touched
+global cw_vidgets
+global cw_root
+global cw			# current color way
+global cw_file			# file name for current color way
+global cw_names			# list of color way names
+global cw_col			# position of color field in cw_win
+global cw_win			# window for current cw
+global cw_interface		# interface window
+global cw_yoff			# y offset from top of interface window
+
+record colorway(table)		# note:  "table" does not conflict
+				# with the function name.  The
+				# field contains a table.
+
+$define ui      cw_ui		# to avoid conflict with other VIB interfaces
+$define ui_atts cw_ui_atts
+
+$define Pad	10		# name padding
+$define Lheight	30		# line height
+$define Cwidth 100		# color width
+
+procedure cw_init()
+   local atts
+
+   atts := ui_atts()
+
+   put(atts, "posx=10", "posy=10")
+
+   cw_interface := (WOpen !atts) | stop("can't open window")
+   cw_vidgets := ui()		# set up vidgets
+
+   cw_yoff := WAttrib(cw_interface, "height") + 45
+
+   cw_root := cw_vidgets["root"]
+   cw_active_vidget := cw_vidgets["active"]
+   cw_active := &null		# initially inactive
+
+   return
+
+end
+
+procedure edit_cw()
+   local name
+
+   expose(cw_win)
+
+   repeat {
+      case Event(cw_win) of {
+         &lpress | &mpress | &rpress:   {
+            name := cw_names[(&y / Lheight) + 1]
+            if &meta then {
+               delete(cw.table, name)
+               cw_touched := 1
+               win_cw()
+               }
+            else if &x > cw_col then {
+               if ColorDialog("Select color:", cw.table[name]) ==
+                  "Cancel" then next
+               cw.table[name] := dialog_value
+               cw_touched := 1
+               win_cw()
+               }
+            else {
+               repeat {
+                  if TextDialog("Change name:", , name, 60) ==
+                     "Cancel" then break
+                  if dialog_value[1] == name then break		 # no change
+                  if member(cw.table, dialog_value[1]) then {
+                        Notice("Name " || image(dialog_value[1]) || " exists")
+                        next
+                        }
+                  else {
+                     cw.table[dialog_value[1]] := cw.table[name]
+                     delete(cw.table, name)
+                     win_cw()
+                     cw_touched := 1
+                     break 
+                     }
+                  }
+               }
+            }
+         "q":   return control_mode()
+         }
+      }
+
+end
+
+procedure control_mode()
+
+   VSetState(cw_active_vidget, &null)
+
+   expose(cw_interface)
+
+   return
+
+end
+
+procedure active_cb(vidget, value)
+
+   cw_active := value
+
+   return
+
+end
+
+procedure way_cb(vidget, value)
+
+   case value[1] of {
+      "add     @A":   add_way()
+      "delete  @D":   delete_way()
+      }
+
+   return
+
+end
+
+procedure file_cb(vidget, value)
+
+   case value[1] of {
+      "load  @L":   load_cw()
+      "new   @N":   new_cw()
+      "pick  @P":   pick()
+      "quit  @Q":   quit()
+      "save  @S":   save_cw()
+      "save as":    save_cw_as()
+      }
+
+   return
+
+end
+
+procedure shortcuts(e)
+
+   if &meta then case map(e) of {
+      "a":   add_way()
+      "d":   delete_way()
+      "e":   VSetState(cw_active_vidget, 1)
+      "l":   load_cw()
+      "n":   new_cw()
+      "p":   pick()
+      "q":   quit()
+      "s":   save_cw()
+      }
+
+   return
+
+end
+
+procedure add_way()
+   local name
+
+   repeat {
+      repeat {
+         if TextDialog("Add color:", "name", , 60) == "Cancel" then return
+         if \cw.table[dialog_value[1]] then {
+            Notice("Name is in use.")
+            next
+            }
+         name := dialog_value[1]
+         if ColorDialog("Choose color:") == "Cancel" then return
+         cw.table[name] := dialog_value
+         win_cw()
+         cw_touched := 1
+         next
+         }
+      }
+
+end
+
+#  NOTE:  Got error in line comparing dialog_value[i]:  &null.
+
+procedure delete_way()
+   local i, x, count
+
+   if ToggleDialog("Delete ways:", cw_names) == "Cancel" then fail
+
+   count := 0
+
+   every i := 1 to *dialog_value do
+      if dialog_value[i] == 1 then {
+         delete(cw.table, cw_names[i])
+         count +:= 1
+         cw_touched := 1
+         }
+
+   if count > 0 then win_cw()
+
+   return
+
+end
+ 
+procedure load_cw()
+   local input, x
+
+   repeat {
+      if OpenDialog() == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file")
+         next
+         }
+      x := xdecodet(input, "colorway") | {
+         Notice("File does not contain color way")
+         close(input)
+         next
+         }
+      cw_file := dialog_value
+      cw := x
+      win_cw()
+      expose(cw_interface)
+      close(input)
+      cw_touched := &null
+      return
+      }
+
+end
+
+
+procedure win_cw()
+   local y, name, height
+
+   WClose(\cw_win)
+
+   cw_col := 2 * Pad			# in case the color way is empty
+   cw_names := (keylist(cw.table) | [])
+   cw_col := maxlen(cw_names, TextWidth) + (2 * Pad)
+
+   height := Lheight
+   height <:= Lheight * *cw.table
+
+   cw_win := WOpen("label=" || cw_file, "size=" || (cw_col + Cwidth) ||
+      "," || height, "posx=" || WAttrib(cw_interface, "posx"),
+         "posy=" || WAttrib(cw_interface, "posy") + cw_yoff) |
+            ExitNotice("Cannot open window")
+
+   y := 0
+
+   every name := !cw_names do {
+      Fg(cw_win, "black")
+      CenterString(cw_win, cw_col / 2, y + (Lheight / 2), name)
+      Fg(cw_win, cw.table[name]) | {
+         Notice("Invalid color: " || cw.table[name], "substituting black")
+         Fg(cw_win, "black")
+         }
+      FillRectangle(cw_win, cw_col, y, Cwidth, Lheight)
+      y +:= Lheight
+      }
+
+   if \cw_active then expose(cw_win)
+
+   return
+
+end
+
+procedure new_cw()
+
+   if /cw_touched then {
+	# ask if colorway is to be saved first
+      }
+
+   cw := colorway(table())
+   win_cw()
+   cw_touched := &null
+
+   return
+
+end
+
+procedure save_cw()
+   local output
+
+   repeat {
+      if SaveDialog(, cw_file) == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open " || dialog_value || " for writing")
+         next
+         }
+      xencodet(cw, output, "colorway") |
+        ExitNotice("Internal inconsistency:  color way is corrupt")
+      close(output)
+      cw_touched := &null
+      return
+      }
+
+end
+
+procedure save_cw_as()
+   local output, temp
+
+   repeat {
+      if SaveDialog("Save as:") == "Cancel" then fail
+      if dialog_value == \cw_file then {
+         temp := dialog_value
+         if TextDialog("Overwrite existing file?") == "Cancel" then next
+         dialog_value := temp
+         }
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open " || dialog_value || " for writing")
+         next
+         }
+      xencodet(cw, output, "colorway") |
+        ExitNotice("Internal inconsistency:  color way is corrupt")
+      close(output)
+      cw_touched := &null
+      return
+      }
+
+end
+
+procedure quit()
+
+   if \cw_touched then {
+				# ask for save if touched
+      }
+
+   exit()
+
+end
+
+#  Utility procedure to let user pick an image file in the current directory.
+
+procedure pick()
+   local plist, ls, input, x
+
+   plist := filelist("*.cw") |
+      return FailNotice("Pick not supported on this platform")
+
+   if *plist = 0 then return FailNotice("No files found.")
+
+   repeat {
+      if SelectDialog("Select color way:", plist, plist[1]) == "Cancel"
+         then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file")
+         next
+         }
+      x := xdecodet(input, "colorway") | {
+         Notice("File does not contain color way")
+         close(input)
+         next
+         }
+      cw_file := dialog_value
+      cw := x
+      win_cw()
+      expose(cw_interface)
+      close(input)
+      cw_touched := &null
+      return
+      }
+
+   return
+   
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure ui_atts()
+   return ["size=134,169", "bg=gray-white"]
+end
+
+procedure ui(win, cbk)
+return vsetup(win, cbk,
+   [":Sizer:::0,0,134,169:",],
+   ["active:Button:regular:1:17,38,49,20:edit",active_cb],
+   ["file:Menu:pull::2,2,36,21:File",file_cb,
+      ["new   @N","load  @L","pick  @P","save  @S","save as",
+      "quit  @Q"]],
+   ["line:Line:::0,25,200,25:",],
+   ["ways:Menu:pull::40,2,36,21:Ways",way_cb,
+      ["add     @A","delete  @D"]],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/colrlist.icn b/ipl/gprocs/colrlist.icn
new file mode 100644
index 0000000..865cb34
--- /dev/null
+++ b/ipl/gprocs/colrlist.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     colrlist.icn
+#
+#	Subject:  Procedures to produce list of colors
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 24, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  colrlist(f) returns a list of the colors given in a file.
+#
+#  colrplte(p) returns a list of colors for the palette p.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  io
+#
+############################################################################
+
+link io
+
+procedure colrlist(f)			#: list of colors from file
+   local input, colors, line
+
+   if f === "-" then input := &input
+   else (input := dopen(f)) | fail
+   colors := []
+
+   while line := read(input) do
+      put(colors, ColorValue(line ? tab(upto('\t') | 0)))
+
+   close(input)
+
+   if *colors = 0 then fail
+
+   return colors
+
+end
+
+procedure colrplte(p)			#: list of colors from palette
+   local colors
+
+   colors := []
+ 
+   every put(colors, PaletteColor(p, !PaletteChars(p)))
+
+   if *colors = 0 then fail			# invalid palette
+
+   return colors
+
+
+end
diff --git a/ipl/gprocs/colrmodl.icn b/ipl/gprocs/colrmodl.icn
new file mode 100644
index 0000000..3bbd9fa
--- /dev/null
+++ b/ipl/gprocs/colrmodl.icn
@@ -0,0 +1,273 @@
+############################################################################
+#
+#	File:     colrmodl.icn
+#
+#	Subject:  Procedures to convert between color models
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     These procedures convert between various color models. A color
+#  value is represented by a record (see the declarations below).
+#
+#  Color values are normalized to a maximum of 1.0.
+#
+############################################################################
+#
+#  Acknowledgement:  Some of the procedures here are based on information
+#  given in Computer Graphics; Principles and Practice, second edition;
+#  James D. Foley, Andries van Dam, Steven K. Feiner, and John F. Hughes;
+#  Addison-Wesley Publishing Company; 1990.
+#
+############################################################################
+#
+#  Note:  These procedures have not been extensively tested. Those related
+#  to the YIQ model are particularly in question.
+#
+############################################################################
+#
+#  Links:  matrix, numbers
+#
+############################################################################
+
+link matrix
+link numbers
+
+record rgb(r, g, b)
+record cmy(c, m, y)
+record cmyk(c, m, y, k)
+record yiq(y, i, q)
+record hsv(h, s, v)
+record hls(h, l, s)
+
+procedure rgb2cmy(color)
+
+   return cmy(1.0 - color.r, 1.0 - color.g, 1.0 - color.b)
+
+end
+
+procedure cmy2rgb(color)
+
+   return rgb(1.0 - color.c, 1.0 - color.m, 1.0 - color.y)
+
+end
+
+#  Note: The following procedure illustrates the principle of
+#  undercolor removal, but for pragmatic reasons, it does not
+#  produce acceptable results in process printing.
+
+procedure cmy2cmyk(color)
+   local k
+
+   k := min(color.c, color.m, color.y)
+
+   return cmyk(color.c - k, color.m - k, color.y - k, k)
+
+end
+
+procedure cmyk2cmy(color)
+   local kdelta
+
+   kdelta := color.k / 3
+
+   return cmy(color.c + kdelta, color.m + kdelta, color.y + kdelta)
+
+end
+
+#
+#  Note: The RGB specification is assumed to be based on the standard
+#  NTSC phosphors.  See the reference cited above.
+
+procedure rgb2yiq(color)
+   static M, R, Y
+
+   initial {
+      M := create_matrix(3, 3)
+      M[1, 1] := 0.299
+      M[1, 2] := 0.587
+      M[1, 3] := 0.114
+      M[2, 1] := 0.596
+      M[2, 2] := -0.275
+      M[2, 3] := -0.321
+      M[3, 1] := 0.212
+      M[3, 2] := -0.528
+      M[3, 3] := 0.311
+      }
+
+   R := create_matrix(3, 1)
+   R[1][1] := color.r
+   R[2][1] := color.g
+   R[3][1] := color.b
+
+   Y := mult_matrix(M, R)
+
+   return yiq(Y[1][1], Y[2][1], Y[3][1])
+
+end
+
+procedure yiq2rgb(color)
+   static M, R, Y
+
+   initial {
+      M := create_matrix(3, 3)
+      M[1, 1] := 1.0031
+      M[1, 2] := 0.9548
+      M[1, 3] := 0.6179
+      M[2, 1] := 0.9968
+      M[2, 2] := -0.2707
+      M[2, 3] := -0.6448
+      M[3, 1] := 1.0084
+      M[3, 2] := -1.1005
+      M[3, 3] := 1.6996
+      }
+
+   Y := create_matrix(3, 1)
+   Y[1][1] := color.y
+   Y[2][1] := color.i
+   Y[3][1] := color.q
+
+   R := mult_matrix(M, Y)
+
+   return rgb(R[1][1], R[2][1], R[3][1])
+
+end
+
+procedure rgb2hsv(color)
+   local maximum, minimum, delta, h, s, v
+
+   maximum := max(color.r, color.g, color.b)
+   minimum := min(color.r, color.g, color.b)
+   delta := maximum - minimum
+
+   v := maximum
+
+   if maximum ~= 0 then s := delta / maximum
+   else s := 0
+
+   if s = 0 then h := -1.0		# undefined
+   else {
+      if color.r = maximum then {
+         h := (color.g - color.b) / delta
+         }
+      else if color.g = maximum then {
+         h := 2 + (color.b - color.r) / delta
+         }
+      else if color.b = maximum then {
+         h := 4 + (color.r - color.g) / delta
+         }
+      h := h * 60
+      if h < 0 then h +:= 360.0		# make sure hue is nonnegative
+      }
+
+   return hsv(h, s, v)
+
+end
+
+procedure hsv2rgb(color)
+
+   local h, i, f, p, q, t, s, v
+
+   if color.s = 0 then {
+      if color.h = -1 then {
+         return rgb(color.v, color.v, color.v)
+         }
+      else stop("*** error in HSV to RGB conversion")
+      }
+   else {
+      h := color.h
+      v := color.v
+      s := color.s
+      if h = 360.0 then h := 0.0
+      h /:= 60
+      i := floor(h)
+      f := h - i
+      p := v * (1.0 - s)
+      q := v * (1.0 - s * f)
+      t := v * (1.0 - (s * (1.0 - f)))
+      return case i of {
+         0:  rgb(v, t, p)
+         1:  rgb(q, v, p)
+         2:  rgb(p, v, t)
+         3:  rgb(p, q, v)
+         4:  rgb(t, p, v)
+         5:  rgb(v, p, q)
+         default:  stop("*** error in HSV to RGB conversion")
+         }
+      }
+
+end
+
+procedure rgb2hls(color)
+   local maximum, minimum, delta, sum, h, s, l
+
+   maximum := max(color.r, color.b, color.g)
+   minimum := min(color.r, color.b, color.g)
+
+   delta := maximum - minimum
+   sum := maximum + minimum
+   l := sum / 2				# lightness
+
+   if maximum = minimum then {		# achromatic case
+      s := 0.0
+      h := -1.0
+      }
+   else {
+      if l <= 0.5 then
+         s := delta / sum
+      else s := delta / (2 - sum)
+
+      if color.r = maximum then
+         h := (color.g - color.r) / delta
+      else if color.g = maximum then
+         h := 2 + (color.b - color.r) / delta
+      else if color.b = maximum then
+         h := 4 + (color.r - color.g) / delta
+      h *:= 60				# convert to degrees
+      if h < 0.0 then h +:= 360.0	# make positive
+
+      return hls(h, l, s)
+      }
+
+end
+
+procedure hls2rgb(color)
+   local h, l, s, m1, m2
+
+   h := color.h
+   l := color.l
+   s := color.s
+
+   if l <= 0.5 then m2 := l * (1 + s)
+   else m2 := l + s - l * s
+   m1 := 2 * l - m2
+   if s = 0 then {			# achromatic case
+      if h = -1.0 then return rgb(l, l, l)
+      else stop("*** error in HLS specification")
+      }
+   else {
+      return rgb(
+         color_value(m1, m2, h + 120.0),
+         color_value(m1, m2, h),
+         color_value(m1, m2, h - 120.0)
+         )
+      }
+
+end
+
+procedure color_value(m1, m2, h)
+
+   if h > 360.0 then h -:= 360.0
+   else if h < 0.0 then h +:= 360.0
+   if h < 60.0 then return m1 + (m2 - m1) * h / 60.0
+   else if h < 180.0 then return m2
+   else if h < 240.0 then return m1 + (m2 - m1) * (240.0 - h) / 60.0
+   else return m1
+
+end
diff --git a/ipl/gprocs/colrspec.icn b/ipl/gprocs/colrspec.icn
new file mode 100644
index 0000000..03b4322
--- /dev/null
+++ b/ipl/gprocs/colrspec.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     colrspec.icn
+#
+#	Subject:  Procedure to produce VRML color specifications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 3, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure colrspec(s)
+   local color
+   static max, win
+
+   initial {
+      max := real(2 ^ 16 - 1)
+      WOpen("canvas=hidden")
+      }
+
+   color := ""
+
+   ColorValue(s) ? {
+      every 1 to 3 do {
+         color ||:= (tab(upto(",") | 0) / max) || " "
+         move(1)
+         }
+      return color
+      }
+
+   fail
+
+end
diff --git a/ipl/gprocs/cwutils.icn b/ipl/gprocs/cwutils.icn
new file mode 100644
index 0000000..4a46207
--- /dev/null
+++ b/ipl/gprocs/cwutils.icn
@@ -0,0 +1,161 @@
+############################################################################
+#
+#	File:     cwutils.icn
+#
+#	Subject:  Procedures to support color ways
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 2, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  dialog, interact, tables, wopen, xcode
+#
+############################################################################
+
+link dialog
+link interact
+link tables
+link wopen
+link xcode
+
+#  Note: This duplicates declaration in colorway.icn
+
+record colorway(table)		# note:  "table" does not conflict
+				# with the function name.  The
+				# field contains a table.
+
+$define Width 50		# width of image produced in way2image()
+
+
+procedure list2way(L)		#: convert list of color specs. to colorway
+   local cw, i, c
+
+   cw := colorway(table())
+
+   i := 0
+
+   every c := !L do {
+      c := ColorValue(c) | "black"
+      cw.table["Color " || right(i +:= 1, 3, "0")] := c
+      }
+
+   return cw
+
+end
+
+#  Note:  code is identical to procedure above.
+
+procedure file2way(f)		#: convert file of color specs. to color way
+   local cw, i, c
+
+   cw := colorway(table())
+
+   i := 0
+
+   every c := !f do {
+      c := ColorValue(c) | "black"
+      cw.table["Color " || (i +:= 1)] := c
+      }
+
+   return cw
+
+end
+
+procedure way2list(cw)		#: convert color way to list of colors
+
+   return kvallist(cw.table)
+
+end
+
+procedure way2file(cw)		#: convert color way to file of colors
+
+   every write(!kvallist(cw.table))
+
+end
+
+procedure way2image(cw)		#: create image from color way
+   local win, y
+
+   win := WOpen("canvas=hidden", "size="|| Width || "," || *cw.table) |
+      return FailNotice("Cannot open window for color way image")
+
+   y := 0
+
+   every Fg(!kvallist(cw.table)) do {
+      DrawLine(win, 0, y, Width - 1, y)
+      y +:= 1
+      }
+
+   snapshot(win)
+
+   WClose(win)
+
+   return
+
+end
+
+procedure saveway(cw, output)	#: save color way
+
+   xencodet(cw, output, "colorway") | fail
+
+end
+
+procedure loadway(input)	#: load color way
+
+    return xdecodet(input, "colorway") | fail
+
+end
+
+procedure image2way(s, direction)	#: convert image to color way
+   local result, width, color, old_color, stripes, w, h
+
+   /direction := "horizontal"
+
+   result := []
+
+   stripes := WOpen("canvas=hidden", "image=" || s) |
+      return FailNotice("Cannot open " || image(s))
+
+   width := 0
+   old_color := ""
+
+   case direction of {
+      "horizontal":   {
+         w := 1
+         h := WAttrib(stripes, "height")
+         }
+      "vertical":     {
+         w := WAttrib(stripes, "width")
+         h := 1
+         }
+      default:   stop("*** invalid direction specification in image2way()")
+      }
+
+   every color := Pixel(stripes, 0, 0, w, h) do {
+      if (color ~== old_color) & (width ~= 0) then {
+         put(result, old_color)
+         width := 0
+         }
+      old_color := color
+      width +:= 1
+      }
+
+   WClose(stripes)
+
+   return list2way(result)
+
+end
diff --git a/ipl/gprocs/decay.icn b/ipl/gprocs/decay.icn
new file mode 100644
index 0000000..414504c
--- /dev/null
+++ b/ipl/gprocs/decay.icn
@@ -0,0 +1,84 @@
+############################################################################
+#
+#	File:     decay.icn
+#
+#	Subject:  Procedures for decaying-displays for windows
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide a way to draw objects and then have them
+#	automatically redrawn (say, in a lighter color) n steps later.
+#	A user routine is called to do the actual drawing.  If a second
+#	call to draw an object comes before its time has expired, the
+#	object's counter is reset and the drawing routine is not called.
+#
+#	dpipe() initializes a decay pipeline and returns a pipeline object.
+#
+#	decay() marks an object, unmarks another, and advances the clock.
+#
+############################################################################
+#
+#   dpipe(proc, length, gc1, gc2) -- create a decay pipeline
+#
+#	dpipe() initializes a decay pipeline and returns a pipeline object.
+#
+#	proc	user marking procedure: proc(gc, i) marks entry i using gc
+#	length	length of the delay pipeline (number of steps)
+#	gc1	gc to mark an entry when it becomes active
+#	gc2	gc to mark an entry when it decays (becomes inactive)
+#
+#   decay(dp, i) -- mark entry i with later decay
+#
+#	decay() marks an object, unmarks another, and advances the clock.
+#
+#	Using decay pipe dp, entry i (anything but &null) is drawn in an
+#	active state, and the oldest entry in the pipe is drawn in an
+#	inactive state.
+#
+#	Records are kept, though, so that an already-active entry is not
+#	redrawn, and a decayed entry reaching the end of the pipe is not
+#	drawn as inactive if it was more recently renewed.
+#
+#	The decay pipe can be flushed by a sufficient number of
+#	decay(dp, &null) calls.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record Decay_Rec(	# decay pipe record
+   pipe,	# queue of active indices
+   tab,		# table of activity for each index
+   proc,	# marking procedure
+   gc1,		# gc to use to turn on
+   gc2)		# gc to use to turn off
+
+
+##  dpipe(proc, length, gc1, gc2) -- create a decay pipeline
+
+procedure dpipe(proc, length, gc1, gc2)		#: create a decay pipeline
+   return Decay_Rec(list(length), table(0), proc, gc1, gc2)
+end
+
+
+##  decay(dp, i) -- mark entry i with later decay
+
+procedure decay(dp, i)				#: mark entry for later decay
+   local j
+   j := get(dp.pipe)
+   if (dp.tab[\i] +:= 1) = 1 then
+      dp.proc(dp.gc1, i)
+   if (dp.tab[\j] -:= 1) = 0 then
+      dp.proc(dp.gc2, j)
+   put(dp.pipe, i)
+end
diff --git a/ipl/gprocs/dialog.icn b/ipl/gprocs/dialog.icn
new file mode 100644
index 0000000..d10648c
--- /dev/null
+++ b/ipl/gprocs/dialog.icn
@@ -0,0 +1,735 @@
+############################################################################
+#
+#	File:     dialog.icn
+#
+#	Subject:  Procedures for dialogs
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     December 14, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains several procedures for posting dialog boxes:
+#
+#  AskDialog() -- TextDialog() with only caption and "No" instead of "Cancel"
+#  Notice(win, captions) -- notice dialog (a simple text dialog)
+#  TextDialog(win, captions, labels, defaults...) -- text dialog
+#  ToggleDialog(win, captions, labels, defaults...) -- toggle dialog
+#  SelectDialog(win, captions, labels, defaults...) -- selection dialog
+#  SaveDialog(win, caption, filename, len) -- save file dialog
+#  OpenDialog(win, caption, filename, len) -- open file dialog
+#  ColorDialog(win, captions, refcolor, callback, id) -- color dialog
+#
+#  In all cases, the first or only caption is used as a dialog box ID,
+#  used to remember the dialog box location when it is closed.  A later
+#  posting using the same ID places the new box at the same location.
+#
+############################################################################
+#
+#  ColorDialog(win, captions, color, callback, id) -- display color dialog
+#
+#  captions	list of dialog box captions; default is ["Select color:"]
+#  color	reference color setting; none displayed if not supplied
+#  callback	procedure to call when the setting is changed
+#  id		arbitrary value passed to callback
+#
+#  ColorDialog displays a dialog window with R/G/B and H/S/V sliders for
+#  color selection.  When the "Okay" or "Cancel" button is pressed,
+#  ColorDialog returns the button name, with the ColorValue of the final
+#  settings stored in the global variable dialog_value.
+#
+#  If a callback procedure is specified, callback(id, k) is called whenever
+#  the settings are changed;  k is the ColorValue of the settings.
+#
+############################################################################
+#
+#  Popup(x, y, w, h, proc, args...) creates a subwindow of the specified
+#  size, calls proc(args), and awaits its success or failure.  Then, the
+#  overlaid area is restored and the result of proc is produced.  &window,
+#  as seen by proc, is a new binding of win in which dx, dy, and clipping
+#  have been set.  The usable area begins at (0,0);  its size is
+#  (WAttrib(win, "clipw"), WAttrib(win, "cliph")).  Defaults are:
+#   	x, y	positioned to center the subwindow
+#	w, h	250, 150
+#	proc	Event
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics, vbuttons, vdialog, vradio, vslider, vidgets
+#
+############################################################################
+
+link graphics
+link vbuttons
+link vdialog
+link vradio
+link vslider
+link vidgets
+
+$include "vdefns.icn"
+
+global dialog_button
+global dialog_value
+
+$define ButtonWidth	 50	# minimum button width
+$define ButtonHeight	 30	# button height
+$define FieldWidth	 10	# default field width
+$define OpenWidth	 50	# default field width for Open/SaveDialog
+
+$define XOff		  0	# offset for text vidgets
+$define XOffButton	 85	# initial x offset for buttons
+$define XOffIncr	 15	# space between buttons
+
+procedure Dialog(win, captions, labels, defaults, widths, buttons, index)
+   Dialog := TextDialog
+   return Dialog(win, captions, labels, defaults, widths, buttons, index)
+end
+
+procedure AskDialog(win, caption)
+
+   return TextDialog(win, caption, , , , , ["Okay", "No"])
+
+end
+
+procedure TextDialog(			#: text dialog
+   win, captions, labels, defaults, widths, buttons, index
+   )
+   local maxl, lead, pad, default_button, i, maxw, cwidth, id, label_width
+   local button, maxb, dialog, x, y, button_space, default_width, box_id
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: labels :=: defaults :=: widths :=: buttons :=:
+         index
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := []
+   /labels := []
+   /defaults := []
+   /widths := []
+   /buttons := ["Okay", "Cancel"]
+   /index := 1
+
+   if type(captions) ~== "list" then captions := [captions]
+   if type(labels)   ~== "list" then labels   := [labels]
+   if type(defaults) ~== "list" then defaults := [defaults]
+   if type(widths)   ~== "list" then widths   := [widths]
+   if type(buttons)  ~== "list" then buttons  := [buttons]
+
+   default_button := buttons[index] 		# null if out of bounds
+   default_width := widths[-1] | FieldWidth
+
+   maxl := 0
+   every maxl <:= *(labels | defaults | widths)
+   until *labels = maxl do put(labels, labels[-1] | "")
+   until *defaults = maxl do put(defaults, defaults[-1] | "")
+   until *widths = maxl do put(widths, widths[-1] | 10) 
+
+   id := 0
+
+   label_width := 0
+   every label_width <:= TextWidth(win, !labels)
+   if label_width > 0 then label_width +:= 15
+
+   maxb := 0
+   every maxb <:= TextWidth(win, !buttons)
+   maxb +:= 10
+   maxb <:= ButtonWidth
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+   cwidth := WAttrib(win, "fwidth")
+
+   dialog := Vdialog(win, pad, pad)
+
+   maxw := 0
+   every maxw <:= TextWidth(win, !captions)
+
+   y := -lead
+
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+   every i := 1 to maxl do {
+      y +:= pad
+      if *labels[i] > 0 then
+         VInsert(dialog, Vmessage(win, labels[i]), 0, y)
+      VRegister(dialog, Vtext(win, "", , id +:= 1,
+         widths[i]), label_width, y)
+      maxw <:= label_width + widths[i] * cwidth
+      }
+
+   y +:= (3 * pad) / 2
+
+   button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+   maxw <:= button_space
+
+   x := ((maxw - button_space) / 2)
+
+   every button := !buttons do {
+      VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+         ButtonHeight), x, y)
+      x +:= maxb + XOffIncr
+      }
+
+   VFormat(dialog)
+
+   box_id := captions[1] | "TextDialog"
+   dialog_value := VOpenDialog(dialog, , box_id, defaults, default_button)
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure ToggleDialog(			#: toggle dialog
+   win, captions, labels, defaults, buttons, index
+   )
+   local maxl, lead, pad, default_button, i, maxw, cwidth, id, label_width
+   local button, maxb, dialog, x, y, button_space, default_width, box_id
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: labels :=: defaults :=:  buttons :=: index
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := []
+   /labels := []
+   /defaults := []
+   /buttons := ["Okay", "Cancel"]
+   /index := 1
+
+   if type(captions) ~== "list" then captions := [captions]
+   if type(labels)   ~== "list" then labels   := [labels]
+   if type(defaults) ~== "list" then defaults := [defaults]
+   if type(buttons)  ~== "list" then buttons  := [buttons]
+
+   default_button := buttons[index] 		# null if out of bounds
+
+   maxl := 0
+   every maxl <:= *(labels | defaults)
+   every maxl <:= *labels
+   until *labels = maxl do put(labels, labels[-1] | "")
+   until *defaults = maxl do put(defaults, defaults[-1] | &null)
+
+   id := 0
+
+   label_width := 0
+   every label_width <:= TextWidth(win, !labels)
+   if label_width > 0 then label_width +:= 30
+
+   maxb := 0
+   every maxb <:= TextWidth(win, !buttons)
+   maxb +:= 10
+   maxb <:= ButtonWidth
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+   cwidth := WAttrib(win, "fwidth")
+
+   dialog := Vdialog(win, pad, pad)
+
+   maxw := 0
+   every maxw <:= TextWidth(win, !captions)
+
+   y := -lead
+
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+   every i := 1 to maxl do {
+      y +:= pad
+      VRegister(dialog, Vtoggle(win, labels[i], , id +:= 1, V_CHECK_NO,
+         label_width), 0, y)
+      maxw <:= label_width
+      }
+
+   y +:= (3 * pad) / 2
+
+   button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+   maxw <:= button_space
+
+   x := ((maxw - button_space) / 2)
+
+   every button := !buttons do {
+      VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+         ButtonHeight), x, y)
+      x +:= maxb + XOffIncr
+      }
+
+   VFormat(dialog)
+
+   box_id := captions[1] | "ToggleDialog"
+   dialog_value := VOpenDialog(dialog, , box_id, defaults, default_button)
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure SelectDialog( 		#: selection dialog
+   win, captions, labels, deflt, buttons, index
+   ) 
+   local maxl, lead, pad, default_button, i, maxw, cwidth, label_width
+   local button, maxb, dialog, x, y, button_space, box_id
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: labels :=: deflt :=: buttons :=: index
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := []
+   /labels := []
+   /buttons := ["Okay", "Cancel"]
+   /index := 1
+
+   if type(captions) ~== "list" then captions := [captions]
+   if type(labels)   ~== "list" then labels   := [labels]
+   if type(buttons)  ~== "list" then buttons  := [buttons]
+
+   default_button := buttons[index] 		# null if out of bounds
+
+   maxl := 0
+   every maxl <:= *labels
+   until *labels = maxl do put(labels, labels[-1] | "")
+
+   label_width := 0
+   every label_width <:= TextWidth(win, !labels)
+   if label_width > 0 then label_width +:= 15
+
+   maxb := 0
+   every maxb <:= TextWidth(win, !buttons)
+   maxb +:= 10
+   maxb <:= ButtonWidth
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+   cwidth := WAttrib(win, "fwidth")
+
+   dialog := Vdialog(win, pad, pad)
+
+   maxw := 0
+   every maxw <:= TextWidth(win, !captions)
+
+   y := -lead
+
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+   y +:= 2 * lead
+   VRegister(dialog, Vvert_radio_buttons(win, labels, , 1, V_DIAMOND_NO), 0, y)
+
+   y +:= integer(0.83 * (pad * (*labels - 1)) + 1.5 * pad)
+
+   button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+   maxw <:= button_space
+
+   x := ((maxw - button_space) / 2)
+
+   every button := !buttons do {
+      VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+         ButtonHeight), x, y)
+      x +:= maxb + XOffIncr
+      }
+
+   VFormat(dialog)
+
+   box_id := captions[1] | "ToggleDialog"
+   dialog_value := VOpenDialog(dialog, , box_id, [deflt], default_button)[1]
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure Notice(captions[])		#: notice dialog
+   local win, temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(captions[1]) == "window" then
+      win := get(captions)
+   else {
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   TextDialog(win, captions, , , , "Okay")
+
+   dialog_value := &null
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure SaveDialog(win, caption, filename, len)	#: save dialog
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: caption :=: filename :=: len
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /caption := "Save:"
+   /filename := ""
+   /len := OpenWidth
+
+   TextDialog(win, caption, , filename, len, ["Yes", "No", "Cancel"])
+
+   dialog_value := dialog_value[1]
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure OpenDialog(win, caption, filename, len)	#: open dialog
+   local temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: caption :=: filename :=: len
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /caption := "Open:"
+   /filename := ""
+   /len := OpenWidth
+
+   TextDialog(win, caption, , filename, len)
+
+   dialog_value := dialog_value[1]
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure dialog_cb(vidget, s)
+
+   dialog_button := vidget.s
+
+   return
+
+end
+
+#  ColorDialog(win, captions, color, callback, id) -- display color dialog
+
+record cdl_rec(rect, orgcolor, refcolor, mutable, callback, id,
+   r, g, b, h, s, v, rv, gv, bv, hv, sv, vv, fg, fillargs, dialog, nc)
+
+global cdl_data			# data for current color dialog
+
+$define PickerWidth	300	# overall color picker width
+$define SliderHeight	200	# height of a slider
+$define SliderWidth	 15	# width of one slider
+$define SliderPad	  5	# distance between sliders
+$define MaxStaticCol	200	# maximum colors before recycling
+
+procedure ColorDialog(			#: color dialog
+   win, captions, refcolor, callback, id
+   )
+   local x1, x2, dx, y, bw, lead, pad, dialog, box_id, temp_win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: captions :=: refcolor :=: callback :=: id
+      win := &window
+      /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+      }
+
+   /captions := "Select color:"
+   if type(captions) ~== "list" then captions := [captions]
+
+   cdl_data := cdl_rec()
+   cdl_data.callback := callback
+   cdl_data.id := id
+   cdl_data.refcolor := refcolor
+   cdl_data.orgcolor := ColorValue(win, \refcolor | Fg(win) | "gray")
+
+   cdl_data.orgcolor ? {
+      cdl_data.r := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.g := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.b := integer(tab(many(&digits)))
+      }
+   HSV(cdl_data.orgcolor) ? {
+      cdl_data.h := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.s := integer(tab(many(&digits)))
+      move(1)
+      cdl_data.v := integer(tab(many(&digits)))
+      }
+
+   lead := WAttrib(win, "leading")
+   pad := 2 * lead
+
+   y := -lead
+
+   dialog := Vdialog(win, pad, pad, cdl_init)
+   every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+
+   dx := SliderWidth + SliderPad
+   x1 := 0 - dx
+   x2 := PickerWidth + SliderPad
+   y +:= pad
+
+   cdl_data.dialog := dialog
+   cdl_data.rv := cdl_slider(dialog, "r", x1 +:= dx, y, 0, 65535, cdl_data.r)
+   cdl_data.gv := cdl_slider(dialog, "g", x1 +:= dx, y, 0, 65535, cdl_data.g)
+   cdl_data.bv := cdl_slider(dialog, "b", x1 +:= dx, y, 0, 65535, cdl_data.b)
+   cdl_data.vv := cdl_slider(dialog, "v", x2 -:= dx, y, 0, 100, cdl_data.v)
+   cdl_data.sv := cdl_slider(dialog, "s", x2 -:= dx, y, 0, 100, cdl_data.s)
+   cdl_data.hv := cdl_slider(dialog, "h", x2 -:= dx, y, 0, 360, cdl_data.h)
+
+   x1 +:= dx + SliderPad
+   x2 -:= 2 * SliderPad
+   cdl_data.rect := Vpane(win, , , "sunken",
+      x2 - x1, SliderHeight - 3 * lead - SliderPad)
+   VInsert(dialog, cdl_data.rect, x1, y)
+
+   y +:= SliderHeight + pad
+   bw := TextWidth(win, "Cancel") + 10
+   VInsert(dialog, Vbutton(win, "Okay", cdl_exit, V_OK, ,
+      bw, ButtonHeight), PickerWidth / 2 - bw - 10, y)
+   VInsert(dialog, Vbutton(win, "Cancel", cdl_exit, V_OK, ,
+      bw, ButtonHeight), PickerWidth / 2 + 10, y)
+
+   VFormat(dialog)
+   box_id := captions[1] | "ColorDialog"
+   VOpenDialog(dialog, , box_id, , "Okay")
+
+   dialog_value := cdl_data.r || "," || cdl_data.g || "," || cdl_data.b
+
+   WClose(\temp_win)
+
+   return dialog_button
+
+end
+
+procedure cdl_slider(dialog, id, x, y, low, high, init) 	# place a slider
+   local v
+
+   v := Vvert_slider(dialog.win, cdl_setval, id,
+      SliderHeight, SliderWidth, low, high, init)
+   VInsert(dialog, v, x, y)
+   return v
+end
+
+procedure cdl_init()			# initialize non-vidget part of dialog
+   local r
+
+   r := cdl_data.rect
+   cdl_data.fg := Fg(r.win)
+   cdl_data.fillargs := [r.win, r.ux, r.uy, r.uw, r.uh]
+   if cdl_data.mutable := NewColor(cdl_data.rect.win, cdl_data.orgcolor) then {
+      Fg(r.win, cdl_data.mutable)
+      FillRectangle ! cdl_data.fillargs
+      }
+   else
+      cdl_data.nc := 0
+   if Fg(r.win, \cdl_data.refcolor) then {
+      cdl_data.fillargs[-1] -:= r.uh / 8
+      FillRectangle(r.win, r.ux, r.uy + r.uh, r.uw, -r.uh / 8)
+      }
+   Fg(r.win, cdl_data.fg)
+   cdl_sethsv()
+   return
+end
+
+procedure cdl_exit(vidget, s)		# save position and button name on exit
+   dialog_button := vidget.s
+   FreeColor(cdl_data.rect.win, \cdl_data.mutable)
+   EraseArea(cdl_data.rect.win)
+   return
+end
+
+procedure cdl_setval(v, x)		# set value in response to slider motion
+   static recurse
+
+   if /recurse then {			# if not a recursive call
+      recurse := 1			# note to prevent recursion
+      case v.id of {
+         "r":  { cdl_data.r := x; cdl_sethsv(); }
+         "g":  { cdl_data.g := x; cdl_sethsv(); }
+         "b":  { cdl_data.b := x; cdl_sethsv(); }
+         "h":  { cdl_data.h := x; cdl_setrgb(); }
+         "s":  { cdl_data.s := x; cdl_setrgb(); }
+         "v":  { cdl_data.v := x; cdl_setrgb(); }
+         }
+      recurse := &null
+      }
+   return
+end
+
+procedure cdl_sethsv()			# set h/s/v values from r/g/b
+   local c
+
+   HSV(c := cdl_data.r || "," || cdl_data.g || "," || cdl_data.b) ? {
+      VSetState(cdl_data.hv, cdl_data.h := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.sv, cdl_data.s := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.vv, cdl_data.v := integer(tab(many(&digits))))
+      }
+   cdl_setcolor(c)
+   return
+end
+
+procedure cdl_setrgb()			# set r/g/b values from h/s/v
+   local c
+
+   (c := HSVValue(cdl_data.h || "/" || cdl_data.s || "/" || cdl_data.v)) ? {
+      VSetState(cdl_data.rv, cdl_data.r := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.gv, cdl_data.g := integer(tab(many(&digits))))
+      move(1)
+      VSetState(cdl_data.bv, cdl_data.b := integer(tab(many(&digits))))
+      }
+   cdl_setcolor(c)
+   return
+end
+
+procedure cdl_setcolor(c)		# display new color and invoke callback
+   local r, win, x1, x2, y, dy
+
+   r := cdl_data.rect
+   win := r.win
+   if \cdl_data.mutable then
+      Color(win, cdl_data.mutable, c)		# set the mutable color
+   else {
+      if ((cdl_data.nc +:= 1) > MaxStaticCol) | (not Fg(win, c)) then {
+	 EraseArea(win)				# free allocated colors
+	 VDraw(cdl_data.dialog)			# redraw vidget
+         if Fg(r.win, \cdl_data.refcolor) then	# redraw reference color
+            FillRectangle(r.win, r.ux, r.uy + r.uh, r.uw, -r.uh / 8)
+	 Fg(win, c)				# set new foreground
+	 cdl_data.nc := 1
+      }
+      FillRectangle ! cdl_data.fillargs
+      Fg(win, cdl_data.fg)
+   }
+
+   x1 := cdl_data.rect.ax
+   x2 := x1 + cdl_data.rect.aw
+   y := cdl_data.rect.ay + cdl_data.rect.ah + SliderPad
+   dy := WAttrib(win, "leading")
+
+   EraseArea(win, x1, y, x2 - x1, 3 * dy)	# erase and redraw text area
+   y +:= WAttrib(win, "ascent")
+   x2 -:= TextWidth(win, "h: 360")
+
+   DrawString(win, x1, y, "r: " || right(cdl_data.r, 5))
+   DrawString(win, x2, y, "h: " || right(cdl_data.h, 3))
+   y +:= dy
+   DrawString(win, x1, y, "g: " || right(cdl_data.g, 5))
+   DrawString(win, x2, y, "s: " || right(cdl_data.s, 3))
+   y +:= dy
+   DrawString(win, x1, y, "b: " || right(cdl_data.b, 5))
+   DrawString(win, x2, y, "v: " || right(cdl_data.v, 3))
+
+   (\cdl_data.callback)(cdl_data.id, c)		# invoke user callback, if any
+   return
+end
+
+#  Popup(win, x, y, w, h, proc, args[])
+
+$define BorderWidth 4
+$define ShadowWidth 4
+
+procedure Popup(args[])			#: create popup subwindow
+   local win, x, y, w, h, xx, yy, ww, hh, dx, dy, s, proc, retv, ampwin, save
+
+   # Get parameters.
+   PushWin(args)
+   win := get(args)
+   x := get(args);		integer(x) | runerr(101, \x)
+   y := get(args);		integer(y) | runerr(101, \y)
+   w := \get(args) | 250; 	integer(w) | runerr(101, w)
+   h := \get(args) | 150; 	integer(h) | runerr(101, h)
+   proc := \get(args) | Event
+
+   # Handle defaults
+   dx := WAttrib(win, "dx")
+   dy := WAttrib(win, "dy")
+   w >:= WAttrib(win, "width")			# limit to size of full win
+   h >:= WAttrib(win, "height")
+   /x := (WAttrib(win, "width") - w) / 2 - dx	# center the subwindow
+   /y := (WAttrib(win, "height") - h) / 2 - dy
+
+   # Adjust subwindow configuration parameters.
+   xx := x - BorderWidth
+   yy := y - BorderWidth
+   ww := w + 2 * BorderWidth + ShadowWidth
+   hh := h + 2 * BorderWidth + ShadowWidth
+
+   # Save original window contents.
+   save := ScratchCanvas(ww, hh, "__Popup__") |
+      stop("can't get ScratchCanvas in Popup()")
+   CopyArea(win, save, xx, yy, ww, hh)
+
+   # Save &window and create subwindow.
+   ampwin := &window
+   &window := Clone(win) | stop("can't Clone in Popup()")
+   WAttrib("drawop=copy", "fillstyle=solid", "linestyle=solid", "linewidth=1",
+      "dx=" || (dx + x), "dy=" || (dy + y))
+   DrawRectangle(-BorderWidth, -BorderWidth, ww-ShadowWidth-1, hh-ShadowWidth-1)
+   BevelRectangle(-BorderWidth + 1, -BorderWidth + 1,
+      ww - ShadowWidth - 2, hh - ShadowWidth - 2, BorderWidth)
+   FillRectangle(-BorderWidth + ShadowWidth, h + BorderWidth,
+      ww - ShadowWidth, ShadowWidth)
+   FillRectangle(w + BorderWidth, -BorderWidth + ShadowWidth,
+      ShadowWidth, hh - ShadowWidth) 
+   Clip(0, 0, w, h)
+   EraseArea()
+
+   # Flush any previously entered events on the window
+   while *Pending(win) > 0 do
+      Event(win)
+
+   # Call proc; save result, if any, or use args as flag if none.
+   retv := (proc ! args) | args
+
+   # Restore window and return result.  Use &window to ensure drawop=copy.
+   Clip(-BorderWidth, -BorderWidth, ww, hh)
+   CopyArea(save, &window, 0, 0, ww, hh, -BorderWidth, -BorderWidth)
+   EraseArea(save)
+   &window := ampwin
+   return args ~=== retv
+end
diff --git a/ipl/gprocs/dialogs.icn b/ipl/gprocs/dialogs.icn
new file mode 100644
index 0000000..d916389
--- /dev/null
+++ b/ipl/gprocs/dialogs.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     dialogs.icn
+#
+#	Subject:  Declaration to link to dialog
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     November 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link dialog
diff --git a/ipl/gprocs/distance.icn b/ipl/gprocs/distance.icn
new file mode 100644
index 0000000..60fe238
--- /dev/null
+++ b/ipl/gprocs/distance.icn
@@ -0,0 +1,31 @@
+############################################################################
+#
+#	File:     distance.icn
+#
+#	Subject:  Procedure to compute distance in n-dimensions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 3, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  distance(d1, d2, d3, ...) returns the distance between points in n-space
+#  distances d1, d2, d3, ... from the origin.
+#
+############################################################################
+
+procedure distance(d[])
+   local sum
+
+   sum := 0
+
+   every sum +:= !d ^ 2
+
+   return sqrt(sum)
+
+end
diff --git a/ipl/gprocs/drag.icn b/ipl/gprocs/drag.icn
new file mode 100644
index 0000000..67d4602
--- /dev/null
+++ b/ipl/gprocs/drag.icn
@@ -0,0 +1,169 @@
+############################################################################
+#
+#	File:     drag.icn
+#
+#	Subject:  Procedures for dragging rectangles
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 21, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures drag rectangular objects in a window.
+#
+#	Drag(x, y, w, h)		provides an opaque move.
+#
+#	DragOutline(x, y, w, h)		drags only the outline.
+#
+############################################################################
+#
+#  Drag(x, y, w, h) lets the user move a rectangular area using the
+#  mouse.  Called when a mouse button is pressed, Drag() handles all
+#  subsequent events until a mouse button is released.  As the mouse
+#  moves, the rectangular area originally at (x,y,w,h) follows it
+#  across the screen; vacated pixels at the original location are
+#  filled with the background color.  The rectangle cannot be dragged
+#  off-screen or outside the clipping region.  When the mouse button
+#  is released, Drag() sets &x and &y to the upper-left corner of the
+#  new location and returns.
+#
+#  DragOutline(x, y, w, h) lets the user move a reverse-mode rectangle
+#  using the mouse.  Called when a mouse button is pressed, DragOutline
+#  draws a reverse-mode rectangle inside the limits of the rectangle
+#  (x,y,w,h) and handles all subsequent events until a mouse button is
+#  released.  As the mouse moves, the rectangle follows it.  When the
+#  mouse button is released, the rectangle disappears, and DragOutline
+#  sets &x and &y to the upper-left corner of the new location.  It is
+#  up to the calling program to update the display as necessary.
+#
+############################################################################
+#
+#  Requires: Version 9 graphics
+#
+############################################################################
+
+link graphics
+
+
+#  Drag(x, y, w, h) -- opaque drag
+
+procedure Drag(win, x, y, w, h)			#: opaque rectangle drag
+   local dx, dy, x0, y0, x1, y1
+   local behind, xoff, yoff, xnew, ynew, xshift, yshift
+
+   if type(win) ~== "window" then
+      return Drag((\&window | runerr(140)), win, x, y, w)
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   dx := WAttrib(win, "dx")
+   dy := WAttrib(win, "dy")
+
+   x0 := -dx				# set limits due to window size
+   y0 := -dy
+   x1 := WAttrib(win, "width") - dx - w
+   y1 := WAttrib(win, "height") - dy - h
+
+   x0 <:= \WAttrib(win, "clipx")	# adjust limits for clipping
+   y0 <:= \WAttrib(win, "clipy")
+   x1 >:= \WAttrib(win, "clipx") + \WAttrib(win, "clipw") - w
+   y1 >:= \WAttrib(win, "clipy") + \WAttrib(win, "cliph") - h
+
+   behind := ScratchCanvas(win, , , "__Drag__") |
+      stop("can't get ScratchCanvas in Drag()")
+   CopyArea(win, behind, -dx, -dy)
+   Bg(behind, Bg(win))
+   EraseArea(behind, x + dx, y + dy, w, h)
+
+   xoff := x - &x
+   yoff := y - &y
+
+   until Event(win) === (&lrelease | &mrelease | &rrelease) do {
+
+      # move the rectangle
+      xnew := &x + xoff
+      ynew := &y + yoff
+      xnew <:= x0
+      ynew <:= y0
+      xnew >:= x1
+      ynew >:= y1
+      CopyArea(win, x, y, w, h, xnew, ynew)
+
+      # repaint the area exposed by its movement
+      xshift := xnew - x
+      yshift := ynew - y
+
+      if abs(xshift) >= w | abs(yshift) >= h then {
+
+         # completely disjoint from new location
+         CopyArea(behind, win, x + dx, y + dy, w, h, x, y)
+         }
+
+      else {
+
+         # new area overlaps old
+         if xshift > 0 then
+            CopyArea(behind, win, x + dx, y + dy, xshift, h, x, y)
+         else if xshift < 0 then
+            CopyArea(behind, win,
+               x + dx + w + xshift, y + dy, -xshift, h, x + w + xshift, y)
+         if yshift > 0 then
+            CopyArea(behind, win, x + dx, y + dy, w, yshift, x, y)
+         else if yshift < 0 then
+            CopyArea(behind, win,
+               x + dx, y + dy + h + yshift, w, -yshift, x, y + h + yshift)
+         }
+
+      x := xnew
+      y := ynew
+      }
+
+   EraseArea(behind)
+   &x := x			
+   &y := y
+   return win
+end
+
+
+#  DragOutline(x, y, w, h) -- outlined drag
+
+procedure DragOutline(win, x, y, w, h)		#: outlined rectangle drag
+   local wrev, xoff, yoff
+
+   if type(win) ~== "window" then
+      return DragOutline((\&window | runerr(140)), win, x, y, w)
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   wrev := Clone(win, "drawop=reverse")
+   xoff := x - &x
+   yoff := y - &y
+
+   w -:= 1					# adjust Draw/Fill inconsistency
+   h -:= 1
+
+   DrawRectangle(wrev, x, y, w, h)		# draw initial rectangle
+   until Event(wrev) === (&lrelease | &mrelease | &rrelease) do {
+      DrawRectangle(wrev, x, y, w, h)		# erase old rectangle
+      x := &x + xoff
+      y := &y + yoff
+      DrawRectangle(wrev, x, y, w, h)		# draw new rectangle
+      }
+   DrawRectangle(wrev, x, y, w, h)		# erase final rectangle
+   Uncouple(wrev)
+
+   &x := x			
+   &y := y
+   return win
+end
diff --git a/ipl/gprocs/drawcard.icn b/ipl/gprocs/drawcard.icn
new file mode 100644
index 0000000..341aeaa
--- /dev/null
+++ b/ipl/gprocs/drawcard.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     drawcard.icn
+#
+#	Subject:  Procedure to draw a playing card
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#     drawcard(win, x, y, c) draws the playing card labeled <c> with its
+#  upper left corner at (x,y).  The card size is fixed at 80w x 124h.
+#
+#     Card labelings are those used in the examples in the "Mappings and
+#  Labelings" chapter of the Icon book (pp 205-207, 2/e).
+#
+#         label: ABCDEFGHIJKLM NOPQRSTUVWXYZ abcdefghijklm nopqrstuvwxyz
+#         rank:  A23456789TJQK A23456789TJQK A23456789TJQK A23456789TJQK
+#         suit:  clubs........ diamonds..... hearts....... spades.......
+#
+#  If the label is unrecognized, the back of a card is drawn.
+#  "-" is suggested as a conventional label for a card back.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cardbits, graphics
+#
+############################################################################
+
+link cardbits
+link graphics
+
+procedure drawcard(win, x, y, label)
+   static cmap, gc, bk, plist, deck
+   local ysuit, yrank, r, s, i, l, dx, dy
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: label
+      win := &window
+      }
+   if /gc then {
+      # funny order of card deck is for conversion to ranks below
+      deck := "ABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZ"
+      cmap := cardmap() | stop("can't initialize card fragments")
+      gc := Clone(win, "fg=black", "bg=white")
+      bk := Clone(gc)
+      Pattern(bk, "32,#_
+         04444044_
+         0A08000A_
+         11101011_
+         0A00080A_
+         44004404_
+         8000A000_
+         10011001_
+         A0002000_
+         40044404_
+         000A0A02_
+         01111101_
+         020A0A00_
+         44440440_
+         00A00020_
+         11100111_
+         008000A0_
+         40440444_
+         000A0A08_
+         10111110_
+         080A0A00_
+         44044400_
+         A0008000_
+         10011001_
+         2000A000_
+         44044004_
+         0A02000A_
+         11010111_
+         0A00020A_
+         04404444_
+         002000A0_
+         01111110_
+         00A00080")
+      WAttrib(bk, "fillstyle=textured")
+      if WAttrib(bk, "depth") > 1 then
+         WAttrib(bk, "fg=dark red-yellow", "bg=light red-yellow")
+      plist := [
+         [0, 0],			#  A
+         [0, 39],			#  2
+         [0, 39, 0, 0],			#  3
+         [16, 39],			#  4
+         [16, 39, 0, 0],		#  5
+         [16, 0, 16, 39],		#  6
+         [16, 0, 16, 39, 0, -20],	#  7
+         [16, 0, 16, 39, 0, 20],	#  8
+         [16, 13, 16, 39, 0, 0],	#  9
+         [16, 13, 16, 39, 0, 26]	# 10
+         ]
+      }
+
+   if (i := (deck ? find(label)) - 1) then {
+      r := i % 13 + 1			# 1 to 13 for A,2,...,9,10,J,Q,K
+      s := i / 13 + 1			# 1=heart, 2=diamond, 3=spade, 4=club
+      }
+   else {
+      # unrecognized; draw card back
+      DrawRectangle(gc, x, y, 80-1, 124-1)
+      FillRectangle(bk, x+1, y+1, 80-2, 124-2)
+      return
+      }
+
+   ClearOutline(gc, x, y, 80-1, 124-1)
+   ysuit := 94 * (s-1)
+   yrank := (if s <= 2 then 404 else 376)
+
+   CopyArea(cmap, gc, 9 * (r-1), yrank, 9, 14, x+4, y+6)	# rank
+   CopyArea(cmap, gc, 9 * (r-1), yrank+14, 9, 14, x+67, y+104)	# inverted rank
+   CopyArea(cmap, gc, 148, ysuit+40, 9, 14, x+4, y+22)		# suit
+   CopyArea(cmap, gc, 148, ysuit+54, 9, 14, x+67, y+88)	# inverted suit
+
+   if r > 10 then
+      CopyArea(cmap, gc, 48 * (r-11), ysuit, 48, 94, x+16, y+15) # faces
+   else if (r = 1) & (s = 4) then
+      CopyArea(cmap, gc, 117, 376, 43, 56, x+18, y+34)		# ace of spaces
+   else {
+      l := plist[r]
+      i := 0
+      while (dx := l[i +:= 1]) & (dy := l[i +:= 1]) do {
+         if dy = 0 then {
+            # pip in center row; reflect horizontally if dx positive
+            CopyArea(cmap, gc, 144, ysuit, 16, 20, x + dx + 32, y + 52)
+            if dx > 0 then
+               CopyArea(cmap, gc, 144, ysuit, 16, 20, x - dx + 32, y + 52)
+            }
+         else if dx = 0 then {
+            # pip in center column; reflect vertically if dy positive
+            if dy > 0 then {
+               CopyArea(cmap, gc, 144, ysuit + 20, 16, 20, x + 32, y + dy + 52)
+               CopyArea(cmap, gc, 144, ysuit, 16, 20, x + 32, y - dy + 52)
+               }
+            else
+               CopyArea(cmap, gc, 144, ysuit, 16, 20, x + 32, y + dy + 52)
+            }
+         else {
+            # all other positions are 4-way symmetric
+            CopyArea(cmap, gc, 144, ysuit+20, 16, 20, x + dx + 32, y + dy + 52)
+            CopyArea(cmap, gc, 144, ysuit+20, 16, 20, x - dx + 32, y + dy + 52)
+            CopyArea(cmap, gc, 144, ysuit, 16, 20, x + dx + 32, y - dy + 52)
+            CopyArea(cmap, gc, 144, ysuit, 16, 20, x - dx + 32, y - dy + 52)
+            }
+         }
+      }
+   return
+end
+
+#  cardmap() -- create and load card bitmap
+#
+#  The bitmap is in a separate source file cardbits.icn due to its size.
+#  It is represented there as a bilevel image.
+
+procedure cardmap()		# create and load card bitmap
+   local ims, cmap, rmap
+
+   ims := cardbits()
+   cmap := open("cardbits", "g", "canvas=hidden", "size=160,432") | fail
+						# make offscreen canvas
+   DrawImage(cmap, 0, 0, cardbits()) 		# load card fragments
+
+   if WAttrib(cmap, "depth") == "1" then {	# if monochrome screen
+      # dither red portions
+      Pattern(cmap, "4,#4141")
+      WAttrib(cmap, "fillstyle=masked", "fg=white")
+      FillRectangle(cmap, 0, 0, 160, 188, 0, 404, 117, 128)
+      # redraw face outlines
+      WAttrib(cmap, "fillstyle=solid", "fg=black")
+      every DrawRectangle(cmap, 0 to 96 by 48, 0 to 282 by 94, 47, 93)
+      }
+   else {					# if color screen
+      # replace red portions with red bitmaps
+      rmap := open("redcards", "g", "canvas=hidden", "size=160,432",
+         "fg=dark red") | fail
+      DrawImage(rmap, 0, 0, cardbits())
+      CopyArea(rmap, cmap, 0, 0, 160, 188, 0, 0)
+      CopyArea(rmap, cmap, 0, 404, 117, 128, 0, 404)
+      Uncouple(rmap)
+      }
+   return cmap					# return pixmap
+end
diff --git a/ipl/gprocs/drawcolr.icn b/ipl/gprocs/drawcolr.icn
new file mode 100644
index 0000000..216f9e2
--- /dev/null
+++ b/ipl/gprocs/drawcolr.icn
@@ -0,0 +1,69 @@
+############################################################################
+#
+#	File:     drawcolr.icn
+#
+#	Subject:  Procedure to display color list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This program displays the colors given in a list.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+
+$define Cells 16
+$define Width 20
+
+link graphics
+
+procedure draw_colors(clist)
+   local i, j, k, depth, color, colors
+
+   depth := *clist / Cells
+   if *clist % Cells ~= 0 then depth +:= 1
+
+   WClose(\colors)
+
+   colors :=  WOpen("size=" || (Cells * Width) || "," || (depth * Width),
+      "bg=black") | {
+         Notice("Cannot open window for color map.")
+         exit()
+         }
+
+   every j := 0 to depth - 1 do
+      every i := 0 to Cells - 1 do {
+         color := get(clist) | break break
+         Fg(colors, color) | {
+            Notice("Cannot set foreground to " || image(color) || ".")
+            next
+            }
+         FillRectangle(colors, i * Width + 1, j * Width + 1, Width - 1,
+            Width - 1)
+         }
+
+   Bg(colors, "dark gray")
+   Fg(colors, "black")
+   WAttrib(colors, "fillstyle=textured")
+   WAttrib(colors, "pattern=checkers")
+
+   every k := i to Width - 1 do			# fill out rest
+      FillRectangle(colors, k * Width + 1, j * Width + 1, Width - 1, Width - 1)
+
+   return colors
+
+end
diff --git a/ipl/gprocs/drawlab.icn b/ipl/gprocs/drawlab.icn
new file mode 100644
index 0000000..f19139a
--- /dev/null
+++ b/ipl/gprocs/drawlab.icn
@@ -0,0 +1,108 @@
+############################################################################
+#
+#	File:     drawlab.icn
+#
+#	Subject:  Procedure to draw figures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure is a general-purpose interface used by various programs
+#  that draw figures of various kinds.
+#
+#  Although it's listed as requiring graphics, that's really not necessary
+#  for interfaces to other devices or just producing coordinates.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  ifg, gtrace, gdisable, wopen, xgtrace
+#
+############################################################################
+
+link ifg
+link gtrace
+link gdisable
+link wopen
+link xgtrace
+
+global size	# can be set by caller to control the window size
+
+procedure drawlab(p, callt, label)
+   local line, ws, calls, arg, trace, dlist, name
+
+   /size := 600
+
+   ws := ' \t'
+
+   calls := callt()
+
+   dlist := []
+   every put(dlist, key(calls))
+   dlist := sort(dlist)
+
+#  If a window can be opened, set things up for drawing.  If not, just
+#  list coordinates.  (This is useful for testing when an X server
+#  is not available.)
+
+   if ifg() then {
+      WOpen("label=" || label, "width=" || size, "height=" || size) |
+         stop("*** cannot open window")
+      trace := line_trace
+      }
+   else {
+      gdisable()
+      trace := list_coords
+      }
+
+   while line := read() do {
+      EraseArea()			# clear window if there is one
+      args := []
+      line ? {
+         tab(many(ws))
+         if ="=" then {
+            name := tab(0)
+            GotoRC(2, 2)
+            writes(&window, name)
+            trace(\calls[name]) | {
+               write(&errout, "*** erroneous specification")
+               next
+               }
+            }
+         else if ="all" then {
+            every name := !dlist do {
+               GotoRC(2, 2)
+               writes(&window, name)
+               trace(calls[name])
+               Event()
+               EraseArea()
+               }
+            }
+         else {				# not tested yet
+            tab(many(ws))
+            while arg := tab(upto(',')) do {
+               if *arg = 0 then put(args, &null) else {
+                  put(args, numeric(arg)) | {
+                     write(&errout, "*** erroneous specification")
+                     next
+                     }
+                  }
+               move(1) | break
+               tab(many(ws))
+               }
+            trace(call(p, args))
+            }
+         }
+      }
+
+end
diff --git a/ipl/gprocs/dsetup.icn b/ipl/gprocs/dsetup.icn
new file mode 100644
index 0000000..0d5492a
--- /dev/null
+++ b/ipl/gprocs/dsetup.icn
@@ -0,0 +1,293 @@
+############################################################################
+#
+#	File:     dsetup.icn
+#
+#	Subject:  Procedures for creating dialog boxes
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  dsetup(win, wlist) initializes a set of widgets according to
+#  a list of specifications created by the interface editor VIB.
+#
+#  win can be an existing window, or null.
+#
+#  wlist is a list of specifications; the first must be the Sizer and
+#  the last may be null.  Each specification is itself a list consisting
+#  of a specification string, a callback routine, and an optional list
+#  of additional specifications.  Specification strings vary by vidget
+#  type, but the general form is "ID:type:style:n:x,y,w,h:label".
+#
+#  dsetup() returns a table of values from the dialog, indexed by ID.
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Links:  dialog, xio, xutils,
+#          vidgets, vslider, vmenu, vscroll, vtext, vbuttons, vradio
+#          vdialog
+#
+############################################################################
+
+$include "vdefns.icn"
+
+link dialog
+link vdialog
+link vidgets
+link vslider
+link vmenu
+link vscroll
+link vtext
+link vbuttons
+link vradio
+link vsetup
+
+record DL_rec(var, typ, sty, num, x, y, w, h, lbl, cbk, etc)
+record DL_state(dialog, list, deflabel)
+
+global did_list, did_label
+
+## dsetup(win, wlist) -- set up vidgets and return table of handles
+#
+#  wlist is a list of vidget specs as constructed by vib (or uix).
+
+procedure dsetup(win, wlist[])
+   local r, dialog, obj, num, wspec, alist
+
+   if type(win) ~== "window" then
+      win := &window
+
+   win := Clone(win, "fg=black", "linewidth=1", "linestyle=solid",
+      "fillstyle=solid", "drawop=copy")	# clone window with standard attribs
+   VSetFont(win)			# set standard VIB font
+   if ColorValue(Bg(win)) == ("65535,65535,65535" | "0,0,0") then
+      Bg(win, VBackground)		# change black or white bg to pale gray
+
+   while /wlist[-1] do			# ignore trailing null elements
+      pull(wlist)
+   wspec := get(wlist)			# first spec gives wdow size
+
+   r := DL_crack(wspec) | stop("dsetup: bad spec")
+
+   did_list := []
+   did_label := &null
+
+   dialog := Vdialog(win, 0, 0)		# create dialog frame
+   dialog.id := r.var
+   VInsert(dialog, Vmessage(win, ""),	# set dialog box dimensions
+      r.x + r.w - 1, r.y + r.h - WAttrib(win, "fheight") - 1)
+
+   every r := DL_crack(!sort(wlist), &null) do {
+      DL_obj(win, dialog, r)			# insert other vidgets
+      }
+
+   VFormat(dialog)				# create the dialog
+
+   return DL_state(dialog, did_list, did_label)	# return state for dpopup()
+
+end
+
+procedure dpopup(win, dftbl, dstate)
+   local did_list, init_list, i
+
+   if type(win) ~== "window" then {
+      win :=: dftbl
+      }
+
+   /dftbl := table()
+   did_list := dstate.list
+
+   init_list := list(*did_list)
+   every i := 1 to *did_list do
+      init_list[i] := \dftbl[did_list[i]]
+
+   dialog_value := VOpenDialog(dstate.dialog, , dstate.dialog.id,
+      init_list, dstate.deflabel)
+
+   every i := 1 to *did_list do
+      dftbl[did_list[i]] := dialog_value[i]
+
+   dialog_value := dftbl
+
+   return dialog_button
+
+end
+
+## DL_crack(wspec, cbk) -- extract elements of spec and put into record
+#
+#  cbk is a default callback to use if the spec doesn't supply one.
+
+procedure DL_crack(wspec, cbk)
+   local r, f
+
+   r := DL_rec()
+   (get(wspec) | fail) ? { 
+      r.var := tab(upto(':')) | fail;  move(1)
+      r.typ := tab(upto(':')) | fail;  move(1)
+      r.sty := tab(upto(':')) | fail;  move(1)
+      r.num := tab(upto(':')) | fail;  move(1)
+      r.x := tab(upto(',')) | fail;  move(1)
+      r.y := tab(upto(',')) | fail;  move(1)
+      r.w := tab(upto(',')) | fail;  move(1)
+      r.h := tab(upto(':')) | fail;  move(1)
+      r.lbl := tab(0)
+      }
+   get(wspec)		# skip callback field
+   r.cbk := cbk		# always use parameter
+   r.etc := get(wspec)
+   return r
+end
+
+
+## DL_obj(win, dialog, r) -- create vidget depending on type
+
+procedure DL_obj(win, dialog, r)
+   local obj, gc, style, lo, hi, iv, args
+
+   case r.typ of {
+      "Label" | "Message": {
+         obj := Vmessage(win, r.lbl)
+         VInsert(dialog, obj, r.x, r.y, r.w, r.h)
+         }
+      "Line": {
+         obj := Vline(win, r.x, r.y, r.w, r.h)
+         VInsert(dialog, obj, r.x, r.y, 1, 1) 
+         }
+#     "Rect": {   # doesn't work
+#        gc := Clone(win)
+#        if r.num == "" | r.num = 0 then
+#           r.num := &null
+#        obj := Vpane(gc, r.cbk, r.var, r.num)
+#        VInsert(dialog, obj, r.x, r.y, r.w, r.h)
+#        }
+      "Rect":  &null
+      "List":  &null
+      "Check": {
+         obj := Vcheckbox(win, r.cbk, r.var, r.w)
+         VInsert(dialog, obj, r.x, r.y, r.w, r.h)
+         }
+      "Button": {
+         style := case r.sty of {
+            "regular":	V_RECT
+            "regularno":V_RECT_NO
+            "check":	V_CHECK
+            "checkno":	V_CHECK_NO
+            "circle":	V_CIRCLE
+            "circleno":	V_CIRCLE_NO
+            "diamond":	V_DIAMOND
+            "diamondno":V_DIAMOND_NO
+            "xbox":	V_XBOX
+            "xboxno":	V_XBOX_NO
+            default:	V_RECT
+            }
+         if r.num == "1" then {		# toggle
+            put(did_list, r.var)
+            obj := Vtoggle(win, r.lbl, r.cbk, r.var, style, r.w, r.h)
+            VRegister(dialog, obj, r.x, r.y)
+            }
+         else {				# dismiss
+            obj := Vbutton(win, r.lbl, dialog_cb, V_OK, style, r.w, r.h)
+            VInsert(dialog, obj, r.x, r.y)
+            if r.num == "-1" then
+               did_label := r.lbl
+            }
+         }
+      "Choice": {
+         obj := Vradio_buttons(win, r.etc, r.cbk, r.var, V_DIAMOND_NO)
+         put(did_list, r.var)
+         VRegister(dialog, obj, r.x, r.y)
+         }
+      "Slider" | "Scrollbar" : {
+         r.lbl ? {
+            lo := numeric(tab(upto(',')))
+            move(1)
+            hi := numeric(tab(upto(',')))
+            move(1)
+            iv := numeric(tab(0))
+            }
+         if r.num == "" then
+            r.num := &null
+         obj := case (r.sty || r.typ) of {
+            "hSlider":
+               Vhoriz_slider(win, r.cbk, r.var, r.w, r.h, lo, hi, iv, r.num)
+            "vSlider":
+               Vvert_slider(win, r.cbk, r.var, r.h, r.w, hi, lo, iv, r.num)
+            "hScrollbar":
+               Vhoriz_scrollbar(win, r.cbk, r.var, r.w, r.h, lo, hi, , , r.num) 
+            "vScrollbar":
+               Vvert_scrollbar(win, r.cbk, r.var, r.h, r.w, hi, lo, , , r.num)
+            }
+         put(did_list, r.var)
+         VRegister(dialog, obj, r.x, r.y)
+         }
+      "Text": {
+         obj := Vtext(win, r.lbl, r.cbk, r.var, r.num)
+         put(did_list, r.var)
+         VRegister(dialog, obj, r.x, r.y)
+         }
+#     "Menu": {
+#        obj := Vmenu_bar(win, r.lbl, DL_submenu(win, r.etc, r.cbk))
+#        VInsert(dialog, obj, r.x, r.y)
+#        }
+      "Menu":  &null
+      default: {
+         stop("dsetup: unrecognized object: ", r.typ)
+         fail
+         }
+   }
+   return obj
+end
+
+
+
+## DL_submenu(win, lst, cbk) -- create submenu vidget
+
+procedure DL_submenu(win, lst, cbk)
+   local a, c, lbl
+
+   a := [win]
+   while *lst > 0 do {
+      put(a, get(lst))
+      if type(lst[1]) == "list" then
+         put(a, DL_submenu(win, get(lst), cbk))
+      else
+         put(a, cbk)
+      }
+   return Vsub_menu ! a
+end
+
+
+
+## dproto(proc, font, w, h) -- prototype a dialog box procedure built by vib
+#
+#  n.b. "font" is now ignored, although it was once significant.
+
+procedure dproto(proc, font, w, h)
+   local win, s, l
+
+   w <:= 150
+   h <:= 100
+   win := Window([], "canvas=hidden")
+   VSetFont(win)
+   repeat {
+      if write(image(proc), " returned ", image(proc(win))) then {
+         l := sort(dialog_value, 3)
+         while write("   dialog_value[\"", get(l), "\"] = ", image(get(l)))
+         }
+      else
+         write(image(proc), " failed")
+      if TextDialog(win,"Test prototype",,,,["Again","Quit"]) == "Quit" then
+         break
+      }
+   WClose(win)
+end
diff --git a/ipl/gprocs/enqueue.icn b/ipl/gprocs/enqueue.icn
new file mode 100644
index 0000000..69c81b1
--- /dev/null
+++ b/ipl/gprocs/enqueue.icn
@@ -0,0 +1,157 @@
+############################################################################
+#
+#	File:     enqueue.icn
+#
+#	Subject:  Procedures for queued events
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures manipulate Icon window events.
+#
+#	Enqueue(W, eventcode, x, y, modkeys, interval) posts an event.
+#
+#	pack_modkeys(s)		encodes the modifier keys for an event.
+#	unpack_modkeys(n)	decodes a modifier key value.
+#
+#	pack_intrvl(n)		encodes an event interval.
+#	unpack_intrvl(n)	decodes an event interval.
+#
+############################################################################
+#
+#      Icon's event queue is a list accessed via Pending(); the list
+#   can be inspected or altered by the Icon program.  An event is stored
+#   as three consecutive entries on the list.  The first is the event code:
+#   a string for a keypress, or an integer for any other event.  The next
+#   two list entries are integers, interpreted as a packed structure:
+#	0000 0000 0000 0SMC  XXXX XXXX XXXX XXXX   (second entry)
+#	0EEE MMMM MMMM MMMM  YYYY YYYY YYYY YYYY   (third entry)
+#
+#   The fields have these meanings:
+#	X...X	&x: 16-bit signed x-coordinate value
+#	Y...Y	&y: 16-bit signed y-coordinate value
+#	SMC	&shift, &meta, and &control (modifier keys)
+#	E...M	&interval, interpreted as  M * 16 ^ E
+#	0	currently unused; should be zero
+#
+#
+#      pack_modkeys(s) encodes a set of modifier keys, returning an
+#   integer with the corresponding bits set.  The string s contains
+#   any combination of the letters c, m, and s to specify the bits
+#   desired.
+#
+#      pack_intrvl(n) encodes an interval of n milliseconds and returns
+#   a left-shifted integer suitable for combining with a y-coordinate.
+#
+#      unpack_modkeys(n) returns a string containing 0 to 3 of the
+#   letters c, m, and s, depending on which modifier key bits are
+#   set in the argument n.
+#
+#      unpack_intrvl(n) discards the rightmost 16 bits of the integer
+#   n (the y-coordinate) and decodes the remainder to return an
+#   integer millisecond count.
+#
+#      Enqueue([window,] eventcode, x, y, modkeys, interval) synthesizes
+#   and enqueues an event for a window, packing the interval and modifier
+#   keys (specified as above) into the correct places.  Default values
+#   are:
+#	eventcode = &null
+#	x = 0
+#	y = 0
+#	interval = 0
+#	modkeys = ""
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+#  pack_intrvl(n) -- encode event interval
+
+procedure pack_intrvl(n)			#: encode event interval
+   local e
+
+   n := integer(n) | runerr(101, n)	# ensure integer
+   n <:= 0				# ensure nonnegative
+   e := 0				# assume exponent of 0
+
+   while n >= 16r1000 do {		# if too big
+      n := ishift(n, -4)		# reduce significance
+      e +:= 16r1000			# increase exponent
+   }
+   return ishift(e + n, 16)		# return shifted result
+end
+
+
+#  unpack_intrvl(n) -- decode event interval
+
+procedure unpack_intrvl(n)			#: decode event interval
+   local e
+
+   n := integer(n) | runerr(101, n)	# ensure integer
+   e := iand(ishift(n, -28), 7)		# exponent
+   n := iand(ishift(n, -16), 16rFFF)	# mantissa
+   return ishift(n, 4 * e)
+end
+
+
+#  pack_modkeys(s) -- encode modifier keys
+
+procedure pack_modkeys(s)			#: encode modifier keys
+   local b, c
+
+   b := 0
+   s := string(s) | runerr(103, s)		# ensure string value
+   every c := !s do case c of {			# set bit for each flag
+      "c":	b := ior(b, 16r10000)
+      "m":	b := ior(b, 16r20000)
+      "s":	b := ior(b, 16r40000)
+      default:	runerr(205, s)			# diagnose bad flag
+      }
+   return b					# return result
+end
+
+
+#  unpack_modkeys(n) -- decode modifier keys
+
+procedure unpack_modkeys(n)			#: decode modifier keys
+   local s
+
+   n := integer(n) | runerr(101, n)		# ensure integer
+   s := ""
+   if iand(n, 16r10000) ~= 0 then s ||:= "c"	# check each bit
+   if iand(n, 16r20000) ~= 0 then s ||:= "m"
+   if iand(n, 16r40000) ~= 0 then s ||:= "s"
+   return s					# return result string
+end
+
+
+#  Enqueue(window, eventcode, x, y, modkeys, interval) -- enqueue event
+
+procedure Enqueue(win, eventcode, x, y, modkeys, interval)	#: enqueue event
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: eventcode :=: x :=: y :=: modkeys :=: interval
+      win := &window
+      }
+   /x := 0
+   /y := 0
+   x +:= WAttrib(win, "dx")
+   y +:= WAttrib(win, "dy")
+   return put(Pending(win),
+      eventcode,
+      ior(pack_modkeys(\modkeys | ""), iand(x, 16rFFFF)),
+      ior(pack_intrvl(\interval | 0), iand(y, 16rFFFF)))
+end
diff --git a/ipl/gprocs/event.icn b/ipl/gprocs/event.icn
new file mode 100644
index 0000000..37b46ca
--- /dev/null
+++ b/ipl/gprocs/event.icn
@@ -0,0 +1,43 @@
+############################################################################
+#
+#	File:     event.icn
+#
+#	Subject:  Procedure to produces events from a window event history
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Event(win) overloads the built-in function Event() and produces
+#  events using evplay().
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  evplay
+#
+############################################################################
+
+link evplay
+
+procedure Event(win)
+   static Event_
+
+   initial {
+      Event_ := proc("Event", 0) | stop("*** cannot get built-in Event()")
+      }
+
+   evplay(win) | exit()
+
+   return Event_(win)
+
+end
diff --git a/ipl/gprocs/evmux.icn b/ipl/gprocs/evmux.icn
new file mode 100644
index 0000000..da93237
--- /dev/null
+++ b/ipl/gprocs/evmux.icn
@@ -0,0 +1,236 @@
+############################################################################
+#
+#	File:     evmux.icn
+#
+#	Subject:  Procedures for window event multiplexor
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement a simple event handling package.  This
+#	package has more recently been superseded by the vidget library.
+#
+#	The event multiplexor is configured by registering *sensors*, which
+#	respond to events that occur when the mouse cursor is within a
+#	particular region.  When a sensor fires, it calls a user procedure
+#	that was registered when the sensor was created.
+#
+#	These routines interpret window events and invoke callbacks:
+#
+#		sensor()	registers the events of interest.
+#
+#		evhandle()	reads and responds to the next event.
+#
+#		evmux()		loops forever, handling events.
+#
+#	Two other small procedures help build event-driven programs:
+#
+#		quitsensor()	registers a standardized response to Q or q.
+#
+#		argless()	is a "glue" procedure usable as a callback.
+#
+############################################################################
+#
+#   sensor(win, ev, proc, arg, x, y, w, h) -- register an event responder.
+#
+#	registers *proc* as the procedure to be called when the event[s]
+#	*ev* occur within the given bounds inside window *win* and returns
+#	a handle.  The default bounds encompass the entire window.
+#
+#	The event set *ev* can be either:
+#	    -- a cset or string specifying particular keypresses of interest
+#	    -- one of the event keywords (&lpress, &rdrag, &resize, etc.)
+#
+#	When a matching event occurs, proc(win, arg, x, y, e) is called.  proc,
+#	win, and arg are as recorded from the sensor call.  x and y give the
+#	current mouse position and e the event; for a keypress, this is the
+#	character.
+#
+#	No event generates more than one procedure call.
+#	In the case of conflicting entries, the later registrant wins.
+#
+#	delsensor(win, x) deletes sensor x from the specified window.
+#	If x is null, all sensors are deleted.
+#
+#
+#   evmux(win) -- loop forever, calling event handlers as appropriate.
+#   evhandle(win) -- wait for the next event, and handle it.
+#
+#	evmux(win) is an infinite loop that calls user routines in response
+#	to window events.  It is for programs that don't need to do other
+#	work while waiting for window input.
+#
+#	evhandle(win) processes one event and then returns to its caller,
+#	allowing external loop control.  evhandle returns the outcome of
+#	the handler proc, or fails if there is no handler for the event.
+#
+#   quitsensor(win, wait) -- standardized "quit" sensor
+#
+#	quitsensor() registers a sensor that calls exit() when either
+#	"q" or "Q" is typed in the window.
+#
+#	If wait is non-null, quitsensor does not return but just waits for
+#	the signal (useful in non-interactive display programs).
+#
+#
+#   argless(win, proc) -- call proc with no arguments.
+#
+#	Useful for registering argless procedures as in quitsensor() above.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  button.icn, slider.icn
+#
+############################################################################
+
+record EvMux_Rec(ev, proc, arg, x, y, w, h)
+global EvMux_Windows
+
+
+## sensor(win, ev, proc, arg, x, y, w, h) -- register an event responder.
+
+procedure sensor(win, ev, proc, arg, x, y, w, h)
+   local evlist, r, e
+
+   /EvMux_Windows := table()
+   /EvMux_Windows[win] := list()
+   evlist := EvMux_Windows[win]
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   if type(ev) == ("cset" | "string") then
+      ev := cset(ev)
+   else
+      ev := cset(evchar(ev)) | stop("invalid event specification: ", image(ev))
+   push(evlist, r := EvMux_Rec(ev, proc, arg, x, y, w, h))
+   return r
+end
+
+
+## delsensor(win, x) -- delete sensor x, or all sensors, from window.
+
+procedure delsensor(win, x)
+   local t
+
+   t := \EvMux_Windows[win] | fail
+
+   if /x then {
+      delete(EvMux_Windows, win)	# delete whole set of sensors
+      return
+      }
+
+   if not (x === !t) then
+      fail				# not registered in this window
+
+   # Sensor is registered for this window.  Disable it.
+   x.ev := ''
+
+   # Remove disabled sensors from list, if possible.
+   while *t[1].ev = 0 do
+      pop(t)
+   while *t[-1].ev = 0 do
+      pull(t)
+
+   # If nothing is left on list, delete from table.
+   if *t = 0 then
+      delete(EvMux_Windows, win)
+   return
+end
+
+
+##   evchar(e) -- map mouse event to character code.
+#
+#  Internally, *all* events are single-character strings, and mouse & resizing
+#  events are mapped into characters that are never returned as keypress events.
+
+procedure evchar(s)
+   return case s of {
+      &lpress:    "\237"	# mouse button 1 down
+      &mpress:    "\236"	# mouse button 2 down
+      &rpress:    "\235"	# mouse button 3 down
+      &lrelease:  "\234"	# mouse button 1 up
+      &mrelease:  "\233"	# mouse button 2 up
+      &rrelease:  "\232"	# mouse button 3 up
+      &ldrag:     "\231"	# mouse button 1 is dragging
+      &mdrag:     "\230"	# mouse button 2 is dragging
+      &rdrag:     "\227"	# mouse button 3 is dragging
+      &resize:    "\226"	# window has resized
+   }
+   fail
+end
+
+
+## evmux(win) -- loop forever, calling event handlers as appropriate.
+## evhandle(win) -- wait for the next event, and handle it.
+#		    produce result of the handler proc; fail if nobody handles.
+
+procedure evmux(win)
+   repeat
+      evhandle(win)
+end
+
+procedure evhandle(win)
+   local x, y, ev, e, r, t
+
+   t := (\EvMux_Windows)[win] | stop("no events registered for window")
+   ev := Event(win)
+   x := &x
+   y := &y
+
+   # convert event code to single character
+   if type(ev) == "integer" then
+      e := evchar(ev) | ""
+   else
+      e := ev
+
+   # find and call the first (most recent) matching handler
+   # (just a simple serial search)
+   every r := !t do
+      if any(r.ev, e) & ontarget(r, x, y) then
+         return r.proc(win, r.arg, x, y, ev)
+   fail
+end
+
+
+## ontarget(r, x, y) -- check if an event is within bounds
+#
+#  checks that (x, y) are within the bounds of (r.x, r.y, r.w, r.h).
+
+procedure ontarget(r, x, y)
+   return (x -:= r.x) >= 0 & x < r.w & (y -:= r.y) >= 0 & y < r.h
+end
+
+
+## quitsensor(win, wait) -- standardized "quit" sensor
+
+procedure quitsensor(win, wait)
+   sensor(win, 'qQ', argless, exit)
+   if \wait then evmux(win)
+   return
+end
+
+
+## argless(win, proc) -- call proc with no arguments.
+
+procedure argless(win, proc)
+   return proc()
+end
diff --git a/ipl/gprocs/evplay.icn b/ipl/gprocs/evplay.icn
new file mode 100644
index 0000000..9eb1eeb
--- /dev/null
+++ b/ipl/gprocs/evplay.icn
@@ -0,0 +1,49 @@
+############################################################################
+#
+#	File:     evplay.icn
+#
+#	Subject:  Procedure to "play back" recorded window events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 15, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  evplay(win) reads a window event history file (such as produced by
+#  evrecord()), and puts an event on the event queue for the given window.
+#  If the global identifier EventFile is nonnull, it is used as the
+#  event history; otherwise standard input is used.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  ivalue
+#
+############################################################################
+
+link ivalue
+
+global EventFile
+
+procedure evplay(win)
+   local event1, event2, event3
+
+   /EventFile := &input
+
+   event1 := ivalue(read(EventFile)) | fail
+   event2 := ivalue(read(EventFile)) | stop("*** short event history")
+   event3 := ivalue(read(EventFile)) | stop("*** short event history")
+
+   put(Pending(win), event1, event2, event3)
+
+   return
+
+end
diff --git a/ipl/gprocs/evrecord.icn b/ipl/gprocs/evrecord.icn
new file mode 100644
index 0000000..6eaadf2
--- /dev/null
+++ b/ipl/gprocs/evrecord.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     evrecord.icn
+#
+#	Subject:  Procedure to record window events
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 25, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes a file of graphics events.  The file can be
+#  converted to "pseudo events" by evplay.icn.
+#
+#  When used with a vidget interface, evrecord can be passed as an
+#  argument to, say, GetEvents(), as in
+#
+#	GetEvents(root, , evrecord)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  enqueue
+#
+############################################################################
+
+link enqueue
+
+procedure evrecord(event)
+   local modkeys
+
+   modkeys := ""
+   modkeys ||:= (&shift & "s")
+   modkeys ||:= (&meta & "m")
+   modkeys ||:= (&control & "c")
+
+   write(image(event))
+   write(ior(pack_modkeys(modkeys), iand(&x, 16rFFFF)))
+   write(ior(pack_intrvl(&interval), iand(&y, 16rFFFF)))
+
+   return
+
+end
diff --git a/ipl/gprocs/fetchpat.icn b/ipl/gprocs/fetchpat.icn
new file mode 100644
index 0000000..b2358d6
--- /dev/null
+++ b/ipl/gprocs/fetchpat.icn
@@ -0,0 +1,45 @@
+############################################################################
+#
+#	File:     fetchpat.icn
+#
+#	Subject:  Procedure to fetch a pattern specification
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 21, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure fetches a pattern by number from a file of pattern
+#  specifications.  It fails if the file does not exist or does not
+#  contain that many pattern specifications.
+#
+#  The file is searched for in the current directory first, then using
+#  DPATH.
+#
+############################################################################
+#
+#  Links:  io, patutils
+#
+############################################################################
+
+link io
+link patutils
+
+procedure fetchpat(file, n)
+   local input, pattern
+
+   input := dopen(file) | fail
+
+   every 1 to n do
+      pattern := readpatt(input)
+
+   close(file)
+
+   return \pattern
+
+end
diff --git a/ipl/gprocs/fstars.icn b/ipl/gprocs/fstars.icn
new file mode 100644
index 0000000..3f129c8
--- /dev/null
+++ b/ipl/gprocs/fstars.icn
@@ -0,0 +1,94 @@
+############################################################################
+#
+#	File:     fstars.icn
+#
+#	Subject:  Procedure to produce traces of fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces traces of 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 arguments are:
+#
+#	x, y, n, p, r, incr, extent
+#
+#	x	x coordinate of the initial point, default 0
+#	y	y coordinate of the initial point, default 0.5
+#	n	number of vertices, default 5
+#	p	number of phases, default 5
+#	r	reduction factor, default 0.35
+#	incr	angular increment factor, default 0.8
+#	extent	extent of drawing, 1.0
+#
+#  Chosing values for these arguments that produce interesting results and
+#  centering the star in the window is somewhat of an art.  See fstartbl.icn
+#  for some good values.
+#	
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+global size
+
+procedure fstar(x, y, n, p, r, incr, extent, xinit, yinit)	#: fractal stars
+   local angle, i, h, m, dist, xloc, yloc
+
+   /size := 500
+   /x := 0
+   /y := 0.5 * size
+   /n := 5			# defaults
+   /p := 5
+   /r := 0.35
+   /incr := 0.8
+   /extent := 1.0
+   /xinit := 0
+   /yinit := 0.5
+
+   incr *:= &pi			# scaling
+   extent *:= size
+   xloc := xinit * size
+   yloc := yinit * size
+
+   n -:= 1			# computational convenience
+   p -:= 1
+
+#  suspend Point(x + xloc, y + yloc)		# initial point
+
+   angle := 0
+
+   every i := 0 to ((n + 1) * n ^ p) do {
+      m := i
+      h := 0
+      until (m % n ~= 0) | (h >= p) do {
+         m /:= n
+         h +:= 1
+         }
+      dist := extent * r ^ (p - h)
+      xloc +:= dist * cos(angle)
+      yloc +:= dist * sin(angle)
+      suspend Point(x + xloc, y + yloc)
+      angle +:= incr
+      }
+
+end
diff --git a/ipl/gprocs/fstartbl.icn b/ipl/gprocs/fstartbl.icn
new file mode 100644
index 0000000..5fa1f4d
--- /dev/null
+++ b/ipl/gprocs/fstartbl.icn
@@ -0,0 +1,67 @@
+############################################################################
+#
+#	File:     fstartbl.icn
+#
+#	Subject:  Procedure to produce calls for fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 8, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a table of calls from which fractal stars
+#  can be produced.
+#
+############################################################################
+#
+#  See also:  fstars.icn
+#
+############################################################################
+#
+#  Links:  calls, fstars, numbers
+#
+############################################################################
+
+link calls
+link fstars
+link numbers
+
+procedure fstartbl()
+   local fstars
+
+   fstars := table()
+   fstars["fstar01"] := call(fstar,
+      [0, 0,  5,  5, 0.350, 0.80000, 1.00000, 0.000, 0.450])
+   fstars["fstar02"] := call(fstar,
+      [0, 0,  7,  4, 0.320, div(6, 7), 1.00000, 0.000, 0.570])
+   fstars["fstar03"] := call(fstar,
+      [0, 0, 12,  3, 0.500, div(1, 6), div(11, 48), 0.400, 0.300])
+   fstars["fstar04"] := call(fstar,
+      [0, 0,  5,  2, 0.500, 0.40000, 0.50000, 0.300, 0.500])
+   fstars["fstar05"] := call(fstar,
+      [0, 0,  8,  2, 0.500, 0.25000, div(1, 3), 0.350, 0.500])
+   fstars["fstar06"] := call(fstar,
+      [0, 0, 20,  2, 0.500, 0.10000, div(13, 96), 0.400, 0.500])
+   fstars["fstar07"] := call(fstar,
+      [0, 0, 15,  2, 0.900, div(14, 15), div(43, 48), 0.050, 0.470])
+   fstars["fstar08"] := call(fstar,
+      [0, 0, 16,  3, 0.270, 0.12500, div(1, 6), 0.400, 0.270])
+   fstars["fstar09"] := call(fstar,
+      [0, 0,  8,  4, 0.500, 0.25000, div(17, 48), 0.300, 0.600])
+   fstars["fstar10"] := call(fstar,
+      [0, 0,  7,  5, 0.383, 0.40000, div(7, 12), 0.200, 0.050])
+   fstars["fstar11"] := call(fstar,
+      [0, 0,  4,  8, 0.470, 0.50000, 1.00000, 0.000, 0.680])
+   fstars["fstar12"] := call(fstar,
+      [0, 0, 15,  3, 0.300, div(14, 15), 1.00000, 0.000, 0.470])
+   fstars["fstar13"] := call(fstar,
+      [0, 0,  3, 11, 0.620, div(2, 3), 1.00000, 0.000, 0.450])
+
+   return fstars
+
+end
diff --git a/ipl/gprocs/gdisable.icn b/ipl/gprocs/gdisable.icn
new file mode 100644
index 0000000..4a1df66
--- /dev/null
+++ b/ipl/gprocs/gdisable.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     gdisable.icn
+#
+#	Subject:  Procedure to disable graphics functions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure effectively disables the graphics functions.  Care should
+#  be taken in the way the disabled functions are used, since in their
+#  disabled forms, they return their first argument (if any).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure gdisable()
+
+   every (
+      Active |
+      Alert |
+      Bg |
+      Clip |
+      Clone |
+      Color |
+      ColorValue |
+      CopyArea |
+      Couple |
+      DrawArc |
+      DrawCircle |
+      DrawCurve |
+      DrawImage |
+      DrawLine |
+      DrawPoint |
+      DrawPolygon |
+      DrawRectangle |
+      DrawSegment |
+      DrawString |
+      EraseArea |
+      Event |
+      Fg |
+      FillArc |
+      FillCircle |
+      FillPolygon |
+      FillRectangle |
+      Font |
+      FreeColor |
+      GotoRC |
+      GotoXY |
+      Lower |
+      NewColor |
+      PaletteChars |
+      PaletteColor |
+      PaletteKey |
+      Pattern |
+      Pending |
+      Pixel |
+      QueryPointer |
+      Raise |
+      ReadImage |
+      TextWidth |
+      Uncouple |
+      WAttrib |
+      WDefault |
+      WFlush |
+      WSync |
+      WriteImage) := 1
+
+   return
+
+end
diff --git a/ipl/gprocs/getcolrs.icn b/ipl/gprocs/getcolrs.icn
new file mode 100644
index 0000000..2fafb69
--- /dev/null
+++ b/ipl/gprocs/getcolrs.icn
@@ -0,0 +1,377 @@
+############################################################################
+#
+#	File:     getcolrs.icn
+#
+#	Subject:  Procedures for getting color palette
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures support the interactive selection of colors.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: colrlist, dsetup, interact
+#
+############################################################################
+
+link colrlist, dsetup, interact
+
+global save_colortbl_name
+
+$define	CellSize	16
+$define	ColorCols	16
+$define	ColorRows	16
+$define	ColorField	20
+$define	NumberField	 3
+$define	WPad		20
+$define	HPad		45
+
+global	colors
+global	colortbl
+global	palette
+
+record	colorspec(palette, colors)
+
+procedure color_palette()
+   local pal_win, e, number, color_win, x, y, c, i
+   static windows, attribs, colors_tmp, clist, palettes
+
+   initial {
+
+      windows := table()
+      attribs := table()
+
+      attribs["palette"] := "c3"
+
+      palettes := table()			# set up palette colors
+
+      every clist := ("c" || (1 to 6)) | ("g" || (16 | 64)) do
+         palettes[clist] := colrplte(clist) | {
+            Notice("Internal error")
+            exit()
+            }
+
+      }
+
+   if colors_dl(attribs) == "Cancel" then fail
+
+   clist := palettes[attribs["palette"]]
+
+   color_win := palette_win("color list", WAttrib("width") + WPad, 0) | fail
+
+   pal_win := palette_win("palette", WAttrib("width") + WPad,
+      WAttrib(color_win, "height") + HPad) | fail
+
+   i := 0
+   every y := 1 + (0 to ColorCols) * CellSize do
+      every x := 1 + (0 to ColorRows) * CellSize do {
+         Fg(pal_win, clist[i +:= 1]) | break break
+         FillRectangle(pal_win, x, y, CellSize - 1, CellSize - 1)
+         }
+
+   colors_tmp := []
+
+   x := y := 1
+
+   repeat {
+      e := Event(pal_win)
+      if &meta & (map(e) == "q") then break
+      if e === (&lpress | &rpress | &mpress) then {
+         if ((&x % CellSize) | (&y % CellSize)) = 0 then next	# on border
+         put(colors_tmp, c := Pixel(pal_win, &x, &y, 1, 1))
+         Fg(color_win, c)
+         FillRectangle(color_win, x, y, CellSize - 1, CellSize - 1)
+         x +:= CellSize
+         if (x > ColorCols * CellSize) then {
+            x := 1
+            y +:= CellSize
+            if y > (ColorRows * CellSize) then break
+            } 
+         }
+      }
+
+   WAttrib(pal_win, "canvas=hidden")
+   EraseArea(pal_win)
+   WClose(color_win)
+
+   if *colors_tmp = 0 then return Notice("Empty palette")
+
+   colors := colors_tmp
+
+   if OpenDialog("Palette name:") == "Cancel" then fail
+
+   palette := dialog_value
+
+   colortbl[palette] := colors
+
+   return colors_tmp
+
+end
+
+procedure edit_colors(colors)
+   local color_win, x, y
+
+   color_win := palette_win("color list", WAttrib("width") + WPad, 0) | fail
+   x := y := 1
+
+   every Fg(color_win, !colors) do {
+      FillRectangle(color_win, x, y, CellSize - 1, CellSize - 1)
+      x +:= CellSize
+      if (x > ColorCols * CellSize) then {
+         x := 1
+         y +:= CellSize
+         if y > (ColorRows * CellSize) then break
+         } 
+      }
+
+   Event(color_win)
+
+   WClose(color_win)
+
+end
+
+procedure palette_win(label, xoff, yoff)
+   local win, x, y
+
+   win := WOpen("width=" || (ColorCols * CellSize), "height=" || (ColorRows *
+      CellSize), "label=" || label, "bg=black", "fg=white",
+      "posx=" || (WAttrib("posx") + xoff),
+      "posy=" || (WAttrib("posy") + yoff)) |
+         return Notice("Cannot open window for palette selection")
+
+   WAttrib(win, "fillstyle=textured")
+   Pattern(win, "checkers")
+   Bg(win, "very dark gray")
+
+   every x := 1 + (0 to ColorRows) * CellSize do
+      every y := 1 + (0 to ColorCols) * CellSize do
+         FillRectangle(win, x, y, CellSize - 1, CellSize - 1)
+
+   WAttrib(win, "fillstyle=solid")
+   Bg(win, "black")
+ 
+   return win
+
+end
+
+#  This procedure allows the users to provide lists of colors, widths, and
+#  blend information.
+#
+#  If i = 0 then only integers are allowed.
+#  If i = 1 then only color specifications are allowed.
+#  If i = 2 then both integers and color specifications are allowed.  This
+#  is for blend information.
+
+procedure get_list(i)
+   local n, list_tmp, x
+
+   if Dialog("Number of entries", , 2, NumberField, ["Okay", "Cancel"]) ==
+      "Cancel" then fail
+
+   n := (0 < integer(dialog_value[1])) |
+      return Notice("Invalid number specification")
+
+   if Dialog("Values", , list(n, ""), ColorField, ["Okay", "Cancel"]) ==
+      "Cancel" then fail
+
+   list_tmp := [] 
+
+   every x := !dialog_value do {
+      if *x = 0 then next				# skip empty fields
+      case i of {
+         0:  put(list_tmp, integer(x)) | return Notice("Invalid width")
+         1:  put(list_tmp, ColorValue(x)) | return Notice("Invalid color")
+         2:  put(list_tmp, ColorValue(x) | (\x & integer(x))) |
+            return Notice("Invalid blend value:", x)
+         }
+      }
+ 
+   if *list_tmp = 0 then return Notice("Empty list")
+
+   return list_tmp
+
+end
+
+procedure color_blend()
+   local colors_tmp
+
+   colors_tmp := []
+
+   every put(colors_tmp, Blend ! get_list(2)) | fail	# accept counts
+
+   return colors_tmp
+
+end
+
+procedure get_colors(s)
+
+   return case s of {
+      "palette": color_palette()
+      "file":    unsupported()
+      "list":    get_list(1)
+      "blend":   color_blend()
+      default:   unsupported()
+      }
+
+end
+
+procedure select_color(palette)
+   local clist,k
+
+   clist := []
+   every k := key(colortbl) do
+      if \colortbl[k] then put(clist, k)
+
+   if *clist = 0 then {
+      Notice("No colors are available")
+      fail
+      }
+
+   SelectDialog("Select color list:", sort(clist), palette) == "Okay" | fail
+
+   palette := dialog_value
+   colors := colortbl[palette]
+
+   return
+
+end
+
+procedure save_colortbl()
+   local output, temp, n, clist
+
+   if /save_colortbl_name then return save_colortbl_as()
+
+   output := open(save_colortbl_name, "w") | {
+      Notice("Can't open save file for writing")
+      fail
+      }
+
+   temp := sort(colortbl, 3)
+
+   while n := get(temp) do {
+      clist := \get(temp) | next
+      writes(output, n, ":")
+      every writes(output, !clist, " ")
+      write(output)
+      }
+  
+   close(output)
+
+   return
+
+end
+
+procedure load_colortbl()
+   local line, clist, tbl, name
+
+   load_file("Load color table:") == "Okay" | fail
+
+   tbl := table()
+
+   while line := read(dialog_value) do {
+      line ? {
+         name := tab(upto(':')) | {
+            Notice("Invalid color table.")
+            fail
+            }
+         move(1)
+         clist := []
+         while put(clist, tab(upto(' '))) do
+            move(1)
+         tbl[name] := clist
+         }
+      }
+
+   colortbl := tbl
+   palette := name
+   colors := clist
+
+   close(dialog_value)
+
+   return
+
+end
+
+procedure save_colortbl_as()
+   local n, clist, temp
+
+   save_as("Save color table:") == "Yes" | fail
+
+   temp := sort(colortbl, 3)
+
+   while n := get(temp) do {
+      clist := \get(temp) | next
+      writes(dialog_value, n, ":")
+      every writes(dialog_value, !clist, " ")
+      write(dialog_value)
+      }
+  
+   image(dialog_value) ? {
+      ="file("
+      save_colortbl_name := tab(upto(')'))
+      }
+   close(dialog_value)
+
+   return
+
+end
+
+procedure delete_color()
+   local clist, k
+
+   if *colortbl = 0 then {
+      Notice("No colors are available")
+      fail
+      }
+
+   clist := []
+   every k := key(colortbl) do
+      if \colortbl[k] then put(clist, k)
+
+   SelectDialog("Delete color:", sort(clist), palette) == "Okay" | fail
+
+   TextDialog("Delete " || dialog_value || "?") == "Okay" | fail
+
+   colortbl[dialog_value] := &null
+
+   return
+
+end
+
+procedure delete_colortbl()
+
+   TextDialog("Delete entire color table?") == "Okay" | fail
+
+   colortbl := table()
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure colors_dl(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["colors_dl:Sizer::1:0,0,161,249:colors",],
+   ["cancel:Button:regular::83,214,50,20:Cancel",],
+   ["label1:Label:::11,19,56,13:Palette:",],
+   ["okay:Button:regular:-1:15,213,50,20:Okay",],
+   ["palette:Choice::8:83,16,50,168:",,
+      ["c1","c2","c3","c4","c5",
+      "c6","g16","g64"]],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/gifsize.icn b/ipl/gprocs/gifsize.icn
new file mode 100644
index 0000000..b6dd9a3
--- /dev/null
+++ b/ipl/gprocs/gifsize.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     gifsize.icn
+#
+#	Subject:  Procedure to return size of GIF file
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure returns the size of a GIF file in the form
+#  width,height.  It fails if the file does not exist or is
+#  not a valid GIF file.
+#
+############################################################################
+#
+#  Links:  bincvt
+#
+############################################################################
+
+link bincvt
+
+procedure gifsize(name)			#: size of GIF file
+   local gif, width, height
+
+   gif := open(name) | fail
+
+   repeat {			# only to provide a loop to break out of ...
+      read(gif) ? {
+         =("GIF87a" | "GIF89a") | break
+         width := move(1)
+         width := move(1) || width
+         width := unsigned(width) | break
+         height := move(1)
+         height := move(1) || height
+         height := unsigned(height) | break
+         close(gif)
+         return width || "," || height
+         } | break
+      }
+
+   close(gif)
+   fail
+
+end
diff --git a/ipl/gprocs/glabels.icn b/ipl/gprocs/glabels.icn
new file mode 100644
index 0000000..28e41ab
--- /dev/null
+++ b/ipl/gprocs/glabels.icn
@@ -0,0 +1,68 @@
+############################################################################
+#
+#	File:     glabels.icn
+#
+#	Subject:  Procedure to produce graph ticks
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  glabels(min, max, nticks) produces a list of aesthetically pleasing labels
+#  for graph ticks to cover a given range.  It is based on the algorithm
+#  given by Paul S. Heckert in "Graphic Gems", Andrew S Glassner, ed.,
+#  Academic Press, 1990.
+#
+############################################################################
+#
+#  Links: numbers
+#
+############################################################################
+
+link numbers
+
+procedure glabels(min, max, ntick)
+   local d, graphmin, graphmax, nfrac, llist, x, nf, range
+
+   if min = max then fail		# no can do
+
+   range := nicenum(max - min)
+   d := nicenum(range / (ntick - 1), 1)
+   graphmin := floor(min / d) * d
+   graphmax := ceil(max / d) * d
+   nfrac := max(-floor(log(d, 10)), 0)
+   llist := []
+   every x := graphmin to graphmax + 0.5 * d by d do
+     put(llist, x)
+
+   return llist
+
+end
+
+procedure nicenum(x, round)
+   local exp, f, nf
+
+   exp := floor(log(x, 10))
+   f := x / (10 ^ exp)
+   if \round then {
+      if f < 1.5 then nf := 1
+      else if f < 3.0 then nf := 2
+      else if f < 7 then nf := 5
+      else nf := 10
+      }
+   else {
+      if f <= 1 then nf := 1
+      else if f <= 2 then nf := 2
+      else if f <= 5 then nf := 5
+      else nf := 10
+      }
+
+   return nf * (10 ^ exp)
+
+end
diff --git a/ipl/gprocs/glib.icn b/ipl/gprocs/glib.icn
new file mode 100644
index 0000000..09e749a
--- /dev/null
+++ b/ipl/gprocs/glib.icn
@@ -0,0 +1,789 @@
+############################################################################
+#
+#       File:     glib.icn
+#
+#	Subject:  Procedures for graphics
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This package is the collection of routines
+#      developed to facilitate traditional 2D graphics.
+#      It is incomplete, but still provides
+#      a reasonable amount of support.  There is some
+#      support for 3D graphics here, but that is not so
+#      well developed.  People are encouraged to improve
+#      these routines and add new routines.
+#
+#      All routines use list-based subscripting.  This allows
+#      programs to describe points as lists OR records.
+#
+#      In the turtle graphics code, the use gives angles in
+#      degrees.
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics, co-expressions
+#
+############################################################################
+
+record point(x,y)
+
+############################################################################
+# Clipping algorithms...
+#
+global DO_CLIPPING
+
+
+#  Set the state of clipping: "on" or "off"
+#
+procedure set_clip(state)
+   if map(state) == "on" then
+      DO_CLIPPING := "yes"
+   else
+      DO_CLIPPING := &null
+end
+
+# Either clip a line or leave it alone
+#
+procedure Clip_Line(line,box)
+   if \DO_CLIPPING then
+      return LB_line_clip(line, box)
+   return line
+end
+
+# Note: Liang-Barsky algorithms (or variants) are used.  If you
+#   have fast FP hardware, they are faster than Cohen-Sutherland
+#   (and *much* slower if you *don't*!).  Anyway, they're more
+#   fun to code and easier to extend to 3-D.
+
+#
+# LB_line_clip -- takes a 2-D line (two points) and returns it clipped to
+#    a box (normally the viewport).
+procedure LB_line_clip(line, box)
+   local nline, u, dx, dy
+
+			# initialize important parametric values
+   dx := line[2][1] - line[1][1]
+   dy := line[2][2] - line[2][2]
+   u := [0.0, 1.0]
+
+			# do the clipping
+   if clipcheck(-dx, line[1][1] - box[1][1], u) &
+      clipcheck( dx, box[2][1] - line[1][1], u) &
+      clipcheck(-dy, line[1][2] - box[1][2], u) &
+      clipcheck( dy, box[2][2] - line[1][1], u) then {
+			# return a modified copy of original line
+      nline := copy(line)
+      nline[1] := copy(line[1])
+      nline[2] := copy(line[2])
+
+      if u[2] < 1.0 then {
+         nline[2][1] := line[1][1] + (u[2]*dx)
+         nline[2][2] := line[1][2] + (u[2]*dy)
+         }
+      if u[1] < 1.0 then {
+         nline[1][1] := line[1][1] + (u[1]*dx)
+         nline[1][2] := line[1][2] + (u[1]*dy)
+         }
+      return nline
+      }
+			# no need to clip
+   fail
+end
+   
+procedure clipcheck(p,q,u)
+   local r
+
+   if p < 0.0 then {
+      r := real(q)/p
+      if r > u[2] then fail
+      else if r > u[1] then u[1] := r
+      }
+   else if p > 0.0 then {
+      r := real(q)/p
+      if r > u[1] then fail
+      else if r > u[2] then u[2] := r
+      }
+   else if q >= 0.0 then return
+
+end
+
+#
+# Clip a line to a convex polygon (2-D)
+# 
+procedure Convex_clip(poly, line[])
+	# Cyrus-Beck line clipping against a convex polygon
+	#   (assumes poly is a convex polygon!)
+   local D, nc, E, cline
+   local n, p		# point normal of polygon edge
+   local c, p1		# point slope of line
+   local t_in, t_out	# current endpoints
+   local t, i
+
+   c := make_vector(line[1],line[2])
+   p1 := line[1]
+   t_in := 0
+   t_out := 1
+
+   every i := 2 to *poly+1 do {	# for each edge
+      p := poly[i-1]
+      if i > *poly then
+         n := normal_line(poly[i-1],poly[1])
+      else
+         n := normal_line(poly[i-1],poly[i])
+      D := dot(n,p)
+      
+      if (nc := dot(n,c)) = 0 then {	# parallel to edge
+         if not inside_line(p1,p,n) then {fail}
+                                    else next
+        
+         } 
+
+      t := (D - dot(n,p1))/nc
+
+      if nc > 0 then 			# entering polygon
+         t_in <:= t
+      else				# exiting polygon
+         t_out >:= t
+
+      if t_in >= t_out then {fail}
+      }
+
+   # if we get here, part of the line is visible, return that part
+
+   cline := copy(line)
+   cline[1] := vpara(line[1],line[2],t_in)
+   cline[2] := vpara(line[1],line[2],t_out)
+
+   return cline
+end
+
+
+
+#   - some interesting curves
+###
+
+############################################################################
+# Draw a fractal snowflake or order N between two points
+############################################################################
+#
+# Draw a fractal snowflake between two points
+#
+procedure fract_flake(win,A,C,n,lr,cp)
+   local direction, t
+
+   /lr := 1
+   direction := Rel_angle(A,C)
+   t := turtle(win, A, direction)
+   f_flake(t, distance(A,C), n, lr, cp)
+   return
+end
+
+procedure f_flake(t, len, n, lr, cp)
+   local angle, p, nextcolor
+
+   if n > 0 then {
+      # if nextcolor is available, change the foreground color
+      Fg ! ([t.win.vp.screen] ||| @\nextcolor)
+      Left(t,lr*60)
+      f_flake(t, len*0.333333, n-1, -lr, cp)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*60)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*60)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*150)
+      f_flake(t, len*0.19244, n-1,  lr, cp)
+      f_flake(t, len*0.192498, n-1, -lr, cp)
+      Left(t,lr*60)
+      f_flake(t, len*0.192498, n-1, -lr, cp)
+      Left(t,lr*60)
+      f_flake(t, len*0.19244, n-1, -lr, cp)
+      Left(t,lr*90)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      Right(t,lr*150)
+      f_flake(t, len*0.19247, n-1,  lr, cp)
+      f_flake(t, len*0.19247, n-1, -lr, cp)
+      Left(t,lr*150)
+      f_flake(t, len*0.333333, n-1, -lr, cp)
+      f_flake(t, len*0.333333, n-1,  lr, cp)
+      }
+   else {
+      if \cp then {
+         angle := dtor(t.direction)
+         p := [t.pos[1]+len*cos(angle), t.pos[2]+len*sin(angle)]
+         DrawConvexClipped(t.win, cp, t.pos, p)
+         t.pos := p
+         }
+      else {
+         Line_Forward(t, len)
+         }
+      }
+
+   return
+end
+ 
+############################################################################
+# Draw a koch curve of order N between two points
+############################################################################
+#
+# Draw a koch curve from A to B
+#
+procedure koch_line(win,A,B,n)
+   local t, direction
+
+   direction := Rel_angle(A,B)
+   t := turtle(win, A, direction)
+   koch(t, direction, distance(A,B), n)
+   return
+end
+#
+# turtle graphics version
+#
+procedure koch(t, dir, len, n)
+
+   if n > 0 then {
+      koch(t, dir, len/3.0, n-1)
+      Left(t,60)
+      koch(t, dir, len/3.0, n-1)
+      Right(t, 120)
+      koch(t, dir, len/3.0, n-1)
+      Left(t,60)
+      koch(t, dir, len/3.0, n-1)
+      }
+   else
+      Line_Forward(t, len)
+
+   return
+end
+
+
+############################################################################
+# Draw a fractal curve between two points
+############################################################################
+#
+#
+#  The parameter 'H' is a 'roughness' factor.  At H=0.5,
+#     you get roughly brownian motion.
+#
+procedure fract_line(win,A,B,H,min_len,std_dev)
+   local len_sq, direction, t, N, f, r, pt, len
+
+   /H := 0.5
+   /min_len := 0.01
+   /std_dev := 0.12
+   len := distance(A,B)
+   direction := Rel_angle(A,B)
+   t := turtle(win, A, direction)
+
+   if len <= min_len then
+      Line_Forward(t, len)
+   else {
+      f := exp((0.5-H)*log(2.0))
+      r := gauss() * std_dev * f
+      N := point()
+      N.x := 0.5*(A[1] + B[1]) - r*(B[2]-A[2]);
+      N.y := 0.5*(A[2] + B[2]) + r*(B[1]-A[1]);
+      fract_line(win, A, N, H, min_len, std_dev)
+      fract_line(win, N, B, H, min_len, std_dev)
+      }
+
+   return
+end
+
+
+
+# Simple drawing primitives
+############################################################################
+
+procedure DrwLine(w,pnts[])	# draw a polyline
+
+   if *pnts < 2 then fail		# ... not enough points
+
+   return DrawLine ! ([w.vp.screen]|||transform_points(pnts,w.xform_mat[1]))
+end
+
+procedure DrawConvexClipped(w,poly,pnts[])	# clip to polygon
+   local i
+
+   if (*pnts < 2) | (*poly < 3) then fail
+
+   every i := 2 to *pnts do {
+      DrwLine ! ([w]|||Convex_clip(poly,pnts[i-1],pnts[i]))
+      }
+      
+   return
+end
+
+procedure DrawPolygon(args[])	# draw a polygon
+
+   return DrwLine ! (args|||[args[2]])
+
+end
+
+procedure FillPolygon(w,pnts[]) # draw a filled polygon
+
+   if *pnts < 2 then fail		# ... not enough points
+
+   return FillPolygon ! ([w.vp.screen]|||
+                          transform_points(pnts|||[pnts[1]],w.xform_mat[1]))
+end
+
+
+
+# Matrix operations
+############################################################################
+
+#   All matrices are stored as lists of lists, and all
+#     operations determine the size of the matrix directly
+#     from the matrix itself
+
+procedure mwrite(m)		# output a matrix (usually for debugging)
+   local r, c, row, col
+
+   r := *m
+   c := *m[1]
+
+   writes("[")
+   every row := 1 to r do {
+      writes("[")
+      every col := 1 to c do {
+         writes(right(m[row][col],6),", ")
+         }
+      write("]")
+      }
+   write("]")
+end
+
+procedure newmat(n,m)		# create a matrix
+   local M
+
+   M := list(n)
+   every !M := list(m)
+
+   return M
+end
+
+procedure Imatrix(n,m)		# Identity matrix
+   local M, r, c
+
+   M := newmat(n,m)
+   every r := 1 to n do {
+      every c := 1 to m do {
+         M[r][c] := if r = c then 1.0 else 0.0
+         }
+      }
+   return M
+end
+
+procedure mmult(m1,m2)		# matrix multiply
+   local m3, r, c, nk, k
+
+   if (nk := *m1[1]) ~= *m2 then stop("Matrices are wrong size to multiply")
+
+   m3 := newmat(*m1,*m2[1])
+   every r := 1 to *m1 do {
+      every c := 1 to *m2[1] do {
+         m3[r][c] := 0.0
+         every k := 1 to nk do {
+             m3[r][c] +:= m1[r][k] * m2[k][c]
+             }
+         }
+      }
+
+   return m3
+end
+
+
+# low-level screen activity
+############################################################################
+
+record viewport(ul, lr, screen)
+record window(ll, ur, vp, xform_mat)
+
+procedure set_window(win, ll, ur, vp)	# construct new graphics window
+   local x_scale, y_scale, x_trans, y_trans, xfrm
+
+   if /vp then {	# make vp the entire 'screen'
+      vp := viewport()
+      vp.ul := [0,0]
+      vp.lr := [numeric(WAttrib(win,"width")), numeric(WAttrib(win,"height"))]
+      vp.screen := win
+      }
+
+   # determine scale and translate factors ...
+   #   (note the strange viewpoint references to get lower left corner)
+   x_scale := real(vp.lr[1]-vp.ul[1]) / (ur[1]-ll[1])
+   y_scale := real(vp.ul[2]-vp.lr[2]) / (ur[2]-ll[2])
+   x_trans := real(vp.ul[1])-(ll[1]*x_scale)
+   y_trans := real(vp.lr[2])-(ll[2]*y_scale)
+
+   # ... and set up the transformation matrix
+   xfrm := [mmult(set_scale(x_scale, y_scale), set_trans(x_trans, y_trans))]
+
+   return window(ll, ur, vp, xfrm)
+end   
+
+procedure change_viewport(window, ul, lr)
+   local x_scale, y_scale, x_trans, y_trans, xfrm
+
+   # determine scale and translate factors ...
+   #   (note the strange viewpoint references to get lower left corner)
+   x_scale := real(lr[1]-ul[1]) / (window.ur[1]-window.ll[1])
+   y_scale := real(ul[2]-lr[2]) / (window.ur[2]-window.ll[2])
+   x_trans := real(ul[1])-(window.ll[1]*x_scale)
+   y_trans := real(lr[2])-(window.ll[2]*y_scale)
+
+   # ... and set up the transformation matrix
+   xfrm := [mmult(set_scale(x_scale, y_scale), set_trans(x_trans, y_trans))]
+
+   window.xform_mat := xfrm
+   window.vp.ul := ul
+   window.vp.lr := lr
+
+   return
+end
+
+
+
+# support.icn -- miscellaneous support routines
+############################################################################
+
+# para -- parametric equation for coordinate between two others
+#
+procedure para(a,b,t)
+   return (1.0-t)*a + t*b
+end
+
+# vpara -- produce a vector that is parametrically between two others
+#
+procedure vpara(v1,v2,t)
+   local v, i
+
+   v := copy(v1)
+   every i := 1 to *v1 do
+      v[i] := para(v1[i],v2[i],t)
+
+   return v
+end
+
+# sleep -- 'sleep' of n seconds (n may be fractional)
+#
+procedure sleep(n)
+   local start
+
+   start := &time
+   while &time <= start+n*1000
+end
+
+procedure round(n,g)
+   return integer((n + g/2.0)/g) * g
+end
+
+# Some nice random functions
+
+# Do a Gaussian distribution about the value 'x'.
+#   The value of 'f' can be used to alter the shape
+#   of the Gaussian distribution (larger values flatten
+#   the curve...)
+
+procedure Gauss_random(x,f)
+   # if 'f' not passed in, default to 1.0
+   /f := 1.0
+   return gauss()*f+x
+end
+
+# Produce a random value within a Gaussian distribution
+#   about 0.0.  (Sum 12 random numbers between 0 and 1,
+#   (expected mean is 6.0) and subtract 6 to center on 0.0
+
+procedure gauss()
+   local v
+
+   v := 0.0
+   every 1 to 12 do v +:= ?0
+   return v-6.0
+end
+
+
+#
+# A simple implementation of 'turtle' graphics for multiple windows
+#   one can have more than one turtle simultaneously active
+#   In a turtle, the color field (if used) must be a co-expressions
+#   that produces the color.  This allows the turtle to change
+#   color as it runs.  In the simplest case, construct the
+#   turtle with a co-expression the repeatedly supplies the
+#   the same color:   create |"red"
+############################################################################
+
+record turtle(win,pos,direction,color)
+
+procedure moveto(t,p)
+   return t.pos := p
+end
+
+procedure lineto(t,p)
+   Fg(t.win.vp.screen, \@\(t.color))
+   DrwLine(t.win, t.pos, p)
+   return t.pos := p
+end
+
+procedure moverel(t, displacement)
+   return moveto(t, add_vectors(t.pos, displacement))
+end
+
+procedure drawrel(t, displacement)
+   return lineto(t, add_vectors(t.pos, displacement))
+end
+
+procedure Line_Forward(t, dist)
+   local angle, p
+
+   angle := dtor(t.direction)
+   p := [t.pos[1]+dist*cos(angle), t.pos[2]+dist*sin(angle)]
+   return lineto(t, p)
+end
+
+procedure Move_Forward(t, dist)
+   local angle, p
+
+   angle := dtor(t.direction)
+   p := [t.pos[1]+dist*cos(angle), t.pos[2]+dist*sin(angle)]
+   return moveto(t, p)
+end
+
+procedure Right(t, angle)
+   return t.direction -:= angle
+end
+
+procedure Left(t, angle)
+   return t.direction +:= angle
+end
+
+
+
+# Some vector operations
+############################################################################
+
+procedure add_vectors(v1,v2)
+   local v3, i
+
+   if *v1 ~= *v2 then stop("cannot add vectors of differing sizes")
+
+   v3 := copy(v1)
+   every i := 1 to *v3 do
+      v3[i] := v1[i]+v2[i]
+
+   return v3
+end
+
+procedure sub_vectors(v1,v2)
+   local v3, i
+
+   if *v1 ~= *v2 then stop("cannot subtract vectors of differing sizes")
+
+   v3 := copy(v1)
+   every i := 1 to *v3 do
+      v3[i] := v1[i]-v2[i]
+
+   return v3
+end
+
+procedure scale_vector(s,a)
+   local v, i
+
+   v := copy(a)
+   every i := 1 to *v do
+      v[i] *:= s
+
+   return v
+end
+
+procedure len_vector(v)
+   local sum_sq
+
+   sum_sq := 0
+   every sum_sq +:= (!v)^2
+   return sqrt(sum_sq)
+end
+
+procedure unit_vector(v)
+   return scale_vector(1.0/len_vector(v), v)
+end
+
+procedure dot(v1,v2)
+   local sum, i
+
+   if *v1 ~= *v2 then stop("dot product: vectors of differing sizes")
+   sum := 0
+   every i := 1 to *v1 do
+      sum +:= v1[i]*v2[i]
+   return sum
+end
+
+procedure angle_vectors(v1,v2)
+   return rtod(acos(dot(unit_vector(v1),unit_vector(v2))))
+end
+
+procedure normal_vector(v)
+   local n
+
+   n := copy(v)
+   n[1] := v[2]
+   n[2] := -v[1]
+   return n
+end
+
+#
+# The following are special cases for points...
+#
+
+procedure make_vector(p1,p2)
+   return sub_vectors(p2,p1)
+end
+
+procedure distance(p1,p2)
+   return len_vector(sub_vectors(p2,p1))
+end
+
+procedure Rel_angle(A,B)
+   # get angle of line through points A and B (2D only!)
+   local rise, run
+
+   rise := B[2]-A[2]
+   run  := B[1]-A[1]
+
+   return rtod(atan(rise, run))
+end
+
+procedure normal_line(p1,p2)
+	# return a normal to a line
+   return normal_vector(make_vector(p1,p2))
+end
+
+procedure inside_line(P,L,n)
+	# is P inside line passing through L with normal n?
+   return 0 <= dot(sub_vectors(P,L),n)
+end
+
+
+
+# Transformation operations
+############################################################################
+
+procedure transform(p,M)
+   local pl, i
+
+	# convert p to a matrix for matrix multiply...
+   every put((pl := [[]])[1], (!p)|1.0)	# the 1.0 makes it homogeneous
+
+	# do the conversion...
+   pl := mmult(pl, M)
+
+	# convert list back to a point...
+   p := copy(p)
+   every i := 1 to *p do
+      p[i] := pl[1][i]
+
+   return p
+end
+
+procedure transform_points(pl,M)
+   local xformed
+
+   every put(xformed := [], !transform(!pl,M))
+   return xformed
+end
+   
+procedure set_scale(x,y,z)	# set up an Xform matrix for scaling
+   local M
+
+   M := if /z then Imatrix(3,3)
+              else Imatrix(4,4)
+
+   M[1][1] := x
+   M[2][2] := y
+   M[3][3] := \z
+
+   return M
+end
+
+procedure set_trans(x,y,z)	# set up an Xform matrix for translation
+   local M
+
+   M := if /z then Imatrix(3,3)
+              else Imatrix(4,4)
+
+   M[*M][1] := x
+   M[*M][2] := y
+   M[*M][3] := \z
+
+   return M
+end
+
+procedure set_rotate(x,y,z)	# set up an Xform matrix for rotation
+   local X, Y, Z
+
+   if /y & /z then {	# 2-D rotation
+      X := Imatrix(3,3)
+      X[1][1] := cos(x)
+      X[2][2] := X[1][1]
+      X[1][2] := sin(x)
+      X[2][1] := -X[1][2]
+      return X
+      }
+
+   X := Imatrix(4,4)
+   X[2][2] := cos(x)
+   X[3][3] := X[2][2]
+   X[2][3] := sin(x)
+   X[3][2] := -X[2][3]
+
+   Y := Imatrix(4,4)
+   Y[1][1] := cos(y)
+   Y[3][3] := Y[1][1]
+   Y[3][1] := sin(y)
+   Y[1][3] := -Y[3][1]
+
+   Z := Imatrix(4,4)
+   Z[1][1] := cos(z)
+   Z[2][2] := Z[2][2]
+   Z[1][2] := sin(z)
+   Z[2][1] := -Z[1][2]
+
+   return mmult(X,mmult(Y,Z))
+end
+
+#
+# Generalized parametric curve drawing routine, using turtle t
+#
+procedure draw_curve(t,x,xa,y,ya,t1,t2,N)
+   local incr, t0
+
+   /t1 := 0.0
+   /t2 := 1.0
+   /N  := 500
+
+   incr := (t2-t1)/(N-1)
+
+   t0 := t1
+   moveto(t, point( x!([t0]|||xa), y!([t0]|||ya)))
+   every 1 to N-1 do {
+      t0 +:= incr
+      lineto(t, point( x!([t0]|||xa), y!([t0]|||ya)))
+      }
+
+end
diff --git a/ipl/gprocs/gpxlib.icn b/ipl/gprocs/gpxlib.icn
new file mode 100644
index 0000000..7c994c9
--- /dev/null
+++ b/ipl/gprocs/gpxlib.icn
@@ -0,0 +1,130 @@
+############################################################################
+#
+#	File:     gpxlib.icn
+#
+#	Subject:  Procedures for graphics tasks
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 21, 1998
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	This file contains a few eclectic graphics procedures.
+#
+#	ScratchCanvas(w, h, id)	  creates a temporary, hidden window.
+#
+#	PushWin(L)		  adds a default window to an argument list.
+#
+#	Distance(x1, y1, x2, y2)  computes the distance between two points.
+#
+#	InBounds(x, y, w, h)	  succeeds if (&x,&y) is within (x,y,w,h).
+#
+############################################################################
+#
+#   The following procedure allows an additional first argument
+#   specifying a window to use instead of &window:
+#
+#   ScratchCanvas(w, h, id) returns a hidden-canvas window for temporary
+#   use.  The same scratch window (per display) is returned by successive
+#   calls with the same ID, avoiding the cost of creation.  The size is
+#   guaranteed to be at least (w, h), which default to the size of the
+#   window.  The scratch window must not be closed by the caller, but an
+#   EraseArea can be done to reclaim any allocated colors.
+#
+############################################################################
+#
+#   The following procedures do not accept a window argument:
+#
+#   PushWin(L) pushes &window onto the front of list L if the first
+#   element of the list is not a window.  This aids in constructing
+#   variable-argument procedures with an optional window argument.
+#
+#   Distance(x1, y1, x2, y2) returns the distance between two points
+#   as a real number.
+#
+#   InBounds(x, y, w, h) checks whether &x and &y are within the given
+#   region:  it returns &null if x <= &x <= x+w and y <= &y <= y+h,
+#   and fails otherwise.
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link wopen
+
+
+#   PushWin(L) -- push &window on list if no window already there.
+
+procedure PushWin(a)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if not (type(a[1]) == "window") then
+      push(a, &window)
+   return a
+end
+
+
+#   Distance(x1, y1, x2, y2) -- compute distance between two points.
+
+procedure Distance(x1, y1, x2, y2)		#: distance between two points
+   x1 -:= x2
+   y1 -:= y2
+   return sqrt(x1 * x1 + y1 * y1)
+end
+
+
+#   InBounds(x, y, w, h) -- succeed if (&x,&y) is in a rectangular area.
+
+procedure InBounds(x, y, w, h)			#: check point within rectangle
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+   return (x <= &x <= x + w) & (y <= &y <= y + h) & &null
+end
+
+
+#  ScratchCanvas([win,] w, h, id) -- return hidden window for temporary use.
+
+procedure ScratchCanvas(win, w, h, id)		#: return scratch canvas
+   local d, s
+   static dpytab, type
+
+   initial {
+      dpytab := table()
+      type := proc("type", 0)	# protect attractive name
+      }
+
+   if type(win) ~== "window" then {
+      win :=: w :=: h :=: id
+      win := &window
+      }
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+   w <:= 100				# if too teeny, can't open
+   h <:= 100
+
+   d := WAttrib(win, "display")
+   s := d || "," || image(id)
+   /dpytab[s] := WOpen("width=" || w, "height=" || h, "canvas=hidden",
+      "display=" || d)
+   win := dpytab[s]
+   if /win then
+      fail
+   if WAttrib(win, "width") < w | WAttrib(win, "height") < h then
+      WAttrib(win, "width=" || w, "height=" || h)
+   return win
+end
diff --git a/ipl/gprocs/gpxop.icn b/ipl/gprocs/gpxop.icn
new file mode 100644
index 0000000..5767868
--- /dev/null
+++ b/ipl/gprocs/gpxop.icn
@@ -0,0 +1,314 @@
+############################################################################
+#
+#	File:     gpxop.icn
+#
+#	Subject:  Procedures for graphics operations
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 26, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	This file contains some graphics procedures.
+#
+#	LeftString(x, y, s)	  draws a string left-aligned at (x, y).
+#
+#	CenterString(x, y, s)	  draws a string centered at (x, y).
+#
+#	RightString(x, y, s)	  draws a string right-aligned at (x, y).
+#
+#	ClearOutline(x, y, w, h)  draws a rectangle, erasing its interior.
+#
+#	Translate(dx, dy, w, h)	  moves the window origin and optionally
+#				  sets the clipping region.
+#
+#	Zoom(x1, y1, w1, h1, x2, y2, w2, h2)
+#				  copies and distorts a rectangle.
+#
+#	Capture(p, x, y, w, h)	  converts a window area to an image string.
+#
+#	Sweep()			  lets the user select a rectangular area.
+#
+############################################################################
+#
+#  LeftString(x, y, s), CenterString(x, y, s), and RightString(x, y, s)
+#  draw a string centered vertically about y and left-justified,
+#  centered, or right-justified about x.
+#
+#  ClearOutline(x, y, w, h) draws a rectangle in the foreground color
+#  and fills it with the background color.
+#
+#  Translate(dx, dy, w, h) adjusts a window's dx and dy attributes by
+#  the values given.  Note that the resulting attribute values are the
+#  sums of the existing values with the parameters, so that successive
+#  translations accumulate.  If w and h are supplied, the clipping
+#  region is set to a rectangle of size (w, h) at the new origin.
+#
+#  Zoom(x1, y1, w1, h1, x2, y2, w2, h2) is a distorting variation of
+#  CopyArea that can be used to shrink or enlarge a rectangular area.
+#  Zero, one, or two window arguments can be supplied.  Rectangle 1 is
+#  copied to fill rectangle 2 using simple pixel sampling and replication.
+#  The rectangles can overlap.  The usual defaults apply for both rectangles.
+#
+#  Sweep() lets the user select a rectangular area using the mouse.
+#  Called when a mouse button is pressed, Sweep handles all subsequent
+#  events until a mouse button is released.  As the mouse moves, a
+#  reverse-mode outline rectangle indicates the selected area.  The
+#  pixels underneath the rectangle outline are considered part of this
+#  rectangle, implying a minimum width/height of 1, and the rectangle
+#  is clipped to the window  boundary.  Sweep returns a list of four
+#  integers [x,y,w,h] giving the rectangle bounds in canonical form
+#  (w and h always positive).  Note that w and h give the width as
+#  measured in FillRectangle terms (number of pixels included) rather
+#  than DrawRectangle terms (coordinate difference).
+#
+#  Capture(palette, x, y, w, h) converts a window region into an
+#  image string using the specified palette, and returns the string.
+#
+#  These procedures all accept an optional initial window argument.
+#
+############################################################################
+#
+#  Links: gpxlib
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link gpxlib
+
+
+#   LeftString(x, y, s) -- draw string left-justified at (x,y).
+
+procedure LeftString(win, x, y, s)		#: draw left-justified string
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: s
+      win := &window
+      }
+   y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2 + 1
+   return DrawString(win, x, y, s)
+end
+
+
+#   CenterString(x, y, s) -- draw string centered about (x,y).
+
+procedure CenterString(win, x, y, s)		#: draw centered string
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: s
+      win := &window
+      }
+   x -:= TextWidth(win, s) / 2
+   y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2 + 1
+   return DrawString(win, x, y, s)
+end
+
+
+#   RightString(x, y, s) -- draw string right-justified at (x,y).
+
+procedure RightString(win, x, y, s)		#: draw right-justified string
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: s
+      win := &window
+      }
+   x -:= TextWidth(win, s)
+   y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2 + 1
+   return DrawString(win, x, y, s)
+end
+
+
+#   ClearOutline(x, y, w, h) -- draw rectangle and fill background.
+
+procedure ClearOutline(win, x, y, w, h)		#: draw and clear rectangle
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   DrawRectangle(win, x, y, w, h)
+   EraseArea(win, x+1, y+1, w-1, h-1)
+   return win
+end
+
+
+#   Translate(dx, dy, w, h) -- add translation and possibly clipping.
+
+procedure Translate(win, dx, dy, w, h)		#: add translation
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if type(win) ~== "window" then {
+      win :=: dx :=: dy :=: w :=: h
+      win := &window
+      }
+   WAttrib(win, "dx=" || WAttrib(win,"dx")+dx, "dy=" || WAttrib(win,"dy")+dy)
+   Clip(win, 0, 0, \w, \h)
+   return win
+end
+
+
+#  Sweep() -- sweep out area with mouse, return bounds
+
+procedure Sweep(win)				#: sweep area with mouse
+   local x, y, w, h, wmin, wmax, hmin, hmax
+
+   /win := &window
+   win := Clone(win, "drawop=reverse")
+
+   x := &x					# set initial rect bounds
+   y := &y
+   w := h := 0
+
+   wmin := -WAttrib(win, "dx") - x		# calc coordinate limits
+   hmin := -WAttrib(win, "dy") - y
+   wmax := wmin + WAttrib(win, "width") - 1
+   hmax := hmin + WAttrib(win, "height") - 1
+
+   DrawRectangle(win, x, y, w, h)		# draw initial bounding rect
+   until Event(win) === (&lrelease | &mrelease | &rrelease) do {
+      DrawRectangle(win, x, y, w, h)		# erase old bounds
+      w := &x - x				# calc new width & height
+      h := &y - y
+      w <:= wmin				# clip to stay on window
+      w >:= wmax
+      h <:= hmin
+      h >:= hmax
+      DrawRectangle(win, x, y, w, h)		# draw new bounds
+      }
+   DrawRectangle(win, x, y, w, h)		# erase bounding rectangle
+
+   if w < 0 then x -:= (w := -w)		# ensure nonnegative sizes
+   if h < 0 then y -:= (h := -h)
+
+   Uncouple(win)
+   return [x, y, w + 1, h + 1]			# return FillRectangle bounds
+end
+
+
+#  Zoom(win1, win2, x1, y1, w1, h1, x2, y2, w2, h2) -- copy and distort.
+
+procedure Zoom(args[])				#: zoom image
+   local win1, x1, y1, w1, h1
+   local win2, x2, y2, w2, h2
+   local x, y, scr
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(args[1]) == "window" then
+      win1 := get(args)
+   else
+      win1 := \&window | runerr(140, &window)
+   if type(args[1]) == "window" then
+      win2 := get(args)
+   else
+      win2 := win1
+
+   x1 := \get(args) | -WAttrib(win1, "dx")
+   y1 := \get(args) | -WAttrib(win1, "dy")
+   w1 := \get(args) | WAttrib(win1, "width") - (x1 + WAttrib(win1, "dx"))
+   h1 := \get(args) | WAttrib(win1, "height") - (y1 + WAttrib(win1, "dy"))
+   if w1 < 0 then
+      x1 -:= (w1 := -w1)
+   if h1 < 0 then
+      y1 -:= (h1 := -h1)
+
+   x2 := \get(args) | -WAttrib(win2, "dx")
+   y2 := \get(args) | -WAttrib(win2, "dy")
+   w2 := \get(args) | WAttrib(win2, "width") - (x2 + WAttrib(win2, "dx"))
+   h2 := \get(args) | WAttrib(win2, "height") - (y2 + WAttrib(win2, "dy"))
+   if w2 < 0 then
+      x2 -:= (w2 := -w2)
+   if h2 < 0 then
+      y2 -:= (h2 := -h2)
+
+   if w1 = 0 | w2 = 0 | h1 = 0 | h2 = 0 then
+      return
+
+   scr := ScratchCanvas(win2, w2, h1, "__Zoom__") | fail
+   every x := 0 to w2 - 1 do
+      CopyArea(win1, scr, x1 + w1 * ((x + 0.5) / w2), y1, 1, h1, x, 0)
+   every y := 0 to h2 - 1 do
+      CopyArea(scr, win2, 0, h1 * ((y + 0.5) / h2), w2, 1, x2, y2 + y)
+
+   EraseArea(scr)		# release colors
+   return win1
+end
+
+
+#  Capture(win, pal, x, y, w, h) -- capture screen region as image string
+
+$define CaptureChunk 100
+
+procedure Capture(win, pal, x, y, w, h)		#: capture image as string
+   local a, c, k, s, t, cmap
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then {
+      win :=: pal :=: x :=: y :=: w :=: h
+      win := \&window | runerr(140, &window)
+      }
+
+   /pal := "c1"
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   PaletteChars(win, pal) | runerr(205, pal)
+
+   cmap := table()
+
+   # accumulate the image in chunks and then concatenate
+   # (much faster than concatenating single chars on a very long string)
+   s := ""
+   a := []
+   every k := Pixel(win, x, y, w, h) do {
+      c := \cmap[k] | (cmap[k] := PaletteKey(win, pal, k))
+      if *(s ||:= c) >= CaptureChunk then {
+         put(a, s)
+         s := ""
+         }
+      }
+   put(a, s)
+
+   s := w || "," || pal || ","
+   while s ||:= get(a)
+   return s
+end
diff --git a/ipl/gprocs/graphics.icn b/ipl/gprocs/graphics.icn
new file mode 100644
index 0000000..66cd20d
--- /dev/null
+++ b/ipl/gprocs/graphics.icn
@@ -0,0 +1,34 @@
+############################################################################
+#
+#	File:     graphics.icn
+#
+#	Subject:  Procedures for graphics
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 4, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links to core subset of graphics procedures.
+#
+############################################################################
+#
+#  Links: bevel, color, dialog, enqueue, gpxop, gpxlib,
+#     vidgets, window, wopen
+#
+############################################################################
+
+link bevel
+link color
+link dialog
+link enqueue
+link gpxop
+link gpxlib
+link vidgets	# basic set needed by Dialog() and Vset()
+link window
+link wopen
diff --git a/ipl/gprocs/grecords.icn b/ipl/gprocs/grecords.icn
new file mode 100644
index 0000000..612c1fe
--- /dev/null
+++ b/ipl/gprocs/grecords.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     grecords.icn
+#
+#	Subject:  Declarations for graphics
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 27, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These declarations are used in procedures that manipulate objects
+#  in two- and three-dimensional space.
+#
+############################################################################
+
+record point2(x, y)
+
+record vector2(x, y)
+
+record box2(p2min, p2max)
+
+record point3(x, y, z)
+
+record vector3(x, y, z)
+
+record box3(p3min, p3max)
+
+record rect(x, y, w, h)
+
+record line(x1, y1, x2, y2)
diff --git a/ipl/gprocs/gtrace.icn b/ipl/gprocs/gtrace.icn
new file mode 100644
index 0000000..7e10c85
--- /dev/null
+++ b/ipl/gprocs/gtrace.icn
@@ -0,0 +1,203 @@
+############################################################################
+#
+#	File:     gtrace.icn
+#
+#	Subject:  Procedures to process graphic traces
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  As used here, the term "trace" refers to a sequence of points that
+#  generally consists of locations on a curve or other geometrical object.
+#  These procedures process such traces in various ways.
+#
+############################################################################
+#
+#  See also:  gtraces.doc
+#
+############################################################################
+#
+#  Links:  calls, numbers, gobject
+#
+############################################################################
+
+link calls
+link numbers
+link gobject
+
+#  list_coords(call) lists the coordinates of the trace produced by
+#  invoke(call)
+
+procedure list_coords(call, p, w)
+   local point
+
+   /p := 6
+   /w := 20
+
+   every point := invoke(call) do
+      write(decipos(point.x, p, w), decipos(point.y, p, w))
+
+end
+
+#
+#  point_list(call, i) returns a list of the points in the trace produced
+#  by invoke(call).  If i is nonnull, the list is limited to i points.
+
+procedure point_list(call, i)
+   local plist
+
+   plist := []
+
+   if \i then {
+      every put(plist, invoke(call)) \ i
+      }
+   else {
+      every put(plist, invoke(call))
+      }
+
+   return plist
+
+end
+
+#
+#  coord_list(call, i) returns a list of the x,y coordinates in the trace
+#  produced by invoke(call).  If i is nonnull, the list is limited
+#  to i points.
+
+procedure coord_list(call, limit)
+   local clist
+
+   clist := []
+
+   if \limit then {
+      every put(clist, !(invoke(call))) \ (limit * 2)
+      }
+   else {
+      every put(clist, !(invoke(call)))
+      }
+
+   return clist
+
+end
+
+#  read_trace(f) produces a trace from the coordinate file f
+
+procedure read_trace(f)
+   local line
+   static schar
+
+   initial schar := &digits ++ '.'
+
+   while line := read(f) do
+      line ? {
+         suspend Point(
+            tab(upto(schar)) & tab(many(schar)),
+            tab(upto(schar)) & tab(many(schar))
+            )
+         }
+
+end
+
+#  write_trace(header, call) writes a trace file from the trace of call.
+
+procedure write_trace(header, call)
+   local point
+
+   write(header, ":")
+
+   every point := invoke(call) do
+      write(point.x, " ", point.y)
+
+end
+
+#  compose_trace(call_1, call_2) composes the trace for call_1 with the
+#  trace for call_2; that is, the trace for call_1 is passed through
+#  call_2.  For example, if call_1 traces a circle and call_2 draws a
+#  star, the result is a star on each point of the circle.
+#
+#  The procedure assumes that the first two arguments to call_2 are
+#  the x and y coordinates of the point in which it is interested
+#  (standard trace format).
+
+procedure compose_trace(trace, call_1, call_2)
+   local point
+
+   every point := invoke(call_1) do {
+      call_2.args[1] := point.x		# set the origin for call_2
+      call_2.args[2] := point.y
+      suspend invoke(call_2)
+      }
+
+end
+
+#  tcompress(call, i) discards all but the ith points on the trace
+#  produced by call.  The first point of the trace is the first
+#  point of the trace produced by calls.
+
+procedure tcompress(call, i)
+   local j, point
+
+   j := 0
+
+   every point := invoke(call) do {
+      if j % i = 0 then suspend point
+      i +:= 1
+      }
+
+end
+
+#  interp_call(call) inserts a point midway on a line between every two points
+#  on the trace produced by call.
+
+procedure interp_trace(call)
+   local point, last_point
+
+   every point := invoke(call) do {
+      if \last_point then {
+         suspend last_point
+         suspend Point(
+            (point.x - last_point.x) / 2,
+            (point.y - last_point.y) / 2
+            )
+         }
+      last_point := point
+      }
+
+   suspend last_point
+
+end
+
+#  coord2point(cl) creates a list of points from a list of coordinates.
+#  It destroys cl.
+
+procedure coord2point(cl)
+   local pl
+
+   pl := []
+
+   while put(pl, Point(get(cl), get(cl)))
+
+   return pl
+
+end
+
+#  point2coord(pl) creates a list of coordinates from a list of points.
+#  It does not destroy pl.
+
+procedure point2coord(pl)
+   local cl
+
+   cl := []
+
+   every put(cl, !!pl)
+
+   return cl
+
+end
diff --git a/ipl/gprocs/ifg.icn b/ipl/gprocs/ifg.icn
new file mode 100644
index 0000000..433f68f
--- /dev/null
+++ b/ipl/gprocs/ifg.icn
@@ -0,0 +1,33 @@
+############################################################################
+#
+#	File:     ifg.icn
+#
+#	Subject:  Procedure to tell if graphics are running
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 14 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  ifg() fails if (a) the running version of Icon does not support
+#  graphics, or (b) if it is, the graphics system is not running.
+#
+############################################################################
+
+procedure ifg()
+   local win
+
+   if (&features == "graphics") &
+      win := open("", "x", "canvas=hidden") then {
+         close(win)
+         return
+         }
+      
+   else fail
+
+end
diff --git a/ipl/gprocs/imagedim.icn b/ipl/gprocs/imagedim.icn
new file mode 100644
index 0000000..3b5a718
--- /dev/null
+++ b/ipl/gprocs/imagedim.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     imagedim.icn
+#
+#	Subject:  Procedures for getting image dimensions
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  imagedim(s) returns a record that contains the type and dimensions of an 
+#  image named s.
+#
+#  The assumptions about image formats are naive.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record idim(type, w, h)
+
+procedure imagedim(s)
+   local Image, line, dim
+
+   Image := open(s) | stop("*** cannot open ", s)
+
+   line := read(Image) | idim_bad()
+   line ? {
+      if tab(find("width") + 6) then {
+         dim := idim("xbm")
+         dim.w := integer(tab(0)) | idim_bad()
+         read(Image) ? {
+            tab(find("height") + 7) | idim_bad()
+            dim.h := integer(tab(0)) | idim_bad()
+            } | idim_bad()
+         }
+      else if find("XPM") then {
+         dim := idim("xpm")
+         read(Image) | idim_bad()
+
+         read(Image) ? {
+            ="\"" & dim.w := integer(tab(many(&digits))) &
+              =" " & dim.h := integer(tab(many(&digits)))
+            } | idim_bad()
+         }
+      }
+
+#  close(Image)
+
+   return dim
+
+end
+
+procedure idim_bad()
+   stop("*** bad image data")
+end
diff --git a/ipl/gprocs/imageseq.icn b/ipl/gprocs/imageseq.icn
new file mode 100644
index 0000000..ba42ff6
--- /dev/null
+++ b/ipl/gprocs/imageseq.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     imageseq.icn
+#
+#	Subject:  Procedure to write sequences of images
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures provide help for applications that write sequences
+#  of images.
+#
+#  seq_init(opts) initializes the naming parameters from the table opts.
+#  opts["n"] is the name, opts["f"] is the first number, and opts["c"]
+#  is the number of columns for the serial number.
+#
+#  save_image(win, x, y, w, h) write the specified area of win using the
+#  next name in sequence.  There is no check for duplicate names if the
+#  numbering wraps around.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics 
+#
+############################################################################
+
+global prefix__				# hope for no collisions
+global count__
+global width__
+
+procedure seq_init(opts)
+
+   prefix__ := if /opts | /opts["n"] then "image" else opts["n"]
+   count__ := if /opts | /opts["f"] then 0 else opts["f"] - 1
+   width__ := if /opts | /opts["c"] then 3 else opts["c"]
+
+   return
+
+end
+
+procedure save_image(win, x, y, w, h)
+
+   initial seq_init(/prefix__)		# initialize if prefix__ null.
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   return WriteImage(win, prefix__ || right(count__ +:= 1, width__, "0") ||
+      ".gif", x, y, w, h)
+
+end
diff --git a/ipl/gprocs/imgcolor.icn b/ipl/gprocs/imgcolor.icn
new file mode 100644
index 0000000..39bba90
--- /dev/null
+++ b/ipl/gprocs/imgcolor.icn
@@ -0,0 +1,36 @@
+############################################################################
+#
+#	File:     imgcolor.icn
+#
+#	Subject:  Procedure to produce table of colors in area
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 5, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#   This procedure produces a table of all the colors in a specified
+#   area of a window.  The value corresponding to a color key is
+#   the number of pixels with that color
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure imgcolor(win, x, y, w, h)
+   local colors
+
+   colors := table(0)
+
+   every colors[Pixel(win, x, y, w, h)] +:= 1
+
+   return colors
+
+end
diff --git a/ipl/gprocs/imrutils.icn b/ipl/gprocs/imrutils.icn
new file mode 100644
index 0000000..97b8c34
--- /dev/null
+++ b/ipl/gprocs/imrutils.icn
@@ -0,0 +1,332 @@
+############################################################################
+#
+#	File:     imrutils.icn
+#
+#	Subject:  Procedures to deal with image records
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Procedures to manipulate image strings as records.  
+#
+#	imrcath(imr1, imr2)
+#			concatenates imr1 and imr2 horizontally
+#
+#	imrcatv(imr1, imr2)
+#			concatenates imr1 and imr2 vertically
+#
+#	imrcopy(imr)	create copy of imr
+#
+#	imrdraw(win, x, y, imr)
+#			draws an image record
+#
+#	imrfliph(imr)	flips an image record horizontally
+#
+#	imrflipv(imr)	flips an image record vertically
+#
+#	imrnegative(imr)
+#			produces "negative" of image; intended for
+#			grayscale palettes
+#
+#	imropen(imr)	opens a hidden window with an image record
+#
+#	imror(imr)	forms inclusive "or" of two images
+#
+#	imrpshift(imr, ir)
+#			shifts colors by mapping rotated palette
+#
+#	imrrot180(imr)
+#			rotates an image record 180 degrees
+#
+#	imrrot90cw(imr)
+#			rotates an image record 90 degrees clockwise
+#
+#	imrshifth(imr, i)
+#			shifts an image record horizontally by i pixels
+#			with wrap-around; positive i to the right,
+#			negative to the left.
+#
+#	imrshiftv(imr, i)
+#			shifts an image record vertically by i pixels
+#			with wrap-around; positive i to the top,
+#			negative to the bottom.
+#
+#	imstoimr(s)	converts an image string to an image record
+#
+#	imrtoims(imr)	converts an image record to an image string
+#
+#  Note:  All the procedures that produce image records modify their
+#  argument records; they do not return modified copies.
+#
+############################################################################
+#
+#  Possible additions:
+#
+#	Make stripes from one (or more) rows/columns.
+#
+#	Convert from one palette to another.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  strings, wopen
+#
+############################################################################
+
+link strings
+link wopen
+
+record ImageRecord(width, palette, pixels)
+
+procedure imrcath(imr1, imr2)	#: horizontally concatenate image records
+   local imr, i, rows1, rows2
+
+   if *imr1.pixels / imr1.width ~= *imr2.pixels / imr2.width then fail
+   if imr1.palette ~== imr2.palette then fail
+
+   imr := ImageRecord()
+   imr.width := imr1.width + imr2.width
+   imr.palette := imr1.palette
+
+   rows1 := []
+
+   imr1.pixels ? {
+      while put(rows1, move(imr1.width))
+      }
+
+   rows2 := []
+
+   imr2.pixels ? {
+      while put(rows2, move(imr2.width))
+      }
+
+   imr.pixels := ""
+
+   every i := 1 to *rows1 do
+      imr.pixels ||:= rows1[i] || rows2[i]
+
+   return imr
+
+end
+
+procedure imrcatv(imr1, imr2)		#: vertically concatenate image records
+   local imr
+
+   if imr1.width ~= imr2.width then fail
+   if imr1.palette ~== imr2.palette then fail
+
+   imr := ImageRecord()
+   imr.width := imr1.width
+   imr.palette := imr1.palette		# CHECK
+   imr.pixels := imr1.pixels || imr2.pixels
+
+   return imr
+
+end
+
+procedure imrcopy(imr)
+
+   return copy(imr)
+
+end
+
+procedure imrdraw(win, x, y, imr)	#: draw image record
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: imr
+      win := \&window | runerr(140, &window)
+      }
+
+   /x := 0
+   /y := 0
+
+   return DrawImage(win, x, y, imrtoims(imr))
+
+end
+
+procedure imrflipd(imr)			#: flip image record diagonally
+   local height, columns, i, row
+
+   height := *imr.pixels / imr.width
+   columns := list(height, "")
+
+   imr.pixels ? {
+      while row := move(imr.width) do
+         every i := 1 to imr.width do
+            columns[i] ||:= row[i]
+      }
+
+   imr.pixels := ""
+
+   every imr.pixels ||:= !columns
+
+   imr.width := height
+
+   return imr
+
+end
+
+procedure imrfliph(imr)			#: flip image record horizontally
+   local pixels
+
+   pixels := ""
+
+   imr.pixels ? {
+      while pixels ||:= reverse(move(imr.width))
+      }
+
+   imr.pixels := pixels
+
+   return imr
+
+end
+
+procedure imrflipv(imr)			#: flip image record vertically
+   local pixels
+
+   pixels := ""
+
+   imr.pixels ? {
+      while pixels := move(imr.width) || pixels
+      }
+
+   imr.pixels := pixels
+
+   return imr
+
+end
+
+procedure imrnegative(imr)		#: form negative of image record
+   local chars
+
+   chars := PaletteChars(imr.palette)
+
+   imr.pixels := map(imr.pixels, chars, reverse(chars))
+
+   return imr
+
+end
+
+procedure imropen(imr)			#: open window with image record
+   local win
+
+   win := WOpen("canvas=hidden","size=" || imr.width || "," ||
+      *imr.pixels / imr.width)
+
+   imrdraw(win, 0, 0, imr) | {
+      WClose(win)
+      fail
+      }
+
+   return win
+   
+end
+
+procedure imrpshift(imr, i)		#: map shifted palette
+   local chars
+
+   chars := PaletteChars(imr.palette)
+
+   imr.pixels := map(imr.pixels, chars, rotate(chars, i))
+
+   return imr
+
+end
+
+procedure imrrot180(imr)		#: rotate image record 180 degrees
+
+   imr.pixels := reverse(imr.pixels)
+
+   return imr
+
+end
+
+procedure imrrot90cw(imr)		#: rotate image record 90 deg. clockwise
+   local height, columns, i, row
+
+   height := *imr.pixels / imr.width
+   columns := list(imr.width, "")
+
+   imr.pixels ? {
+      while row := move(imr.width) do
+         every i := 1 to imr.width do
+            columns[i] := row[i] || columns[i]
+      }
+
+   imr.pixels := ""
+
+   every imr.pixels ||:= !columns
+
+   imr.width := height
+
+   return imr
+
+end
+
+#  Note:  Since shifted out pixels enter in the top or bottom row, depending
+#  on the direction of the shift, one full pass over the width raises the
+#  image one pixel.
+
+procedure imrshifth(imr, i)		#: shift image record horizontally
+
+   imr.pixels := rotate(imr.pixels, i)
+
+   return imr
+
+end
+
+#  See note on imrshifth()
+
+procedure imrshiftv(imr, i)		#: shift image record vertically
+
+   /i := 1
+
+   imr.pixels := rotate(imr.pixels, i * imr.width)
+
+   return imr
+
+end
+
+procedure imrtoims(imr)			#: convert image record to image string
+
+   return imr.width || "," || imr.palette || "," || imr.pixels
+
+end
+
+procedure imstoimr(s)			#: convert image string to image record
+   local imr
+
+   imr := ImageRecord()
+
+   s ? {
+      imr.width := tab(upto(',')) | fail
+      move(1)
+      imr.palette := tab(upto(',')) | fail
+      move(1)
+      imr.pixels := tab(0)
+      }
+
+   return imr
+
+end
+
+procedure imror(imr)			#: form inclusive "or" of two images
+   local chars
+
+   chars := PaletteChars(imr.palette)
+
+   imr.pixels := map(imr.pixels, chars, reverse(chars))
+
+   return imr
+
+end
diff --git a/ipl/gprocs/imscanon.icn b/ipl/gprocs/imscanon.icn
new file mode 100644
index 0000000..2c1c16f
--- /dev/null
+++ b/ipl/gprocs/imscanon.icn
@@ -0,0 +1,61 @@
+############################################################################
+#
+#	File:     imscanon.icn
+#
+#	Subject:  Procedure to put bi-level image string in canonical form
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 6, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure puts a bi-level image string in canonical form so
+#  that duplicates up to shifting can be eliminated.  It is intended to
+#  be used in imlreduc.icn, which handles the rotational case.
+#
+#  It presently only handles widths that are a multiple of four.
+#
+############################################################################
+#
+#  Requires:  Large integers
+#
+############################################################################
+#
+#  Links:  strings
+#
+############################################################################
+
+link strings
+
+procedure imscanon(ims)
+   local head, spec, dspec, max, val, imax, i, width
+
+   ims ? {
+      head := tab(upto('#~') + 1)
+      spec := tab(0)
+      }
+
+   head ? {
+      width := tab(many(&digits))
+      }
+
+   if (width % 4) ~= 0 then return ims		# one digit for 4 columns
+   width /:= 4
+   if (*spec % width) ~= 0 then return ims	# must be even number of digits
+
+   dspec := spec || spec
+   max := -1
+   every i := 1 to (*spec / width) do {
+      val := integer("16r" || dspec[1 +: *spec])
+      if max <:= val then imax := (((i - 1) * width) + 1)
+      dspec := rotate(dspec, width)
+      }
+ 
+   return head || dspec[imax +: *spec]
+
+end
diff --git a/ipl/gprocs/imscolor.icn b/ipl/gprocs/imscolor.icn
new file mode 100644
index 0000000..8910d32
--- /dev/null
+++ b/ipl/gprocs/imscolor.icn
@@ -0,0 +1,423 @@
+############################################################################
+#
+#	File:     imscolor.icn
+#
+#	Subject:  Procedures for manipulating images
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     December 25, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures manipulate image strings.
+#
+#	imswidth(im)		returns the width of an image.
+#	imsheight(im)		returns the height of an image.
+#	imspalette(im)		returns the palette used by an image.
+#
+#	imsmap(s1, s2, s3)	applies map() to the image data.
+#
+#	imswrite(f, s, n)	writes an image string to a file.
+#
+#	drawpalette(W, p, x, y, w, h, f, n)	draws the color palette p.
+#
+#	pickpalette(W, p, dx, dy, w, h, n)      maps window coordinates
+#				to a palette drawn by drawpalette().
+#
+#	XPMImage(W, f, p)	reads an XPM file, returning an image string.
+#
+############################################################################
+#
+#  imswidth(im) returns the width of an image.
+#  imsheight(im) returns the height of an image.
+#  imspalette(im) returns the palette used by an image.
+#
+#  imsmap(s1, s2, s3) returns an image produced by mapping the data (only)
+#  of image s1 and replacing characters found in s2 with corresponding
+#  characters from s3.
+#
+#  imswrite(f, s, n) writes image string s to file f, limiting the line
+#  length to n characters.  Defaults are f = &output, n = 79.  Extra
+#  punctuation in s makes the lines break at nonsensical places, but
+#  the output is still legal.
+#
+#  drawpalette([win,] p, x, y, w, h, f, n) draws the colors of palette
+#  p in the given rectangular region.  n columns are used;  if n is
+#  omitted, a layout is chosen based on the palette name and size. The
+#  layout algorithm works best when the height is two to four times
+#  the width.  Characters in the flag string f have these meanings:
+#	l	label each color with its key
+#	o	outline each color in black
+#	u	unframed use: don't hash unused cells at end
+#
+#  pickpalette([win,] p, dx, dy, w, h, n) returns the character at (dx,dy)
+#  within a region drawn by drawpalette(win, p, x, y, w, h, f, n).
+#
+#  XPMImage([win,] f, palette) reads an XPM (X Pixmap) format image from
+#  the open file f and returns an Icon image specification that uses the
+#  specified palette.  XPMImage() fails if it cannot decode the file.
+#  If f is omitted, &input is used; if palette is omitted, "c1" is used.
+#  Not all variants of XPM format are handled; in particular, images that
+#  use more than one significant input character per pixel, or that use
+#  the old XPM Version 1 format, cause XPMImage() to fail.  No window
+#  is required, but X-specific color names like "papayawhip" will not
+#  be recognized without a window.
+#
+############################################################################
+#
+#  Links: graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link graphics
+
+
+#  imspalette(im) -- return palette used by image
+
+procedure imspalette(im)			#: palette for image
+   im ? {tab(upto(',') + 1) & return ((="#" & &null) | tab(upto(',')))}
+end
+
+
+#  imswidth(im) -- return width of image
+
+procedure imswidth(im)				#: width of image
+   im ? return integer(tab(upto(',')))
+end
+
+
+#  imsheight(im) -- return height of image
+
+procedure imsheight(im)				#: height of image
+   local pal, w, n, d, c
+
+   im ? {
+      w := integer(tab(upto(','))) | fail
+      move(1)
+      if ="#" then {
+         n := IMH_Count('0123456789ABCDEFabcdef')
+         d := (w + 3) / 4
+         return (n + d - 1) / d
+         }
+      pal := tab(upto(',')) | fail
+      move(1)
+      c := cset(PaletteChars(pal)) | fail
+      n := IMH_Count(c ++ '~\xFF')
+      return (n + w - 1) / w
+      }
+end
+
+procedure IMH_Count(c)		# count remaining chars that are in cset c
+   local n
+
+   n := 0
+   while tab(upto(c)) do
+      n +:= *tab(many(c))
+   return n
+end
+
+
+#  imsmap(s1, s2, s3) -- map the data (only) of an image string
+
+procedure imsmap(s1, s2, s3)			#: map data of image string
+   s1 ? return tab(upto(',')+1) || tab(upto(',')+1) || map(tab(0), s2, s3)
+end
+
+
+#  imswrite(f, s, n) -- write image string s to file f, max linelength of n.
+
+procedure imswrite(f, s, n)			#: write image string
+   local w, h, p, d, ll
+
+   w := imswidth(s) | fail
+   h := imsheight(s) | fail
+   p := imspalette(s) | fail
+
+   if /p then				# if bilevel image
+      d := (w + 3) / 4			# number of digits per row
+   else
+      d := w
+
+   /f := &output
+   /n := 79
+
+   # Figure out a reasonable line length for output, with n as maximum
+   n -:= 1				# allow for underscore
+   if upto('\0', PaletteChars(\p)) then
+      n /:= 4				# allow for escapes
+   ll := 1 + (n > (d - 1) / seq(1))	# divide line as equally as possible
+
+   # Write the image as a multiline string constant.
+   s ? {
+      tab(upto(',') + 1)
+      ="#" | tab(upto(',') + 1)
+      write(f, "\"", w, ",", (\p || ",") | "#", "_")
+      while not pos(0) do IWR_Row(f, move(d) | tab(0), ll)
+      write(f, "\"")
+      }
+   return
+end
+
+procedure IWR_Row(f, s, n)	# write one row, max n bytes per line
+   s ? while not pos(0) do
+      write(f, image(move(n) | tab(0)) [2:-1], "_")
+   return
+end
+
+
+#  drawpalette(win, p, x, y, w, h, f, n) -- draw palette in region
+
+procedure drawpalette(win, p, x, y, w, h, f, n)	#: draw palette
+   local nh, c, s, colr, x1, x2, y1, y2, i, j, ret
+   static cs
+   initial cs := &ascii[33+:95] -- '\\'
+
+   if type(win) ~== "window" then {
+      win :=: p :=: x :=: y :=: w :=: h :=: f :=: n
+      win := \&window | runerr(140, &window)
+      }
+   win := Clone(win, "fg=black")
+   ret := win
+
+   /p := "c1"
+   /f := ""
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   s := PAL_Order(p) | fail
+   /n := PAL_Columns(p, s, w, h)
+   nh := (*s + n - 1) / n
+
+   EraseArea(win, x, y, w, h)
+   if f ? upto('o') then {
+      w -:= 1
+      h -:= 1
+      }
+
+   i := j := 0
+   every c := !s do {
+      x1 := x + j * w / n
+      x2 := x + (j + 1) * w / n
+      y1 := y + i * h / nh
+      y2 := y + (i + 1) * h / nh
+      Fg(win, colr := PaletteColor(p, c)) | (ret := &null)
+      FillRectangle(win, x1, y1, x2 - x1, y2 - y1)
+      if upto('l', f) then {
+         Fg(win, Contrast(win, colr))
+         if not upto(cs, c) then
+            c := image(c)[-3:-1]
+         CenterString(win, (x1 + x2) / 2, (y1 + y2) / 2, c)
+         }
+      if upto('o', f) then {
+         Fg(win, "black")
+         DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
+         }
+      if (j +:= 1) >= n then {
+         j := 0
+         i +:= 1
+         }
+      }
+
+   # if some cells are unfilled, and the 'u' flag is not given,
+   # hash the unfilled cells with a diagonal pattern.
+   if j > 0 & not upto('u', f) then {
+      x1 := x + j * w / n
+      y1 := y + i * h / nh
+      x2 := x + w
+      y2 := y + h
+      WAttrib(win, "fg=black", "pattern=diagonal", "fillstyle=textured")
+      FillRectangle(win, x1, y1, x2 - x1, y2 - y1)
+      if upto('o', f) then {
+         WAttrib(win, "fillstyle=solid")
+         DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
+         }
+      }
+
+   Uncouple(win)
+   return \ret
+end
+
+
+#  pickpalette(win, p, dx, dy, w, h, n) -- return key picked from drawn palette
+
+procedure pickpalette(win, p, dx, dy, w, h, n)	#: key from drawn palette
+   local s, nw, nh
+
+   if type(win) ~== "window" then {
+      win :=: p :=: dx :=: dy :=: w :=: h :=: n
+      win := \&window | runerr(140, &window)
+      }
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+   if dx < 0 | dy < 0 | dx >= w | dy >= h then
+      fail
+
+   s := PAL_Order(p) | fail
+   /n := PAL_Columns(p, s, w, h)
+   nh := (*s + n - 1) / n
+
+   dx := ((dx + 1) * n - 1) / w
+   dy := ((dy + 1) * nh - 1) / h
+   return s[1 + n * dy + dx]
+end
+
+
+#  PAL_Columns(p, s, w, h) -- calc columns for auto-layout (internal routine)
+#
+#  p is palette name; s is character string; w,h are available dimensions
+
+procedure PAL_Columns(p, s, w, h)
+   local nw, nh
+
+   return case p of {
+      "c1":	return 6
+      "c2":	return 2
+      "c3":	return 3
+      "c4":	return 4
+      "c5":	return 5
+      "c6":	return 6
+      default: {
+	 nw := integer(w / sqrt(w * h / *s))
+         nw <:= 1
+         nh := (*s + nw - 1) / nw
+         nh <:= 1
+         return (*s + nh - 1) / nh
+	 }
+      }
+end
+
+
+#  PAL_Order(p) -- return reordered palette chars (internal routine)
+#
+#  Normal order for color cube is sorted r/g/b, then extra grays.
+#  Reorder by g/r/b followed by full set of grays, including duplicates,
+#  back to black.  Returns unmodified list of characters for c1 and
+#  grayscale palettes.
+
+procedure PAL_Order(p)
+   local palchars, s, t, n, n3, i, l
+
+   palchars := PaletteChars(p) | fail
+
+   p ? {
+      if not (="c" & any('23456')) then return palchars
+      n := integer(move(1))
+      }
+
+   palchars ? {
+
+      l := list(n, "")
+      n3 := n * n * n
+      while &pos <= n3 do
+         every !l ||:= (move(n) \ 1)
+      s := ""
+      every s ||:= !l		# build g/r/b cube portion
+
+      t := ""
+      every i := 1 to (n3 - 1) by (n * (n + 1) + 1) do
+         t ||:= palchars[i] || move(n - 1)
+      }
+
+   return s || reverse(t)
+end
+
+
+#  XPMImage(win, f, palette) -- read XPM file and return Icon image spec
+
+procedure XPMImage(win, f, pal)			#: image string for XPM file
+   local w, h, nc, cpp, i, im, c, k, s1, s2
+
+   if type(win) ~== "window" then {
+      win :=: f :=: pal
+      win := &window		# okay if null
+      }
+   /f := &input
+   /pal := "c1"
+   type(f) == "file" | runerr(105, f)
+   PaletteChars(pal) | runerr(205, f)
+
+   (read(f) ? find("XPM")) | fail
+   (XPM_RdStr(f) | fail) ? {
+      tab(many(' \t'));  w := tab(many(&digits)) | fail
+      tab(many(' \t'));  h := tab(many(&digits)) | fail
+      tab(many(' \t'));  nc := tab(many(&digits)) | fail
+      tab(many(' \t'));  cpp := tab(many(&digits)) | fail
+   }
+   if w = 0 | h = 0 then
+      fail
+
+   # read colors and figure out translation
+   s1 := s2 := ""
+   every i := 1 to nc do (XPM_RdStr(f) | fail) ? {
+      s1 ||:= move(1)
+      if cpp > 1 then
+         =" " | fail			# if not blank, we can't handle it
+      k := &null
+      # find a color key we can decipher; try color, then grayscale, then mono
+      (c := !"cgm") & tab(upto(' \t') + 1) & =c & tab(many(' \t')) &
+         (k := XPM_Key(win, pal, (tab(upto(' \t') | 0))))
+      # use first color found, or default if none
+      s2 ||:= \k | PaletteKey(pal, "gray")
+      }
+
+   # construct image
+   im := w || "," || pal || ","
+   if cpp = 1 then
+      while im ||:= map(XPM_RdStr(f), s1, s2)
+   else
+      while im ||:= map(XPM_Nth(XPM_RdStr(f), cpp), s1, s2)
+   return im
+end
+
+procedure XPM_Key(win, pal, s)	#  return key corresponding to color s
+
+   if s == "None" then {		# if transparent
+      if PaletteColor(pal, "~") then	# if "~" is in palette
+         return "\xFF"			# then use "\xFF" for transparent
+      else
+         return "~"			# but use "~" if possible
+      }
+
+   if \win then
+      return PaletteKey(win, pal, s)	# return key from palette, or fail
+   else
+      return PaletteKey(pal, s)		# return key from palette, or fail
+end
+
+procedure XPM_RdStr(f)		# read next C string from file f
+   local line, s
+
+   while line := read(f) do line ? {
+      tab(many(' \t'))
+      ="\"" | next
+      if s := tab(upto('"')) then
+         return s
+      }
+   fail
+end
+
+procedure XPM_Nth(s, n)		#  concatenate every nth character from s
+   local t
+   n -:= 1
+   t := ""
+   s ? while t ||:= move(1) do
+      move(n)
+   return t
+end
diff --git a/ipl/gprocs/imsutils.icn b/ipl/gprocs/imsutils.icn
new file mode 100644
index 0000000..2f45db1
--- /dev/null
+++ b/ipl/gprocs/imsutils.icn
@@ -0,0 +1,607 @@
+############################################################################
+#
+#	File:     imsutils.icn
+#
+#	Subject:  Procedures to manipulate image specifications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate string representations for
+#  images.
+#
+#	patident(imx1, imx2)
+#	XDrawTile(win, xoff, yoff, pattern, magnif, mode)
+#	XDrawRows(win, xoff, yoff, imx, magnif, mode)
+#	bits2hex(s)
+#	decspec(pattern)
+#	getpatt(line)
+#	getpattnote(line)
+#	hex2bits(s)
+#	hexspec(pattern)
+#	legalpat(tile)
+#	legaltile(tile)
+#	pat2xbm(pattern, name)
+#	tilebits(imx)
+#	pdensity(pattern)
+#	pix2pat(window, x, y, cols, rows)
+#	readims(input)
+#	readimsline(input)
+#	rowbits(pattern)
+#	imstoimx(ims)
+#	imxtoims(imx)
+#	showbits(pattern)
+#	tiledim(pattern)
+#	pheight(pattern)
+#	pwidth(pattern)
+#	xbm2rows(input)
+#
+############################################################################
+#
+#  Requires:  Version 8.11 graphics
+#
+############################################################################
+#
+#  Links:  convert
+#
+############################################################################
+
+$include "xnames.icn"
+
+link convert
+
+record tdim(w, h)
+
+#
+#  Test whether two image matrices are equivalent
+
+procedure patident(imx1, imx2)
+   local i
+
+   if *imx1 ~= *imx2 then fail
+   if **imx1 ~= **imx2 then fail
+
+   every i := 1 to *imx1 do
+      if imx1[i] ~== imx2[1] then fail
+
+   return imx2
+
+end
+#
+#  Draw a tile at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure XDrawTile(win, xoff, yoff, pattern, magnif, mode)
+   local x, y, row, pixel, dims, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: pattern :=: mode
+      win := &window
+      }
+
+   if magnif = 1 then XDrawImage(win, xoff, yoff, pattern, mode)
+   else {
+      if \mode then {
+         dims := tiledim(pattern)
+         XEraseArea(xoff, yoff, dims.w * magnif, dims.h * magnif)
+         }
+      y := yoff
+      every row := rowbits(pattern) do {		# draw a row
+         x := xoff
+         arglist := []
+         every pixel := !row do {
+            if pixel = "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         if *arglist = 0 then next
+         XFillRectangle ! arglist
+         }
+      }
+
+   return
+
+end
+#
+#  Draw image matrix at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure XDrawRows(win, xoff, yoff, imx, magnif, mode)
+   local x, y, row, pixel, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: imx :=: magnif :=: mode
+      win := &window
+      }
+
+   /magnif := 1
+
+   y := yoff
+
+   if \mode then
+      XEraseArea(xoff, yoff, *imx[1] * magnif, *imx * magnif)
+
+   every row := !imx do {		# draw a row
+      x := xoff
+      arglist := []
+
+      if magnif = 1 then {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y)
+            x +:= 1
+            }
+         y +:= 1
+         }
+      else {
+         every pixel := !row do {
+            if pixel = "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         }
+      if *arglist = 0 then next
+      if magnif = 1 then XDrawPoint ! arglist else XFillRectangle ! arglist
+      }
+
+   return
+
+end
+
+#
+#  Convert bit string to hex pattern string
+
+procedure bits2hex(s)
+   static bittab
+   local hex
+
+   initial {
+      bittab := table()
+      bittab["0000"] := "0"
+      bittab["1000"] := "1"
+      bittab["0100"] := "2"
+      bittab["1100"] := "3"
+      bittab["0010"] := "4"
+      bittab["1010"] := "5"
+      bittab["0110"] := "6"
+      bittab["1110"] := "7"
+      bittab["0001"] := "8"
+      bittab["1001"] := "9"
+      bittab["0101"] := "a"
+      bittab["1101"] := "b"
+      bittab["0011"] := "c"
+      bittab["1011"] := "d"
+      bittab["0111"] := "e"
+      bittab["1111"] := "f"
+      }
+
+   hex := ""
+
+   s ? {
+       while hex := bittab[move(4)] || hex
+       if not pos(0) then hex := bittab[left(tab(0), 4, "0")] || hex
+       }
+
+   return hex
+
+end
+
+#
+#  Convert pattern specification to decimal form
+
+procedure decspec(pattern)
+   local cols, chunk, dec
+
+   pattern ? {
+      if not upto("#") then return pattern
+      cols := tab(upto(','))
+      move(2)
+      chunk := (cols + 3) / 4
+      dec := cols || ","
+      while dec ||:= integer("16r" || move(chunk)) || ","
+      }
+
+   return dec[1:-1]
+
+end
+
+#
+#  Get pattern from line.  It trims off leading and trailing whitespace
+#  and removes any annotation (beginning with a # after the first whitespace
+
+procedure getpatt(line)
+
+   line ? {
+      tab(many(' \t'))
+      return tab(upto(' \t') | 0)
+      }
+
+end
+
+#
+#  Get pattern annotation.  It returns an empty string if there is
+#  no annotation.
+
+procedure getpattnote(line)
+
+   line ? {
+      tab(many(' \t'))			# remove leading whitespace
+      tab(upto(' \t')) | return ""	# skip pattern
+      tab(upto('#')) | return ""	# get to annotation
+      tab(many('# \t'))			# get rid of leading junk
+      return tab(0)			# annotation
+      }
+
+end
+
+#  Convert hexadecimal string to bits
+
+procedure hex2bits(s)
+   static hextab
+   local bits
+
+   initial {
+      hextab := table()
+      hextab["0"] := "0000"
+      hextab["1"] := "0001"
+      hextab["2"] := "0010"
+      hextab["3"] := "0011"
+      hextab["4"] := "0100"
+      hextab["5"] := "0101"
+      hextab["6"] := "0110"
+      hextab["7"] := "0111"
+      hextab["8"] := "1000"
+      hextab["9"] := "1001"
+      hextab["a"] := "1010"
+      hextab["b"] := "1011"
+      hextab["c"] := "1100"
+      hextab["d"] := "1101"
+      hextab["e"] := "1110"
+      hextab["f"] := "1111"
+      }
+
+   bits := ""
+
+   map(s) ? {
+      while bits ||:= hextab[move(1)]
+      }
+
+   return bits
+
+end
+
+#
+#  Convert pattern to hexadecimal form
+
+procedure hexspec(pattern)
+   local cols, chunk, hex
+
+   pattern ? {
+      if find("#") then return pattern
+      cols := tab(upto(','))
+      move(1)
+      chunk := (cols + 3) / 4
+      hex := cols || ",#"
+      while hex ||:= right(exbase10(tab(upto(',') | 0), 16), chunk, "0") do
+         move(1) | break
+      }
+
+   return hex
+
+end
+
+#
+#  Succeed if tile is legal and small enough for (X) pattern.  Other
+#  windows systems may be more restrictive.
+
+procedure legalpat(tile)
+
+   if not legaltile(tile) then fail
+
+   tile ? {
+      if 0 < integer(tab(upto(','))) <= 32 then return tile
+      else fail
+      }
+
+end
+
+#
+#  Succeed if tile is legal.  Accepts tiles that are too big for
+#  patterns.
+
+procedure legaltile(tile)
+
+   map(tile) ? {				# first check syntax
+      (tab(many(&digits)) & =",") | fail
+      if ="#" then (tab(many('0123456789abcdef')) & pos(0)) | fail
+      else {
+         while tab(many(&digits)) do {
+            if pos(0) then break	# okay; end of string
+            else ="," | fail
+            }
+         if not pos(0) then fail	# non-digit
+         }
+      }
+
+   return hexspec(decspec(tile)) == tile
+
+end
+
+#
+#  Convert pattern specification to an XBM image file.
+
+procedure pat2xbm(pattern, name)
+   local dims, chunk, row
+
+   /name := "noname"
+
+   dims := tiledim(pattern)
+
+
+   write("#define ", name, "_width ", dims.w)
+   write("#define ", name, "_height ", dims.h)
+   write("static char ", name, "_bits[] = {")
+
+   chunk := (dims.w + 3) / 4
+
+   pattern ? {
+      tab(upto('#') + 1)
+      while row := move(chunk) do {
+         if *row % 2 ~= 0 then row := "0" || row
+         row ? {
+            tab(0)
+            while writes("0x", move(-2), ",")
+            }
+         write()
+         }
+      }
+
+   write("};")
+
+end
+
+#
+#  Count the number of bits set in a tile
+
+procedure tilebits(imx)
+   local bits
+
+   bits := 0
+
+   every bits +:= !!imx
+
+   return bits
+
+end
+
+#
+#  Compute density (percentage of black bits) of pattern
+
+procedure pdensity(pattern)
+
+   local dark, dims
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      dark := 0
+      every rowbits(pattern) ? {
+         every upto('1') do
+            dark +:= 1
+            }
+      return dark / real(dims.w * dims.h)
+      }
+
+end
+
+#
+#  Procedure to produce pattern specification from a section of a window.
+
+procedure pix2pat(window, x, y, cols, rows)
+   local c, tile, pattern, pixels, y0
+
+   pattern := ""
+
+   every y0 := 0 to rows - 1 do {
+      pixels := ""
+      every c := Pixel(window, x, y0 + y, cols, 1) do
+         pixels ||:= (if c == "0,0,0" then "1" else "0")
+      pattern ||:= bits2hex(pixels)
+      }
+
+   if *pattern = 0 then fail		# out of bounds specification
+   else return cols || ",#" || pattern
+
+end
+
+#
+#  Read pattern.  It skips lines starting with a #,
+#  empty lines, and trims off any trailing characters after the
+#  first whitespace of a pattern.
+
+procedure readims(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(upto(' \t') | 0)
+         }
+
+   fail
+
+end
+
+#  
+#  Read pattern line.  It skips lines starting with a # and empty lines but
+#  does not trim off any trailing characters after the first whitespace of
+#  a pattern.
+
+procedure readimsline(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(0)
+         }
+
+   fail
+
+end
+
+#
+#  Generate rows of bits in a pattern.  Doesn't work correctly for small
+#  patterns.  (Why?)
+
+procedure rowbits(pattern)
+   local row, dims, chunk, hex
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      tab(upto(',') + 2)
+      hex := tab(0)
+      chunk := *hex / dims.h
+      hex ? {
+         while row := right(hex2bits(move(chunk)), dims.w, "0") do
+            suspend reverse(row)
+         }
+      }
+
+end
+
+#
+#  Produce an image matrix from a image string
+
+procedure imstoimx(ims)
+   local imx
+
+   imx := []
+
+   every put(imx, rowbits(ims))
+
+   return imx
+
+end
+
+#
+#  Convert row list to pattern specification
+
+procedure imxtoims(imx)
+   local pattern
+
+   pattern := *imx[1] || ",#"
+
+   every pattern ||:= bits2hex(!imx)
+
+   return pattern
+
+end
+
+#  Show bits of a pattern
+
+procedure showbits(pattern)
+
+   every write(rowbits(pattern))
+
+   write()
+
+   return
+
+end
+
+
+#
+#  Produce dimensions of the tile for a pattern
+
+procedure tiledim(pattern)
+   local cols
+
+   hexspec(pattern) ? {
+      cols := integer(tab(upto(',')))
+      move(2)
+      return tdim(cols, *tab(0) / ((cols + 3) / 4))
+      }
+
+end
+
+#
+#  Produce height of a pattern specification
+
+procedure pheight(pattern)
+   local cols
+
+   hexspec(pattern) ? {
+      cols := integer(tab(upto(',')))
+      move(2)
+      return  *tab(0) / ((cols + 3) / 4)
+      }
+
+end
+
+#
+#  Produce width of a pattern specification
+
+procedure pwidth(pattern)
+
+   hexspec(pattern) ? {
+      return integer(tab(upto(',')))
+      }
+
+end
+
+#
+#  Generate rows of bits from an XBM file.  Note:  This apparently
+#  is not quite right if there are more than 2 hex digits per
+#  literal.
+
+procedure xbm2rows(input)
+   local imagex, bits, row, hex, width, height, chunks
+   static hexdigit
+
+   initial hexdigit := &digits ++ 'abcdef'
+
+   imagex := ""
+
+   read(input) ? {
+      tab(find("width") + 6)
+      tab(upto(&digits))
+      width := integer(tab(many(&digits)))
+      }
+
+   read(input) ? {
+      tab(find("height") + 6)
+      tab(upto(&digits))
+      height := integer(tab(many(&digits)))
+      }
+
+   chunks := (width / 8) + if (width % 8) > 0 then 1 else 0
+
+   while imagex ||:= reads(input, 500000)	# Boo! -- can do better
+
+   imagex ? {
+      every 1 to height do {
+         row := ""
+         every 1 to chunks do {
+            (hex := tab(any(hexdigit)) || tab(any(hexdigit))) | {
+               tab(find("0x") + 2)
+               hex := move(2)
+               }
+            row ||:= case hex of {
+              "00":    "00000000"
+              "ff":    "11111111"
+               default: reverse(right(hex2bits(hex), 8, "0"))
+               }
+            }
+         suspend left(row, width)
+         }
+      }
+
+end
diff --git a/ipl/gprocs/imutils.icn b/ipl/gprocs/imutils.icn
new file mode 100644
index 0000000..e638bf0
--- /dev/null
+++ b/ipl/gprocs/imutils.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     imutils.icn
+#
+#	Subject:  Declarations to link graphics utilities
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 11, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+
+link imscolor
+link color
+link gpxop
+link gpxlib
+link wopen
diff --git a/ipl/gprocs/imxform.icn b/ipl/gprocs/imxform.icn
new file mode 100644
index 0000000..80df6ca
--- /dev/null
+++ b/ipl/gprocs/imxform.icn
@@ -0,0 +1,488 @@
+############################################################################
+#
+#	File:     imxform.icn
+#
+#	Subject:  Procedures to transform image matrices
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate matrices that represent
+#  images.
+#
+############################################################################
+#
+#  Requires:  Version 8.11, graphics
+#
+############################################################################
+#
+#  Links:  factors, imsutils, random, strings
+#
+############################################################################
+
+link factors
+link imsutils
+link random
+link strings
+
+#
+#  Reduces a image matrix to the smallest equivalent one.
+
+procedure imxreduce(rows)
+
+   rows := imxcollap(rows)
+   rows := imxrotate(rows, 90)
+   rows := imxcollap(rows)
+   rows := imxrotate(rows, -90)
+
+   return rows
+
+end
+
+procedure imxcollap(rows)
+   local size, fact
+
+   size := *rows
+   every fact := !pfactors(size) do {
+      while rowdupl(rows, fact) do {
+         size /:= fact
+         rows := rows[1+:size]
+         }
+      }
+
+   return rows
+
+end
+
+procedure rowdupl(rows, n)
+   local span, i, j
+
+   if *rows % n ~= 0 then fail
+
+   span := *rows / n
+
+   every i := 1 to n - 1 do
+      every j := 1 to span do
+         if rows[j] ~== rows[i * span + j] then fail
+
+   return
+
+end
+
+#
+#  Produces the inclusive "or" of two image matrices.
+
+procedure imxor(rows1, rows2)
+   local i, j
+
+   if (*rows1 ~= *rows2) | (**rows1 ~= **rows2) then fail
+
+   rows1 := copy(rows1)
+
+   every i := 1 to *rows1 do
+      every j := upto('1', rows2[i]) do
+         rows1[i][j] := "1"
+
+   return rows1
+
+end
+
+#
+#  Produces the "and" of two image matrices.
+
+procedure imxand(rows1, rows2)
+   local i, j
+
+   if (*rows1 ~= *rows2) | (**rows1 ~= **rows2) then fail
+
+   rows1 := copy(rows1)
+
+   every i := 1 to *rows1 do
+      every j := upto('0', rows2[i]) do
+         rows1[i][j] := "0"
+
+   return rows1
+
+end
+
+#
+#  Produces the exclusive "or" of two image matrices.
+
+procedure imxxor(rows1, rows2)
+   local i, j
+
+   if (*rows1 ~= *rows2) | (**rows1 ~= **rows2) then fail
+
+   rows1 := copy(rows1)
+
+   every i := 1 to *rows1 do
+      every j := 1 to **rows1 do
+         rows1[i][j] := if rows1[i][j] == rows2[i][j] then "0" else "1"
+
+   return rows1
+
+end
+
+#
+#  Scrambles a image matrix by shuffling it.  If dir is "h", the columns of each row
+#  are scrambled; if "v", the the rows are scrambled.  If "b", bits are
+#  scrambled throughout the image matrix.
+
+procedure imxscramb(rows, dir)
+   local i, all
+
+   case dir of {
+      "h":  {
+          every i := 1 to *rows do
+             rows[i] := shuffle(rows[i])
+          }
+      "v":  rows := shuffle(rows)
+      "b" | &null:  {
+         all := ""
+         every all ||:= !rows
+         all := shuffle(all)
+         every i := 1 to *rows do {
+            rows[i] := left(all, *rows[1])
+            all[1 +: *rows[1]] := ""
+            }
+         }
+      default:   stop("*** illegal specification in scramble()")
+      }
+
+   return rows
+
+end 
+
+#
+#  Create bit-shifted copy of an image matrix.  If dir is "h", then the
+#  shift is horizontal; if "v", vertical. The default is horizontal.
+#  Positive shift is to the right for horizontal shifts, downward for vertical
+#  shifts.  The default shift is 0 and the default direction is horizontal.
+
+procedure imxshift(rows, shift, dir)
+   local i
+
+   /shift := 0
+
+   rows := copy(rows)
+
+   case dir of {
+      "h" | &null: {			# horizontal shift
+         every i := 1 to *rows do
+            rows[i] := rotate(rows[i], -shift)
+         }
+      "v": {				# vertical shift
+         if shift > 0 then
+            every 1 to shift do
+               push(rows, pull(rows))
+         else if shift < 0 then
+            every 1 to -shift do
+               put(rows, pop(rows))
+         }
+      default:  stop("*** illegal specification in imxshift()")
+      }
+
+   return rows
+
+end
+
+#
+#  Place a border around a image matrix.  l, r, t, and b specify the number of bits
+#  to add at the left, right, top, and bottom, respectively.  c specifies
+#  the color of the border, "0" for white, "1" for black.
+
+procedure imxborder(rows, l, r, t, b, c)
+   local i, row, left, right
+
+   /l := 1
+   /r := 1
+   /t := 1
+   /b := 1
+   /c := "0"
+
+   if l = r = t = b = 0 then return rows
+
+   row := repl(c, *rows[1] + l + r)
+   left := repl(c, l)
+   right := repl(c, r)
+
+   every i := 1 to *rows do
+       rows[i] := left || rows[i] || right
+
+   every 1 to t do
+      push(rows, row)
+
+   every 1 to b do
+      put(rows, row)
+
+   return rows
+
+end
+
+#
+#  Crop a image matrix.  l, r, t, and b specify the number of bits
+#  to crop at the left, right, top, and bottom, respectively.
+
+procedure imxcrop(rows, l, r, t, b)
+   local i
+
+   /l := 0
+   /r := 0
+   /t := 0
+   /b := 0
+
+   if l = r = t = b = 0 then return rows
+
+   if ((*rows[1] - l - r) | (*rows - t - b)) < 4 then fail
+
+   every 1 to t do
+      get(rows)
+
+   every 1 to b do
+      pull(rows)
+
+   every i := 1 to *rows do
+       rows[i] := rows[i][l + 1 : -r]
+
+   return rows
+
+end
+
+#  Creates a tile in every other pixel is discarded.  dir determines the
+#  direction is which the halving is done.  If dir is "b" or null, it's
+#  done both vertically and horizontally.  If dir is "v", it's only done
+#  vertically, while if dir is "v", it's done only vertically.
+#  If choice is "o" or null, odd-numbered rows or columns are kept;
+#  if "e", the even-numbered ones.
+
+procedure imxhalve(rows, dir, choice)
+   local newrows, i
+
+   choice := if choice === ("o" | &null) then 1 else 0
+   newrows := []
+
+   case dir of {
+      "v": {
+         every i := choice to *rows by 2 do
+            put(newrows, rows[i])
+         }
+      "h":  every put(newrows, decollate(!rows, choice))
+      "b" | &null: return imxhalve(imxhalve(rows, "v", choice), "h", choice)
+      }
+
+   return newrows
+
+end
+         
+#
+#  Creates a tile in which each pixel doubled.  dir determines the
+#  direction in which the doubling is done.  If dir is "b" or null, it's
+#  done both horizontally and vertically.  If dir is "v", it's only done
+#  vertically, while if dir is "h", it's done only horizontally.
+
+procedure imxdouble(rows, dir)
+   local row, newrows
+
+   newrows := []
+
+   case dir of {
+      "v":  {
+         every row := !rows do
+            put(newrows, row, row)
+         }
+      "h":  {
+         every row := !rows do
+            put(newrows, collate(row, row))
+         }
+      "b" | &null: return imxdouble(imxdouble(rows, "v"), "h")
+      }
+
+   return newrows
+
+end
+
+#
+#  Flip image matrix.  The possible values of dir are "h" (horizontal flip),
+#  "v" (vertical flip), "l" (left diagonal), and "r" (right diagonal).
+#  (The left diagonal extends from the upper left corner to the bottom
+#  right corner; the right diagonal from the upper right to the lower
+#  left.
+
+procedure imxflip(rows, dir)
+   local newrows, x, y, i
+
+   case dir of {
+      "l": {
+         newrows := imxrotate(rows)
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               newrows[x, y] := rows[y, x]
+         }
+      "r": {
+         newrows := list(*rows[1], repl("0", *rows))
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               if rows[y, x] == "1" then
+                  newrows[x, y] := "1"
+         }
+      "h":  {
+         newrows := copy(rows)
+         every i := 1 to *rows do
+            newrows[i] := reverse(newrows[i])
+         }
+      "v":  {
+         newrows := copy(rows)
+         every i := 1 to *rows / 2 do
+           newrows[i] :=: newrows[-i]
+         }
+      default:  stop("*** illegal flip specification in imxflip()")
+      }
+
+   return newrows
+      
+end
+
+#
+#  Invert white and black bits in image matrix specification
+
+procedure imxinvert(rows)
+   local i
+
+   every i := 1 to *rows do
+      rows[i] := map(rows[i], "10", "01")
+
+   return rows
+
+end
+
+#
+#  Reduce image matrix to its smallest equivalent form (with at least 4 columns).
+#  Limited to square image matrices for portability -- other possibilities exist
+#  for operating on and/or producing image matrices that are not square.
+
+
+procedure imxminim(rows)
+   local halfw, halfh, i
+
+   if (*rows ~= *rows[1]) | (*rows % 2 ~= 0) then return rows
+
+   repeat {
+  
+      if *rows[1] < 8 then break		# can't reduce to < 4 columns
+
+      halfw := *rows[1] / 2
+      halfh := *rows / 2
+   
+      every i := 1 to halfh do			# check rows in top and bottom
+         if (rows[i] ~== rows[i + halfh]) |
+            (rows[i][1+:halfw] ~== rows[i][0-:halfw]) then break break
+   
+      every 1 to halfh do			# reducible; remove rows
+         pop(rows)
+   
+      every i := 1 to halfh do			# truncate rows
+         rows[i] := rows[i][1+:halfw]
+   
+      }
+
+   return rows
+
+end
+
+#  Create rotated copy of an image matrix.  If dir is "cw" or "90", rotation is
+#  90 degrees clockwise; if "ccw" or "-90", 90 degrees counter-clockwise.
+#  If dir is "180", rotation is 180 degrees.  The default is "cw".
+
+procedure imxrotate(rows, dir)
+   local newrows, i, row, pix
+
+   /dir := "cw"
+
+   case string(dir) of {
+      "ccw" | "-90":  {			# counter-clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do  {
+            i := 0
+            every pix := !row do
+               newrows[i -:= 1] ||:= pix
+            }
+        }
+      "cw" | "90" | &null:  {			# clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do {
+            i := 0
+            every pix := !row do
+               newrows[i +:= 1] := pix || newrows[i]
+            }
+         }
+      "180": {
+         newrows := []
+         every push(newrows, reverse(!rows))
+         }
+      default:  stop("*** illegal rotation specification in imxrotate()")
+   }
+
+   return newrows
+
+end
+
+#
+#  Trim border whitespace from image matrix
+
+procedure imxtrim(rows)
+
+   while (*rows > 4) & not(upto('1', rows[1])) do
+      get(rows)
+
+   while (*rows > 4) & not(upto('1', rows[-1])) do
+      pull(rows)
+
+   rows := imxrotate(rows, "cw")
+
+   while (*rows > 4) & not(upto('1', rows[1])) do
+      get(rows)
+
+   while (*rows > 4) & not(upto('1', rows[-1])) do
+      pull(rows)
+ 
+   return imxrotate(rows, "ccw")
+
+end
+
+#
+#  Centers non-white portion of image matrix
+
+procedure imxcenter(rows, w, h)
+   local rw, rh, vert, horz, t, l
+
+   rows := imxtrim(rows)
+
+   rw := *rows[1]
+   rh := *rows
+
+   if (rh = h) & (rw = w) then return rows
+   if (rh > h) | (rw > w) then fail
+
+   horz := w - rw
+   vert := h - rh
+   l := horz / 2
+   t := vert / 2
+
+   return imxborder(rows, l, horz - l, t, vert - t)
+
+end
+
+#  Create a blank i-by-j image matrix
+
+procedure imxcreate(i, j)
+
+   return list(i, repl("0", j))
+
+end
diff --git a/ipl/gprocs/interact.icn b/ipl/gprocs/interact.icn
new file mode 100644
index 0000000..442f434
--- /dev/null
+++ b/ipl/gprocs/interact.icn
@@ -0,0 +1,409 @@
+############################################################################
+#
+#	File:     interact.icn
+#
+#	Subject:  Procedures to support interactive applications
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 7, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	edit_file(s)	launches an editor, default vi, for the file named
+#			s.
+#
+#	edit_list(L)	provides edit dialog for the strings in the list L.
+#
+#	error_notice(i, x, s)
+#			produces a notice dialog noting a run-time
+#			error.  It can be used to handle procedure
+#			errors by runerr := error_notice.
+#
+#	execute()	provides a dialog for specifying a command.
+#
+#	expose(win)	attempt to make win the active window for the
+#			window manager.
+#
+#	load_file(s, n)	presents a standard open dialog with the caption s.
+#			and suggest name n.
+#
+#			If the user specifies a file that can be opened,
+#			dialog_value is set to it.  Otherwise, the dialog
+#			is presented again.  The name of the selected
+#			button is returned.
+#
+#	open_image(s)	presents a standard open dialog with the caption s.
+#			If the user specifies a file that can be opened as
+#			an image in a window, the window is opened.  Otherwise
+#			the dialog is presented again.
+#
+#	ExitNotice(s[])	Notice() that exits.
+#
+#	FailNotice(s[])	Notice() that fails.
+#
+#	save_as(s, n)	presents a standard save dialog with the caption s
+#			and suggested name n.  If the user specifies a file
+#			that can be written, the file is assigned to
+#			dialog_value.  Otherwise the dialog is presented
+#			again.  save_as() fails if the user cancels.
+#
+#	save_file(s, n)	presents a standard save dialog with the caption s
+#			and suggested name n.  If the user specifies a file
+#			that can be written, the file is returned.
+#			Otherwise, save_as() is called.  The name of
+#			the selected button is returned.
+#
+#	save_list(s, L)	provides dialog for saving list items in a file.
+#
+#	select_dialog(s, L, d)	
+#			provides a dialog for selecting from a list of
+#			items.  d is the default selection.
+#
+#	snapshot(win, x, y, w, h, n)
+#			writes an image file for the specified portion of
+#			the window.  The name for the file is requested from
+#			the user via a dialog box.  If there already is a
+#			file by the specified name, the user is given the
+#			option of overwriting it or selecting another name.
+#			The procedure fails if the user cancels.  n sets
+#			the width of the text-entry field.
+#
+#	unsupported()	provides Notice() for unsupported feature.
+#
+############################################################################
+#
+#  Links:  dsetup, exists, lists, strings
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link dsetup
+link io
+link lists
+
+procedure edit_file(name)			#: editor launch
+   local editor
+
+   TextDialog("Edit:", , name, 30) == "Okay" | fail
+
+   editor := getenv("EDITOR") | "vi"
+
+   return system(editor || " " || dialog_value[1])
+
+end
+
+procedure edit_list(lines)			#: edit lines dialog
+   local insert, number, location, bounds, n
+   static add_tbl, labels, buttons
+
+   initial {
+      add_tbl := table("")
+      add_tbl["number"] := 1
+      add_tbl["position"] := "after"
+
+      labels := []
+      every put(labels, right(1 to 50, 2))
+
+      buttons := ["Okay", "Cancel", "Add", "Delete"]
+      }
+
+   repeat {
+      case TextDialog("", labels[1 +: *lines], lines, 60, buttons) of {
+         "Cancel":   fail
+         "Okay":     return dialog_value
+         "Delete":   {
+            repeat {
+               case TextDialog("Delete lines:", , , 60) of {
+                  "Cancel":   break next
+                  "Okay":     {
+                     lines := ldelete(lines, dialog_value[1])
+                     if *lines = 0 then {
+                        Notice("List empty; creating one line")
+                        lines := list(1)
+                        }
+                     break next
+                     }
+                  }
+               }
+            }
+         "Add":      {
+            repeat {
+               add_tbl["location"] :=
+                  if add_tbl["position"] == "after" then *lines else 0
+               case add_dialog(add_tbl) of {
+                  "Cancel":   break next
+                  "Okay":     {
+                     bounds := (if add_tbl["position"] == "after" then 0 else 1)
+                     (0 <= (n := integer(add_tbl["location"] - bounds)) <=
+                        (*lines)) | {
+                           Notice("Invalid location")
+                           add_tbl["location"] := if add_tbl["position"] ==
+                              "after" then *lines else 0
+                           next
+                           }
+                     (number := (0 <= integer(add_tbl["number"]))) | {
+                           Notice("Invalid number")
+                           add_tbl["number"] := 1
+                           next
+                           }
+                     insert := list(number, add_tbl["value"])
+                     if n = 0 then lines := insert ||| lines
+                     else if n = *lines then lines |||:= insert
+                     else lines := lines[1:n] ||| insert ||| lines[n:0]
+                     break next
+                     }
+                  }
+               }
+            }
+         }
+      }
+
+end
+
+procedure error_notice(i, x, s)			#: error alert
+
+   return Notice("Error " || i || " " || s,
+      "Offending value: " || image(x))
+
+end
+
+procedure execute()				#: command-line launch
+   local pipe, win, olist
+
+   OpenDialog("Command line:") == "Okay"  | fail
+
+   olist := []
+   pipe := open(dialog_value, "p")
+
+   every put(olist, !pipe)
+
+   close(pipe)
+
+   win := list_win(olist, "command") | fail
+
+   Event(win)
+
+   WClose(win)
+
+   return
+
+end
+
+procedure list_win(lst, label)			#: window for list of strings
+   local win
+
+   win := WOpen("canvas=hidden", "label=" || label, "lines=" || *lst + 2,
+      "columns=" || maxlen(lst) + 2) | fail
+
+   WWrite(win)
+   every WWrite(win, " ", !lst)
+   WAttrib(win, "canvas=normal")
+
+   return win
+
+end
+
+procedure expose(win)				#: expose window
+
+#  For some window managers, this can be use to make a window active
+
+#  WAttrib(\win, "canvas=hidden") | fail
+#  WAttrib(win, "canvas=normal")
+
+#  However, this should work without the fidgets:
+
+   Raise(win)
+
+   return
+
+end
+
+procedure load_file(caption, n)			#: load dialog
+   local button
+
+   repeat {
+      (button := OpenDialog(caption, n)) == "Okay" | return button
+      dialog_value := open(dialog_value) | {
+         Notice("Can't open " || dialog_value)
+         next
+         }
+      return button
+      }
+
+end
+
+procedure open_image(caption, atts[])		#: open image
+   local button, win
+
+   repeat {
+      (button := OpenDialog(caption)) == "Okay" | fail
+      put(atts, "image=" || dialog_value)
+      win := (WOpen ! atts) | {
+         Notice("Can't open " || dialog_value)
+         pull(atts)
+         next
+         }
+      return win
+      }
+
+end
+
+procedure ExitNotice(s[])			#: notice dialog that fails
+
+   Notice ! s
+
+   exit()
+
+end
+
+procedure FailNotice(s[])			#: notice dialog that fails
+
+   Notice ! s
+
+   fail
+
+end
+
+procedure save_as(caption, name, n)		#: save-as dialog
+   local button, file
+
+   repeat {
+      if (button :=  SaveDialog(caption, name, n)) == "Yes" then {
+         file := dialog_value
+         if exists(file) then {
+            if TextDialog("Overwrite existing file?") == "Cancel" then next
+            }
+         dialog_value := open(file, "w") | {
+            Notice("Can't write " || dialog_value)
+            next
+            }
+         }
+      return button
+      }
+
+end
+
+procedure save_file(caption, name, n)		#: save dialog
+   local button
+
+   (button := SaveDialog(caption, name, n)) == "Yes" | return button
+   dialog_value := open(dialog_value, "w") | {
+      Notice("Can't write file")
+      return save_as("Save:", dialog_value, n)
+      }
+
+   return button
+
+end
+
+procedure save_list(caption, lst)		#: save list dialog
+   local output
+
+   OpenDialog(caption, , 30) == "Okay" | fail
+   if dialog_value == "-" then output := &output	# "-" means &output
+   else output := open(dialog_value, "w") |
+      return FailNotice("Cannot open " || dialog_value)
+
+   every write(output, !lst)
+
+   close(output)
+
+   return
+
+end
+
+#  This procedure handles selection from long lists by producing
+#  a succession of dialogs to the user's choice of "More".
+
+$define Choices 30		# maximum choices per dialog
+
+procedure select_dialog(caption, lst, dflt)	#: select dialog for many items
+   static buttons
+
+   initial buttons := ["Okay", "More", "Cancel"]
+
+   if *lst = 0 then {
+      Notice("No selections available")
+      fail
+      }
+   until *lst <= Choices do {
+      case SelectDialog(caption, lst[1+:Choices], dflt, buttons) of {
+            "Cancel":  fail
+            "Okay":    return
+            "More":    lst := lst[Choices + 1:0]
+            }
+      }
+
+   if *lst > 0 then {
+      SelectDialog(caption, lst, dflt) == "Okay" | fail
+      return dialog_value
+      }
+
+   else fail
+
+end
+
+procedure snapshot(win, x, y, w, h, n)		#: snapshot dialog
+   local name, fg, bg
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   fg := Fg(win)
+   bg := Bg(win)
+   Fg(win, "black")
+   Bg(win, "light gray")
+
+   repeat {
+      if OpenDialog(win, "Image file name", , n) == "Okay" then {
+         name := dialog_value
+         if exists(dialog_value) then {
+            if TextDialog("Overwrite existing file?") == "Cancel"
+            then next
+            }
+         Fg(win, fg)
+         Bg(win, bg)
+         WriteImage(win, name, x, y, w, h) | {
+            Notice("Cannot write image")
+            next
+            }
+         return
+         }
+      else fail
+      }
+      
+end
+
+procedure unsupported()				#: unsupported feature alert
+
+   return FailNotice("Unsupported feature")
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure add_dialog(win, deftbl)
+static dstate
+initial dstate := dsetup(win,
+   ["add_dialog:Sizer::1:0,0,531,182:add",],
+   ["add:Label:::12,14,70,13:Add lines:",],
+   ["cancel:Button:regular::76,150,49,20:Cancel",],
+   ["location:Text::2:12,43,87,19:location:\\=",],
+   ["number:Text::2:12,72,87,19:number:  \\=",],
+   ["okay:Button:regular:-1:12,150,49,20:Okay",],
+   ["position:Choice::2:117,50,71,42:",,
+      ["after","before"]],
+   ["value:Text::60:12,103,493,19:value:   \\=",],
+   )
+return dpopup(win, deftbl, dstate)
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/isdplot.icn b/ipl/gprocs/isdplot.icn
new file mode 100644
index 0000000..4bd8008
--- /dev/null
+++ b/ipl/gprocs/isdplot.icn
@@ -0,0 +1,259 @@
+############################################################################
+#
+#	File:     isdplot.icn
+#
+#	Subject:  Procedures to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 2001
+#
+############################################################################
+#
+#  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.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  cells, convert, expander, weaving, weavutil, lists, mirror,
+#	   tieutils, wopen, numbers, xcode, palettes, patxform
+#
+############################################################################
+
+link convert
+link expander
+link weaving
+link weavutil
+link lists
+link mirror
+link numbers
+link palettes
+link patxform
+link tieutils
+link wopen
+
+global X_		# x position for copying
+global Y_		# y position for copying
+
+$define CellSize 5
+$define g_w 10
+
+# Create draft.
+
+procedure plot(draft, clip)
+   local threading_pane, treadling_pane, tieup_pane
+   local tr_w, th_w, tr_h, th_h, i, j, weft_colors_pane
+   local x, y, k, width, height, warp_colors_pane
+   local drawdown_win, treadle, treadle_list, win, b_w
+   local threading_colors_pane, treadling_colors_pane, colors
+   local trc_w, trc_h, thc_w, thc_h, matrix
+
+   X_ := Y_ := 0
+
+   if /draft.warp_colors | /draft.weft_colors then fail
+
+   colors := *draft.color_list			# NEEDS FIXING
+
+   warp_colors_pane := makepanel(*draft.threading, 1, CellSize)
+   weft_colors_pane := makepanel(1, *draft.treadling, CellSize)
+
+   b_w := WAttrib(weft_colors_pane.window, "width")
+
+   every i := 1 to *draft.warp_colors do
+      colorcell(warp_colors_pane, i, 1,
+         draft.color_list[integer(draft.warp_colors[i])]) | fail
+
+   every j := 1 to *draft.weft_colors do
+      colorcell(weft_colors_pane, 1, j,
+         draft.color_list[integer(draft.weft_colors[j])]) | fail
+
+   threading_pane := makepanel(*draft.threading, draft.shafts, CellSize)
+
+   every i := 1 to *draft.threading do
+      colorcell(threading_pane, i, draft.shafts - \draft.threading[i] + 1,
+         "black") | fail
+
+   th_w := WAttrib(threading_pane.window, "width")
+   th_h := WAttrib(threading_pane.window, "height")
+
+   treadling_pane := makepanel(draft.treadles, *draft.treadling, CellSize)
+
+   tr_w := WAttrib(treadling_pane.window, "width")
+   tr_h := WAttrib(treadling_pane.window, "height")
+
+   every i := 1 to *draft.treadling do
+      colorcell(treadling_pane, draft.treadles - draft.treadling[i] + 1, i,
+         "black")
+
+   threading_colors_pane := makepanel(*draft.threading, colors, CellSize)
+
+   every i := 1 to *draft.threading do
+      colorcell(threading_colors_pane, i,
+         colors - draft.warp_colors[i] + 1, "black")
+
+   thc_w := WAttrib(threading_colors_pane.window, "width")
+   thc_h := WAttrib(threading_colors_pane.window, "height")
+
+   treadling_colors_pane := makepanel(colors, *draft.treadling, CellSize)
+
+   every i := 1 to *draft.treadling do
+      colorcell(treadling_colors_pane,
+         colors - draft.weft_colors[i] + 1, i, "black")
+
+   trc_w := WAttrib(treadling_colors_pane.window, "width")
+   trc_h := WAttrib(treadling_colors_pane.window, "height")
+
+   tieup_pane := makepanel(draft.treadles, draft.shafts, CellSize)
+
+   matrix := pflip(pflip(draft.tieup, "h"), "v")
+
+   every i := 1 to draft.shafts do 		# rows
+      every j := 1 to draft.treadles do		# columns
+         if matrix[i, j] == "1" then 
+            colorcell(tieup_pane, j,  i, "black") 
+
+   drawdown_win := WOpen(
+      "canvas=hidden",
+      "width=" || (CellSize * *draft.threading + 1),
+      "height=" || (CellSize * *draft.treadling + 1)
+      )
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.shafts do
+      every j := 1 to draft.treadles do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == i then
+                  put(treadle_list[j], k)
+
+   every j := 1 to *draft.treadling do {
+      treadle := draft.treadling[j]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *(treadle_list[treadle]) do
+         fillcell(drawdown_win, treadle_list[treadle][i], j, "black")
+      }
+
+   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)
+
+   width := trc_w + tr_w + th_w + b_w + 5 * g_w
+   height := thc_h + th_h + tr_h + b_w + 5 * g_w
+
+   win := WOpen(
+      "canvas=hidden",
+      "width=" || width,
+      "height=" || height
+      ) | stop("cannot open comp window")
+
+   incr_offset(g_w, 4 * g_w + b_w + thc_h + th_h)
+
+   CopyArea(weft_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(b_w + g_w, 0)
+
+   CopyArea(treadling_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(trc_w + g_w, 0)
+
+   CopyArea(treadling_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(tr_w + g_w, 0)
+
+   CopyArea(drawdown_win, win, , , , , X_, Y_)
+
+   incr_offset(0,  -(th_h + g_w))
+
+   CopyArea(threading_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(thc_h + g_w))
+
+   CopyArea(threading_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(b_w + g_w))
+
+   CopyArea(warp_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(-(tr_w + g_w),  b_w + thc_h + 2 * g_w)
+
+   CopyArea(tieup_pane.window, win, , , , , X_, Y_)
+
+   if \clip then {			# remove color portion
+       CopyArea(win, win, X_, Y_, , , 0, 0)
+       WAttrib(win, "width=" || (WAttrib(win, "width") - X_ - 2 * g_w))
+       WAttrib(win, "height=" || (WAttrib(win, "height") - Y_ - 2 * g_w))
+       }
+
+   every WClose(
+      weft_colors_pane.window |
+      treadling_colors_pane.window |
+      treadling_pane.window |
+      drawdown_win |
+      threading_pane.window |
+      threading_colors_pane.window |
+      warp_colors_pane.window |
+      tieup_pane.window |
+      drawdown_win
+      )
+
+   return  win
+
+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 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
+
+procedure incr_offset(x, y)
+
+   X_ +:= x
+   Y_ +:= y
+
+   return
+
+end
diff --git a/ipl/gprocs/isdxplot.icn b/ipl/gprocs/isdxplot.icn
new file mode 100644
index 0000000..52a7283
--- /dev/null
+++ b/ipl/gprocs/isdxplot.icn
@@ -0,0 +1,245 @@
+############################################################################
+#
+#	File:     isdxplot.icn
+#
+#	Subject:  Procedures to create grid plots for ISDs
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 4, 2003
+#
+############################################################################
+#
+#  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.
+#
+#  This version is for ISDs without explicit thread-color information.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and large integers
+#
+############################################################################
+#
+#  Links:  convert, expander, weaving, weavutil, lists, mirror,
+#	   tieutils, wopen, numbers, palettes, patxform
+#
+############################################################################
+
+link convert
+link expander
+link weaving
+link weavutil
+link lists
+link mirror
+link numbers
+link palettes
+link patxform
+link tieutils
+link wopen
+
+global X_		# x position for copying
+global Y_		# y position for copying
+
+$define CellSize 10
+$define g_w 10
+
+# Create draft.
+
+procedure plot(draft, clip)
+   local threading_pane, treadling_pane, tieup_pane
+   local tr_w, th_w, tr_h, th_h, i, j, weft_colors_pane
+   local x, y, k, width, height, warp_colors_pane
+   local drawdown_win, treadle, treadle_list, win, b_w
+   local threading_colors_pane, treadling_colors_pane, colors
+   local trc_w, trc_h, thc_w, thc_h, matrix
+
+   X_ := Y_ := 0
+
+   colors := *draft.color_list			# NEEDS FIXING
+
+   warp_colors_pane := makepanel(*draft.threading, 1, CellSize)
+   weft_colors_pane := makepanel(1, *draft.treadling, CellSize)
+
+   b_w := WAttrib(weft_colors_pane.window, "width")
+
+   every i := 1 to *draft.threading do
+      colorcell(warp_colors_pane, i, 1, "black")
+
+   every j := 1 to *draft.treadling do
+      colorcell(weft_colors_pane, 1, j, "white")
+
+   threading_pane := makepanel(*draft.threading, draft.shafts, CellSize)
+
+   every i := 1 to *draft.threading do
+      colorcell(threading_pane, i, draft.shafts - draft.threading[i] + 1,
+         "black") | fail
+
+   th_w := WAttrib(threading_pane.window, "width")
+   th_h := WAttrib(threading_pane.window, "height")
+
+   treadling_pane := makepanel(draft.treadles, *draft.treadling, CellSize)
+
+   tr_w := WAttrib(treadling_pane.window, "width")
+   tr_h := WAttrib(treadling_pane.window, "height")
+
+   every i := 1 to *draft.treadling do
+      colorcell(treadling_pane, draft.treadles - draft.treadling[i] + 1, i,
+         "black")
+
+   threading_colors_pane := makepanel(*draft.threading, colors, CellSize)
+
+   thc_w := WAttrib(threading_colors_pane.window, "width")
+   thc_h := WAttrib(threading_colors_pane.window, "height")
+
+   treadling_colors_pane := makepanel(colors, *draft.treadling, CellSize)
+
+   trc_w := WAttrib(treadling_colors_pane.window, "width")
+   trc_h := WAttrib(treadling_colors_pane.window, "height")
+
+   tieup_pane := makepanel(draft.treadles, draft.shafts, CellSize)
+
+   matrix := pflip(pflip(draft.tieup, "h"), "v")
+
+   every i := 1 to draft.shafts do 		# rows
+      every j := 1 to draft.treadles do		# columns
+         if matrix[i, j] == "1" then 
+            colorcell(tieup_pane, j, i, "black") 
+
+   drawdown_win := WOpen(
+      "canvas=hidden",
+      "width=" || (CellSize * *draft.threading + 1),
+      "height=" || (CellSize * *draft.treadling + 1)
+      )
+
+   treadle_list := list(draft.treadles)
+   every !treadle_list := []
+
+   every i := 1 to draft.shafts do
+      every j := 1 to draft.treadles do
+         if draft.tieup[i, j] == "1" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] == i then
+                  put(treadle_list[j], k)
+
+   every j := 1 to *draft.treadling do {
+      treadle := draft.treadling[j]
+      if *treadle_list[treadle] = 0 then next	# blank pick
+      every i := 1 to *(treadle_list[treadle]) do
+         fillcell(drawdown_win, treadle_list[treadle][i], j, "black")
+      }
+
+   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)
+
+   width := trc_w + tr_w + th_w + b_w + 5 * g_w
+   height := thc_h + th_h + tr_h + b_w + 5 * g_w
+
+   win := WOpen(
+      "canvas=hidden",
+      "width=" || width,
+      "height=" || height
+      ) | stop("cannot open comp window")
+
+   incr_offset(g_w, 4 * g_w + b_w + thc_h + th_h)
+
+   CopyArea(weft_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(b_w + g_w, 0)
+
+   CopyArea(treadling_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(trc_w + g_w, 0)
+
+   CopyArea(treadling_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(tr_w + g_w, 0)
+
+   CopyArea(drawdown_win, win, , , , , X_, Y_)
+
+   incr_offset(0, -(th_h + g_w))
+
+   CopyArea(threading_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(thc_h + g_w))
+
+   CopyArea(threading_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(0, -(b_w + g_w))
+
+   CopyArea(warp_colors_pane.window, win, , , , , X_, Y_)
+
+   incr_offset(-(tr_w + g_w), b_w + thc_h + 2 * g_w)
+
+   CopyArea(tieup_pane.window, win, , , , , X_, Y_)
+
+   if \clip then {			# remove color portion
+      CopyArea(win, win, X_ - 10, Y_ - 10, , , 0, 0)
+      WAttrib(win, "width=" || (WAttrib(win, "width") - X_ + g_w))
+      WAttrib(win, "height=" || (WAttrib(win, "height") - Y_ + g_w))
+      }
+
+   every WClose(
+      weft_colors_pane.window |
+      treadling_colors_pane.window |
+      treadling_pane.window |
+      drawdown_win |
+      threading_pane.window |
+      threading_colors_pane.window |
+      warp_colors_pane.window |
+      tieup_pane.window |
+      drawdown_win
+      )
+
+   return win
+
+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 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
+
+procedure incr_offset(x, y)
+
+   X_ +:= x
+   Y_ +:= y
+
+   return
+
+end
diff --git a/ipl/gprocs/joinpair.icn b/ipl/gprocs/joinpair.icn
new file mode 100644
index 0000000..6fbdac2
--- /dev/null
+++ b/ipl/gprocs/joinpair.icn
@@ -0,0 +1,44 @@
+############################################################################
+#
+#	File:     joinpair.icn
+#
+#	Subject:  Procedure to connect pairs of points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 12, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  joinpair(points1, points2) draws lines between all pairs of points
+#  in the lists of points.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links: gobject, turtle
+#
+############################################################################
+
+link gobject
+link turtle
+
+procedure joinpair(points1, points2)
+   local j, k, p1, p2
+
+   every p1 := !points1 do
+      every p2 := !points2 do {
+         TGoto(p1.x, p1.y)
+         TDrawto(p2.x, p2.y)
+         }
+
+   return
+
+end
diff --git a/ipl/gprocs/jolygs.icn b/ipl/gprocs/jolygs.icn
new file mode 100644
index 0000000..f776163
--- /dev/null
+++ b/ipl/gprocs/jolygs.icn
@@ -0,0 +1,55 @@
+############################################################################
+#
+#	File:     jolygs.icn
+#
+#	Subject:  Procedure to produce traces of "jolygons"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces traces of jolygons.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 20-24.
+#
+#  The arguments specify the starting positions, the extent of the
+#  drawing, the number of segments, the angle between consecutive
+#  segments, the ratio of the lengths of consecutive segments,
+#  a length factor, and a y scaling factor.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure jolyg(x, y, extent, n, angle, ratio, lfact, yfact)
+   local xpos, ypos, i, offset, length
+
+   angle := dtor(angle)
+   offset := 0
+   length := extent * lfact
+
+   xpos := (extent - length) / 2
+   ypos := (extent - length) / 2
+
+   suspend Point(x + xpos, y + ypos)	# initial point
+
+   every i := 0 to n do {
+      xpos +:= length * cos(offset)
+      ypos +:= length * sin(offset)
+      suspend Point(x + xpos, y + yfact * ypos)
+      offset +:= angle
+      length *:= ratio
+      }
+
+end
diff --git a/ipl/gprocs/linddefs.icn b/ipl/gprocs/linddefs.icn
new file mode 100644
index 0000000..793ecf2
--- /dev/null
+++ b/ipl/gprocs/linddefs.icn
@@ -0,0 +1,424 @@
+############################################################################
+#
+#	File:     linddefs.icn
+#
+#	Subject:  Procedure to produce table of L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 22, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a table of L-systems.
+#
+############################################################################
+#
+#  Links:  lindrec
+#
+############################################################################
+
+link lindrec
+
+procedure linddefs()
+   local linden
+
+   linden := table()
+
+   linden["fibbush"] := lsys_0l("", table(), 0, 90)
+   linden["fibbush"].rewrite["A"] := "[B/////'B///////'B]"
+   linden["fibbush"].rewrite["B"] := "[&IL!A]"
+   linden["fibbush"].rewrite["I"] := "FL"
+   linden["fibbush"].rewrite["F"] := "F/////I"
+   linden["fibbush"].rewrite["L"] := "['''^^{-F+F+F-|-F+F+F}]"
+   linden["fibbush"].gener := 3
+   linden["fibbush"].length := 3
+   linden["fibbush"].axiom := "A"
+   linden["fibbush"].angle := 22.5
+   linden["ebush"] := lsys_0l("", table(), 0, 90)
+   linden["ebush"].rewrite["P"] := "I+[P+O]--//[--L]I[++L]-[PO]++PO"
+   linden["ebush"].rewrite["I"] := "FS[//&&L][//^^L]FS"
+   linden["ebush"].rewrite["S"] := "SFS"
+   linden["ebush"].rewrite["L"] := "['{+f-ff-f+|+f-ff-f}]"
+   linden["ebush"].rewrite["O"] := "[&&&D`/W////W////W////W////W]"
+   linden["ebush"].rewrite["D"] := "FF"
+   linden["ebush"].rewrite["W"] := "[`^F][{&&&&-f+f|-f+f}]"
+   linden["ebush"].axiom := "P"
+   linden["ebush"].angle := 18.0
+   linden["ebush"].gener := 3
+   linden["ebush"].length := 3
+   linden["bush"] := lsys_0l("", table(), 0, 90)
+   linden["bush"].rewrite["F"] := "FF-[-F+F+F]+[+F-F-F]"
+   linden["bush"].axiom := "++++F"
+   linden["bush"].angle := 22.5
+   linden["cesaro"] := lsys_0l("", table(), 0, 90)
+   linden["cesaro"].rewrite["X"] := "----F!X!++++++++F!X!----"
+   linden["cesaro"].rewrite["F"] := ""
+   linden["cesaro"].gener := 10
+   linden["cesaro"].length := 3
+   linden["cesaro"].axiom := "FX"
+   linden["cesaro"].angle := 10.58823529
+   linden["curve1"] := lsys_0l("", table(), 0, 90)
+   linden["curve1"].rewrite["F"] := "FF-F-F-F-F-F+F"
+   linden["curve1"].axiom := "F-F-F-F-"
+   linden["curve1"].angle := 90.0
+   linden["curve2"] := lsys_0l("", table(), 0, 90)
+   linden["curve2"].rewrite["F"] := "FF-F+F-F-FF"
+   linden["curve2"].axiom := "F-F-F-F-"
+   linden["curve2"].angle := 90.0
+   linden["curve3"] := lsys_0l("", table(), 0, 90)
+   linden["curve3"].rewrite["F"] := "F-FF--F-F"
+   linden["curve3"].axiom := "F-F-F-F-"
+   linden["curve3"].angle := 90.0
+   linden["curve4"] := lsys_0l("", table(), 0, 90)
+   linden["curve4"].rewrite["X"] := "YF+XF+Y"
+   linden["curve4"].rewrite["Y"] := "XF-YF-X"
+   linden["curve4"].axiom := "YF"
+   linden["curve4"].angle := 60.0
+   linden["curve4"].gener := 5
+   linden["dragon"] := lsys_0l("", table(), 0, 90)
+   linden["dragon"].rewrite["X"] := "-FX++FY-"
+   linden["dragon"].rewrite["Y"] := "+FX--FY+"
+   linden["dragon"].rewrite["F"] := ""
+   linden["dragon"].axiom := "FX"
+   linden["dragon"].angle := 45.0
+   linden["dragon"].gener := 10
+   linden["dragon1"] := lsys_0l("", table(), 0, 90)
+   linden["dragon1"].rewrite["r"] := "-Fl-r"
+   linden["dragon1"].rewrite["l"] := "l+rF+"
+   linden["dragon1"].axiom := "Fl"
+   linden["dragon1"].gener := 14
+   linden["dragonc"] := lsys_0l("", table(), 0, 90)
+   linden["dragonc"].rewrite["X"] := "X-YF-"
+   linden["dragonc"].rewrite["Y"] := "+FX+Y"
+   linden["dragonc"].axiom := "X"
+   linden["dragonc"].angle := 90.0
+   linden["dragonc"].gener := 10
+   linden["fass1"] := lsys_0l("", table(), 0, 90)
+   linden["fass1"].rewrite["R"] := "-LFLF+RFRFR+F+RF-LFL-FR"
+   linden["fass1"].rewrite["L"] := "LF+RFR+FL-F-LFLFL-FRFR+"
+   linden["fass1"].axiom := "-L"
+   linden["fass1"].angle := 90.0
+   linden["fass2"] := lsys_0l("", table(), 0, 90)
+   linden["fass2"].rewrite["R"] := "-LFLFLF+RFR+FL-F-LF+RFR+FLF+RFRF-LFL-FRFR"
+   linden["fass2"].rewrite["L"] := "LFLF+RFR+FLFL-FRF-LFL-FR+F+RF-LFL-FRFRFR+"
+   linden["fass2"].axiom := "-L"
+   linden["fass2"].angle := 90.0
+   linden["flake3"] := lsys_0l("", table(), 0, 90)
+   linden["flake3"].rewrite["X"] := "++FXFY--FX--FY"
+   linden["flake3"].rewrite["Y"] := "FYFX+++FYFX++FX++FYFX|+FX--FY--FXFY++"
+   linden["flake3"].rewrite["F"] := ""
+   linden["flake3"].axiom := "FX"
+   linden["flake3"].angle := 30.0
+   linden["flake3"].gener := 10
+   linden["hilbert"] := lsys_0l("", table(), 0, 90)
+   linden["hilbert"].rewrite["X"] := "-YF+XFX+FY-"
+   linden["hilbert"].rewrite["Y"] := "+XF-YFY-FX+"
+   linden["hilbert"].axiom := "X"
+   linden["hilbert"].angle := 90.0
+   linden["hilbert"].gener := 10
+   linden["island1"] := lsys_0l("", table(), 0, 90)
+   linden["island1"].rewrite["F"] := "FFFF-F+F+F-F[-FF+F+FF+F]FF"
+   linden["island1"].axiom := "F+F+F+F"
+   linden["island1"].angle := 90.0
+   linden["island2"] := lsys_0l("", table(), 0, 90)
+   linden["island2"].rewrite["F"] := "F+F-FF-F-FF++FF-F+FF+F+FF--FFF"
+   linden["island2"].axiom := "F+F+F+F"
+   linden["island2"].angle := 90.0
+   linden["island2"].gener := 4
+   linden["island2"].length := 2
+   linden["koch1"] := lsys_0l("", table(), 0, 90)
+   linden["koch1"].rewrite["F"] := "F+F--F+F"
+   linden["koch1"].axiom := "F--F--F"
+   linden["koch1"].angle := 60.0
+   linden["koch1"].gener := 4
+   linden["koch1"].length := 4
+   linden["koch2"] := lsys_0l("", table(), 0, 90)
+   linden["koch2"].rewrite["F"] := "-F+++F---F+"
+   linden["koch2"].axiom := "F---F---F---F"
+   linden["koch2"].angle := 30.0
+   linden["koch2"].gener := 6
+   linden["koch2"].length := 4
+   linden["koch3"] := lsys_0l("", table(), 0, 90)
+   linden["koch3"].rewrite["F"] := "F-F+F+FF-F-F+F"
+   linden["koch3"].axiom := "F-F-F-F"
+   linden["koch3"].angle := 90.0
+   linden["koch3"].gener := 6
+   linden["koch3"].length := 4
+   linden["koch4"] := lsys_0l("", table(), 0, 90)
+   linden["koch4"].rewrite["F"] := "+F--F++F-"
+   linden["koch4"].axiom := "F++++F++++F"
+   linden["koch4"].angle := 30.0
+   linden["koch4"].gener := 5
+   linden["koch4"].length := 3
+   linden["koch5"] := lsys_0l("", table(), 0, 90)
+   linden["koch5"].rewrite["F"] := "F+F-F-FFF+F+F-F"
+   linden["koch5"].axiom := "F+F+F+F"
+   linden["koch5"].angle := 90.0
+   linden["koch6"] := lsys_0l("", table(), 0, 90)
+   linden["koch6"].rewrite["F"] := "F-FF+FF+F+F-F-FF+F+F-F-FF-FF+F"
+   linden["koch6"].axiom := "F+F+F+F"
+   linden["koch6"].angle := 90.0
+   linden["koch7"] := lsys_0l("", table(), 0, 90)
+   linden["koch7"].rewrite["F"] := "F+F-F+F+F"
+   linden["koch7"].axiom := "F+F+F+F"
+   linden["koch7"].gener := 4
+   linden["koch8"] := lsys_0l("", table(), 0, 90)
+   linden["koch8"].rewrite["F"] := "F+F--F+F"
+   linden["koch8"].axiom := "F"
+   linden["koch8"].angle := 60.0
+   linden["lakeisle"] := lsys_0l("", table(), 0, 90)
+   linden["lakeisle"].rewrite["F"] := "F-f+FF-F-FF-Ff-FF+f-FF+F+FF+Ff+FFF"
+   linden["lakeisle"].rewrite["f"] := "ffffff"
+   linden["lakeisle"].axiom := "F-F-F-F"
+   linden["lakeisle"].gener := 2
+   linden["leaf1"] := lsys_0l("", table(), 0, 90)
+   linden["leaf1"].rewrite["H"] := "J"
+   linden["leaf1"].rewrite["P"] := "X"
+   linden["leaf1"].rewrite["X"] := "F[+AAAA]FY"
+   linden["leaf1"].rewrite["E"] := "H"
+   linden["leaf1"].rewrite["B"] := "E"
+   linden["leaf1"].rewrite["J"] := "Y"
+   linden["leaf1"].rewrite["O"] := "P"
+   linden["leaf1"].rewrite["A"] := "N"
+   linden["leaf1"].rewrite["Y"] := "F[-BBBB]FX"
+   linden["leaf1"].rewrite["N"] := "O"
+   linden["leaf1"].axiom := "X"
+   linden["leaf1"].angle := 45.0
+   linden["leaf1"].gener := 10
+   linden["leaf2"] := lsys_0l("", table(), 0, 90)
+   linden["leaf2"].rewrite["X"] := "A"
+   linden["leaf2"].rewrite["B"] := "F[-Y]FA"
+   linden["leaf2"].rewrite["A"] := "F[+X]BF"
+   linden["leaf2"].rewrite["Y"] := "B"
+   linden["leaf2"].axiom := "A"
+   linden["leaf2"].angle := 45.0
+   linden["leaf2"].gener := 14
+   linden["peano1"] := lsys_0l("", table(), 0, 90)
+   linden["peano1"].rewrite["F"] := "F-F+F+F+F-F-F-F+F"
+   linden["peano1"].axiom := "F-F-F-F"
+   linden["peano1"].angle := 90.0
+   linden["peano2"] := lsys_0l("", table(), 0, 90)
+   linden["peano2"].rewrite["X"] := "XY-F-FXY++F++FXY"
+   linden["peano2"].rewrite["Y"] := "-F-FXY"
+   linden["peano2"].axiom := "FXY++F++FXY++F"
+   linden["peano2"].angle := 45.0
+   linden["peano2"].gener := 4
+   linden["peano2"].length := 7
+   linden["peano3"] := lsys_0l("", table(), 0, 90)
+   linden["peano3"].rewrite["X"] := "XFYFX+F+YFXFY-F-XFYFX"
+   linden["peano3"].rewrite["Y"] := "YFXFY-F-XFYFX+F+YFXFY"
+   linden["peano3"].axiom := "X"
+   linden["peano3"].angle := 90.0
+   linden["penrose1"] := lsys_0l("", table(), 0, 90)
+   linden["penrose1"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose1"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose1"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose1"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose1"].rewrite["F"] := ""
+   linden["penrose1"].axiom := "+WF--XF---YF--ZF"
+   linden["penrose1"].angle := 36.0
+   linden["penrose2"] := lsys_0l("", table(), 0, 90)
+   linden["penrose2"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose2"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose2"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose2"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose2"].rewrite["F"] := ""
+   linden["penrose2"].axiom := "++ZF----XF-YF----WF"
+   linden["penrose2"].angle := 36.0
+   linden["penrose2"].gener := 5
+   linden["penrose2"].length := 10
+   linden["penrose3"] := lsys_0l("", table(), 0, 90)
+   linden["penrose3"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose3"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose3"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose3"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose3"].rewrite["F"] := ""
+   linden["penrose3"].axiom := "[X]++[X]++[X]++[X]++[X]"
+   linden["penrose3"].angle := 36.0
+   linden["penrose3"].gener := 5
+   linden["penrose3"].length := 10
+   linden["penrose4"] := lsys_0l("", table(), 0, 90)
+   linden["penrose4"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrose4"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrose4"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrose4"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrose4"].rewrite["F"] := ""
+   linden["penrose4"].axiom := "[Y]++[Y]++[Y]++[Y]++[Y]"
+   linden["penrose4"].angle := 36.0
+   linden["penrose4"].gener := 5
+   linden["penrose4"].length := 10
+   linden["penrosed"] := lsys_0l("", table(), 0, 90)
+   linden["penrosed"].rewrite["X"] := "+YF--ZF[---WF--XF]+"
+   linden["penrosed"].rewrite["Z"] := "--YF++++WF[+ZF++++XF]--XF"
+   linden["penrosed"].rewrite["W"] := "YF++ZF----XF[-YF----WF]++"
+   linden["penrosed"].rewrite["Y"] := "-WF++XF[+++YF++ZF]-"
+   linden["penrosed"].rewrite["F"] := ""
+   linden["penrosed"].axiom := "[X][Y]++[X][Y]++[X][Y]++[X][Y]++[X][Y]"
+   linden["penrosed"].angle := 36.0
+   linden["penrosed"].length := 40
+   linden["plant01"] := lsys_0l("", table(), 0, 90)
+   linden["plant01"].rewrite["F"] := "F[+F]F[-F]F"
+   linden["plant01"].axiom := "F"
+   linden["plant01"].angle := 25.71428571
+   linden["plant01"].gener := 10
+   linden["plant02"] := lsys_0l("", table(), 0, 90)
+   linden["plant02"].rewrite["F"] := "F[+F]F[-F][F]"
+   linden["plant02"].axiom := "F"
+   linden["plant02"].angle := 20.0
+   linden["plant03"] := lsys_0l("", table(), 0, 90)
+   linden["plant03"].rewrite["F"] := "FF-[-F+F+F]+[+F-F-F]"
+   linden["plant03"].axiom := "F"
+   linden["plant03"].angle := 22.5
+   linden["plant03"].gener := 4
+   linden["plant04"] := lsys_0l("", table(), 0, 90)
+   linden["plant04"].rewrite["X"] := "F[+X]F[-X]+X"
+   linden["plant04"].rewrite["F"] := "FF"
+   linden["plant04"].axiom := "X"
+   linden["plant04"].angle := 20.0
+   linden["plant04"].gener := 5
+   linden["plant05"] := lsys_0l("", table(), 0, 90)
+   linden["plant05"].rewrite["X"] := "F[+X][-X]FX"
+   linden["plant05"].rewrite["F"] := "FF"
+   linden["plant05"].axiom := "X"
+   linden["plant05"].angle := 25.71428571
+   linden["plant05"].gener := 5
+   linden["plant06"] := lsys_0l("", table(), 0, 90)
+   linden["plant06"].rewrite["X"] := "F-[[X]+X]+F[+FX]-X"
+   linden["plant06"].rewrite["F"] := "FF"
+   linden["plant06"].axiom := "X"
+   linden["plant06"].angle := 22.5
+   linden["plant06"].gener := 5
+   linden["plant07"] := lsys_0l("", table(), 0, 90)
+   linden["plant07"].rewrite["X"] := "X[-FFF][+FFF]FX"
+   linden["plant07"].rewrite["Z"] := "ZFX[+Z][-Z]"
+   linden["plant07"].axiom := "Z"
+   linden["plant07"].angle := 25.71428571
+   linden["plant07"].gener := 5
+   linden["plant08"] := lsys_0l("", table(), 0, 90)
+   linden["plant08"].rewrite["S"] := "[+++Z][---Z]TS"
+   linden["plant08"].rewrite["H"] := "-Z[+H]L"
+   linden["plant08"].rewrite["Z"] := "+H[-Z]L"
+   linden["plant08"].rewrite["L"] := "[-FFF][+FFF]F"
+   linden["plant08"].rewrite["T"] := "TL"
+   linden["plant08"].axiom := "SLFFF"
+   linden["plant08"].angle := 18.0
+   linden["plant08"].gener := 6
+   linden["plant08"].length := 8
+   linden["plant09"] := lsys_0l("", table(), 0, 90)
+   linden["plant09"].rewrite["X"] := "X[-FFF][+FFF]FX"
+   linden["plant09"].rewrite["Y"] := "YFX[+Y][-Y]"
+   linden["plant09"].axiom := "Y"
+   linden["plant09"].angle := 25.71428571
+   linden["plant09"].gener := 5
+   linden["plant10"] := lsys_0l("", table(), 0, 90)
+   linden["plant10"].rewrite["F"] := "F[+FF][-FF]F[+FF][-FF]F"
+   linden["plant10"].axiom := "F"
+   linden["plant10"].angle := 36.0
+   linden["plant10"].gener := 3
+   linden["plant11"] := lsys_0l("", table(), 0, 90)
+   linden["plant11"].rewrite["F"] := "F[+F[+F][-F]F][-F[+F][-F]F]F[+F][-F]F"
+   linden["plant11"].axiom := "F"
+   linden["plant11"].angle := 30.0
+   linden["plant11"].gener := 3
+   linden["plant11"].length := 10
+   linden["quadgos"] := lsys_0l("", table(), 0, 90)
+   linden["quadgos"].rewrite["R"] := "+FLFL-FR-FR+FL+FLFR+FL-FRFR-FL-FR+FLFRFR-FL-FRFL+FL+FR-FR-FL+FL+FRFR"
+   linden["quadgos"].rewrite["L"] := "FLFL-FR-FR+FL+FL-FR-FRFL+FR+FLFLFR-FL+FR+FLFL+FR-FLFR-FR-FL+FL+FRFR-"
+   linden["quadgos"].rewrite["F"] := ""
+   linden["quadgos"].axiom := "-FR"
+   linden["quadgos"].angle := 90.0
+   linden["quadkoch"] := lsys_0l("", table(), 0, 90)
+   linden["quadkoch"].rewrite["F"] := "F+FF-FF-F-F+F+FF-F-F+F+FF+FF-F"
+   linden["quadkoch"].axiom := "FX++FX++FX++FX++FX"
+   linden["quadkoch"].angle := 90.0
+   linden["quartet"] := lsys_0l("", table(), 0, 90)
+   linden["quartet"].rewrite["H"] := "-"
+   linden["quartet"].rewrite["B"] := "FB+FA-FB-JFBFA"
+   linden["quartet"].rewrite["J"] := "+"
+   linden["quartet"].rewrite["A"] := "FBFA+HFA+FB-FA"
+   linden["quartet"].rewrite["F"] := ""
+   linden["quartet"].axiom := "FB"
+   linden["quartet"].angle := 90.0
+   linden["quartet"].gener := 8
+   linden["sier1"] := lsys_0l("", table(), 0, 90)
+   linden["sier1"].rewrite["X"] := "+FXF-FXF-FXF+"
+   linden["sier1"].rewrite["F"] := "FXF"
+   linden["sier1"].axiom := "F"
+   linden["sier1"].angle := 120.0
+   linden["sier1"].gener := 5
+   linden["sier2"] := lsys_0l("", table(), 0, 90)
+   linden["sier2"].rewrite["X"] := "--FXF++FXF++FXF--"
+   linden["sier2"].rewrite["F"] := "FF"
+   linden["sier2"].axiom := "FXF--FF--FF"
+   linden["sier2"].angle := 60.0
+   linden["sier2"].gener := 5
+   linden["sier3"] := lsys_0l("", table(), 0, 90)
+   linden["sier3"].rewrite["F"] := "F[-F]F"
+   linden["sier3"].axiom := "F-F-F"
+   linden["sier3"].angle := 120.0
+   linden["sier3"].gener := 5
+   linden["siersqar"] := lsys_0l("", table(), 0, 90)
+   linden["siersqar"].rewrite["F"] := "FF+F+F+F+FF"
+   linden["siersqar"].axiom := "F+F+F+F"
+   linden["siersqar"].angle := 90.0
+   linden["siersqar"].gener := 4
+   linden["snoflake"] := lsys_0l("", table(), 0, 90)
+   linden["snoflake"].rewrite["F"] := "F-F+F+F-F"
+   linden["snoflake"].axiom := "+F"
+   linden["snoflake"].gener := 4
+   linden["space1"] := lsys_0l("", table(), 0, 90)
+   linden["space1"].rewrite["X"] := "YFXFY+F+YFXFY-F-XFYFX"
+   linden["space1"].rewrite["Y"] := "YFXFY-F-XFYFX+F+YFXFY"
+   linden["space1"].axiom := "X"
+   linden["space1"].gener := 3
+   linden["sphinx"] := lsys_0l("", table(), 0, 90)
+   linden["sphinx"].rewrite["X"] := "+FF-YFF+FF--FFFXF--YFFFYFFF"
+   linden["sphinx"].rewrite["G"] := "GG"
+   linden["sphinx"].rewrite["Y"] := "-FF+XFF-FF++FFFYF++XFFFXFFF"
+   linden["sphinx"].rewrite["F"] := "GG"
+   linden["sphinx"].axiom := "X"
+   linden["sphinx"].angle := 60.0
+   linden["sphinx"].gener := 5
+   linden["sqgasket"] := lsys_0l("", table(), 0, 90)
+   linden["sqgasket"].rewrite["X"] := "+FXF+FXF+FXF+FXF"
+   linden["sqgasket"].rewrite["F"] := "FF"
+   linden["sqgasket"].axiom := "X"
+   linden["sqgasket"].angle := 90.0
+   linden["sqgasket"].gener := 5
+   linden["square"] := lsys_0l("", table(), 0, 90)
+   linden["square"].rewrite["F"] := "FF+F+F+F+FF"
+   linden["square"].axiom := "F+F+F+F"
+   linden["square"].angle := 90.0
+   linden["tile"] := lsys_0l("", table(), 0, 90)
+   linden["tile"].rewrite["X"] := "[F+F+F+F[---X-Y]+++++F++++++++F-F-F-F]"
+   linden["tile"].rewrite["Y"] := "[F+F+F+F[---Y]+++++F++++++++F-F-F-F]"
+   linden["tile"].axiom := "X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X+X"
+   linden["tile"].angle := 15.0
+   linden["tile"].length := 10
+   linden["tree"] := lsys_0l("", table(), 0, 90)
+   linden["tree"].rewrite["X"] := "[-FX]+FX"
+   linden["tree"].axiom := "+++FX"
+   linden["tree"].angle := 30.0
+   linden["tree"].gener := 8
+   linden["tree"].length := 10
+   linden["tree1"] := lsys_0l("", table(), 0, 90)
+   linden["tree1"].rewrite["X"] := "[-FX]+FX"
+   linden["tree1"].axiom := "+++FX"
+   linden["tree1"].angle := 30.0
+   linden["tree1"].gener := 5
+   linden["tree1"].length := 8
+   linden["tree2"] := lsys_0l("", table(), 0, 90)
+   linden["tree2"].rewrite["X"] := "+FY"
+   linden["tree2"].rewrite["Y"] := "-FX"
+   linden["tree2"].rewrite["F"] := "FF-[XY]+[XY]"
+   linden["tree2"].axiom := "++++F"
+   linden["tree2"].angle := 22.5
+
+   return linden
+
+end
diff --git a/ipl/gprocs/linddraw.icn b/ipl/gprocs/linddraw.icn
new file mode 100644
index 0000000..5020972
--- /dev/null
+++ b/ipl/gprocs/linddraw.icn
@@ -0,0 +1,63 @@
+############################################################################
+#
+#	File:     linddraw.icn
+#
+#	Subject:  Procedure to draw L-System strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure draws strings of characters produced by
+#  L-systems.
+#
+############################################################################
+#
+#  Links:  lindgen, turtle, graphics
+#
+############################################################################
+
+link lindgen
+link turtle
+link graphics
+
+#  The drawing is based on the axiom and the rewriting rules.  The other
+#  parameters are the line length, the angle delta between lines, and
+#  the number of generations.  Drawing starts at x,y.
+
+procedure linddraw(		#: draw L-system
+   x, y, axiom, rewrite, length, delta, gener, delay
+   )
+   local c
+
+   /x := (WAttrib(\&window, "width") / 2) | 250
+   /y := (WAttrib(\&window, "height") / 2) | 250
+   /length := 5
+   /delta := 90
+
+   TReset()
+   TGoto(x, y)
+
+   every c := lindgen(!axiom, rewrite, gener) do {
+      WDelay(delay)
+      case c of {
+         "F":   TDraw(length)			# draw forward
+         "f":   TSkip(length)			# skip forward
+         "+":   TRight(delta)			# turn right
+         "-":   TLeft(delta)			# turn left
+         "[":   TSave()				# save state
+         "]":   TRestore()			# restore state
+         }					# ignore other characters
+      }
+
+   WFlush()
+
+   return
+
+end
diff --git a/ipl/gprocs/lindrec.icn b/ipl/gprocs/lindrec.icn
new file mode 100644
index 0000000..5290630
--- /dev/null
+++ b/ipl/gprocs/lindrec.icn
@@ -0,0 +1,22 @@
+############################################################################
+#
+#	File:     lindrec.icn
+#
+#	Subject:  Declarations for L-systems
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 18, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These declarations are provided for representing Lindenmayer systems
+#  as records.
+#
+############################################################################
+
+record lsys_0l(axiom, rewrite, gener, angle, length, x, y, color)
diff --git a/ipl/gprocs/lindterp.icn b/ipl/gprocs/lindterp.icn
new file mode 100644
index 0000000..2f01f1a
--- /dev/null
+++ b/ipl/gprocs/lindterp.icn
@@ -0,0 +1,73 @@
+############################################################################
+#
+#	File:     lindterp.icn
+#
+#	Subject:  Procedure to interpret and draw L-System strings
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure interpreters strings of characters produced by
+#  L-Systems and draws them using turtle graphics.
+#
+############################################################################
+#
+#  Links:  lindrec, lindgen, turtle
+#
+############################################################################
+
+link lindrec
+link lindgen
+link turtle
+
+global size
+
+#  length is the length of line segments and delta is the amount of
+#  direction change.
+
+procedure lindterp(x, y, lsys, gener, length, color, fnc)
+   local rewrite, delta, axiom, symbols, c
+
+   /size := 500
+   /x := size / 2
+   /y := size / 2
+   rewrite := lsys.rewrite
+   axiom := lsys.axiom
+   delta := lsys.delta
+   /gener := lsys.gener
+   /length := lsys.length
+
+#  The table symbols contains definitions for other symbols as
+#  string of other characters.  It remains to be seen how this
+#  will be represented.  Note also there is a potential for
+#  circularity and unbounded recursion.
+
+   symbols := table()				# table of defined symbols
+
+   TReset()
+   TGoto(x, y)
+
+   every c := lindgen(!axiom, rewrite, gener) do
+      case c of {
+         "F":   TDraw(length)			# draw forward
+         "f":   TSkip(length)			# skip forward
+         "+":   TRight(delta)			# turn right
+         "-":   TLeft(delta)			# turn left
+         "[":   TSave()				# save state
+         "]":   TRestore()			# restore state
+						# interpret defined symbol
+         default:   lindterp(\symbols[c], length, delta)
+         }					# ignore other characters
+
+   WFlush()
+
+   return
+
+end
diff --git a/ipl/gprocs/lsystem.icn b/ipl/gprocs/lsystem.icn
new file mode 100644
index 0000000..b6ef102
--- /dev/null
+++ b/ipl/gprocs/lsystem.icn
@@ -0,0 +1,181 @@
+############################################################################
+#
+#       File:     lsystem.icn
+#
+#	Subject:  Procedures for Lindenmayer systems support
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#   Comments: This package is the collection of routines
+#      developed to facilitate experiments with L-systems,
+#      including the interpretation of strings as turtle
+#      graphics commands.
+#
+#      Only rudimentary L-systems are currently implemented.
+#	users are encouraged to extend this system.
+#
+############################################################################
+#
+#	Requires:  Version 9 graphics, co-expressions (for glib.icn)
+#
+############################################################################
+#
+#	Links: glib
+#
+############################################################################
+
+link glib
+record Lsys(order, dist, delta, axiom, rewrite)
+
+# lsmap(s1,T) - replace, in s1, occurrences of character key values in T
+#     with assigned value for that key.  (Suitable for l-system rules!)
+#
+procedure lsmap(s1,T)
+   local s
+
+   if type(T) ~== "table" then
+      stop("lsmap() - second argument not a table!")
+
+   s := ""
+   s1 ? while s ||:= (\T[move(1)] | move(1))
+
+   return s
+end
+
+# mk_map(L) - build a rewriting map table from list L
+#
+procedure mk_map(L)
+   local a, t
+
+   t := table()
+   every a := !L do {
+      t[a[1]] := a[2]
+      }
+
+   return t
+end
+      
+# read_Lsystem(f) - read in an L system from a file...
+#
+#      Form for an L_system:
+#
+#	order: n
+#	delta: angle
+#	axiom: string
+#	map:   c = string
+#
+procedure read_Lsystem(f)
+   local ls, line, next_token
+
+   ls := Lsys(0,10,90,"",table())
+
+   while line := read(f) do {
+      next_token := create gen_tokens(line)
+
+      case map(@next_token) of {
+         "order:": ls.order := integer(@next_token)
+         "dist:" : ls.dist  := integer(@next_token)
+         "delta:": ls.delta := numeric(@next_token)
+	 "axiom:": ls.axiom := @next_token
+	 "map:"  : ls.rewrite[@next_token] := (@next_token, @next_token)
+         }
+      }
+
+   return ls
+end
+
+
+# write_Lsystem(ls) - display L-system ls (for debugging, mainly)
+#
+procedure  write_Lsystem(ls)
+   write("L-system:")
+   write("\torder: ",ls.order)
+   write("\t dist: ",ls.dist)
+   write("\tdelta: ",ls.delta)
+   write("\taxiom: ",ls.axiom)
+   every key := key(ls.rewrite) do
+       write("\t  map: ",key," -> ",ls.rewrite[key])
+   return
+end
+
+
+# build_cmd(ls) - return the command string for
+#	l-system ls
+#
+procedure build_cmd(ls)
+   local s
+
+   s := ls.axiom
+   every 1 to ls.order do
+      s := lsmap(s, ls.rewrite)
+   return s
+
+end
+
+# eval_cmd(s) - apply turtle t to command string
+#
+procedure eval_cmd(t,s,dist,delta)
+
+   s ? while obey(t,move(1), dist, delta)
+
+   return
+end
+         
+
+# eval_lsys(t,ls,dist,delta) - apply turtle t directly to
+#    an Lsystem avoids constructing full Lsystem string
+#    at once (i.e. no need to call build_cmd).
+#
+procedure eval_lsys(t,ls)
+   evaluate(t,ls.axiom, ls.rewrite, ls.order, ls.delta, ls.dist)
+end
+
+# evaluate(t,s, Ls_map, n, delta, dist) - recursive l-system evaluation
+#   (avoids building entire command string)
+procedure evaluate(t, s, Ls_map, n, delta, dist)
+
+    if n = 0 then return eval_cmd(t,s,dist,delta)
+
+    s ? while evaluate(t, lsmap(move(1), Ls_map), Ls_map, n-1, delta, dist)
+    return
+end
+
+# obey(t, c, dist, delta) - execute the appropriate turtle command
+#      using turtle t.   (INCOMPLETE) (this is where L-systems could
+#      be greatly extended.)
+procedure obey(t, c, dist, delta)
+
+    case c of {
+       "f" : Move_Forward(t, dist)
+       "+" : Left(t, delta)
+       "-" : Right(t, delta)
+       default: Line_Forward(t, dist)
+       }
+
+   return
+end
+
+# get_tokens(s) - suspend the tokens in string s
+#
+procedure gen_tokens(s, ws)
+   local nws
+   
+   /ws := ' \t'
+   nws := ~ws
+
+   s ? while tab(upto(nws)) do
+          suspend tab(many(nws)) \ 1
+
+end
diff --git a/ipl/gprocs/mapnav.icn b/ipl/gprocs/mapnav.icn
new file mode 100644
index 0000000..c72ef65
--- /dev/null
+++ b/ipl/gprocs/mapnav.icn
@@ -0,0 +1,320 @@
+############################################################################
+#
+#	File:     mapnav.icn
+#
+#	Subject:  Procedures for navigating a map interactively
+#
+#	Authors:  Gregg M. Townsend
+#
+#	Date:     May 7, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement a user interface for browsing a map
+#	that is drawn using a simple rectangular projection.  The
+#	following interface actions are provided, if not overridden
+#	by the calling program:
+#	   The arrow keys pan the display.
+#	   Shifted arrows pan by a smaller amount.
+#	   The + and - keys zoom in and out.
+#	   The 0, 1, or HOME key resets the original display.
+#	   The q key causes an immediate exit.
+#	   Sweeping a region with the mouse zooms the display.
+#	   Resizing the window causes it to be redrawn.
+#
+#	The calling program provides the main loop and a drawing
+#	procedure; this module handles the interface and computes
+#	the output transformation.
+#
+#	mapinit(win, proc, arg, xleft, xright, ytop, ybottom, m) initializes.
+#	mapgen(win, proc, arg) generates the map by invoking the callback.
+#	mapevent(win, e) handles a window event, possibly invoking a callback.
+#	mapproj(win) returns the projection used in the window.
+#
+#	The win argument is optional in all procedures but can be used
+#	to supply the correct graphics context.  The window argument is
+#	always supplied to the callback procedure.
+#
+############################################################################
+#
+#	Typical use is like this:
+#
+#	procedure main(...)
+#	   ... initialize ...
+#	   ... load data ...
+#	   ... open window ...
+#	   mapinit(draw, ...)
+#	   mapgen()
+#	   case e := Event() of {
+#	      ... handle custom events ...
+#	      default: mapevent(e)
+#	      }
+#	end
+#
+#	procedure draw(win, p, arg)
+#	   ... create list of coordinates ...
+#	   ... L2 := project(p, L1) ...
+#	   ... draw map ...
+#	end
+#
+############################################################################
+#
+#	mapinit(win, proc, arg, xleft, xright, ytop, ybottom, m) configures
+#	the navigator.  proc is a drawing procedure to be called whenever
+#	the window needs to be redrawn.  arg is an arbitrary value to be
+#	passed to proc along with the transformation parameters.
+#
+#	xleft, xright, ytop, and ybottom specify the range of coordinates
+#	for the data that is to be displayed.  For both the x and y pairs,
+#	the values must differ but either can be the greater.
+#
+#	The value of m (default 1.0) specifies the aspect ratio of the
+#	input units.  If the input data is in units of latitude and
+#	longitude, choose a central latitude for projection and pass
+#	the cosine of that latitude as m.
+#
+############################################################################
+#
+#	mapgen(win, proc, arg) calls the drawing procedure proc to draw a
+#	map.  win is optional, and proc and arg default to the values
+#	registered by the last mapinit() call.
+#
+#	The drawing procedure is called as
+#	   proc(win, pj, arg)
+#       where pj the projection returned by mapproj(win).
+#
+#	The drawing procedure should project and display its data.
+#	It must ensure that the resulting coordinates lie inside
+#	the range -32768 <= v <=32767 before passing them to Icon
+#	drawing functions.  (See also clipping.icn.)
+#
+############################################################################
+#
+#	mapevent(win, e) handles a window event.  If e is recognized as
+#	an interface action, the map parameters are altered and mapgen()
+#	is called, resulting in a call to the drawing procedure.  For
+#	a panning action, the window contents are first shifted;
+#	otherwise, the window is first erased.  mapevent() fails if
+#	e is not recognized.
+#
+#	The calling program can intercept and override any action it does
+#	not want handled by the navigator.  This can be used to customize
+#	the interface -- for example, to use "0" for something other than
+#	"reset zooming".  However, any &resize event, even if handled by
+#	the caller, should be passed to the navigator to allow it to
+#	properly adjust its view of the world.
+#
+############################################################################
+#
+#	mapproj(win) returns a rectangular projection (see cartog.icn)
+#	that maximizes the display of the currently selected data range
+#	for viewing in the center of window win.  The "selected data range"
+#	is that passed to mapinit() and subsequently modified by any
+#	zooming or panning actions.
+#
+############################################################################
+#
+#   Links: graphics, cartog
+#
+############################################################################
+
+$include "keysyms.icn"
+
+link graphics
+link cartog
+
+$define MARGIN 16
+
+global mnv_proc			# registered drawing procedure
+global mnv_arg			# arbitrary argument for that procedure
+global mnv_aspr			# coordinate system aspect ratio
+
+global mnv_prjn			# current projection
+
+# map limits
+global mnv_mleft, mnv_mright, mnv_mtop, mnv_mbottom
+
+# viewport configuration
+global mnv_vleft, mnv_vright, mnv_vtop, mnv_vbottom
+
+procedure mapinit(win,p,a,xleft,xright,ytop,ybottom,m)	#: initialize navigator
+
+   if type(win) ~== "window" then	# handle missing optional win argument
+      return mapinit((\&window | runerr(140)),
+         win, p, a, xleft, xright, ytop, ybottom)
+
+   mnv_proc := p
+   mnv_arg := a
+   mnv_aspr := \m | 1.0
+
+   mnv_mleft := mnv_vleft := xleft
+   mnv_mright := mnv_vright := xright
+   mnv_mtop := mnv_vtop := ytop
+   mnv_mbottom := mnv_vbottom := ybottom
+
+   return
+end
+
+procedure mapgen(win, proc, arg)	#: invoke callback to redraw the map
+
+   if type(win) ~== "window" then {	# handle missing optional win argument
+      win :=: proc :=: arg
+      win := \&window | runerr(140)
+      }
+
+   /proc := mnv_proc
+   /arg := mnv_arg
+   return proc(win, mapproj(win), arg)
+end
+
+procedure mapproj(win)			#: compute map projection
+   local l, r, t, b, d, nx, ny, xmul, ymul
+
+   /win := \&window | runerr(140)	# handle missing optional win argument
+
+   l := \WAttrib(win, "clipx") | 0
+   t := \WAttrib(win, "clipy") | 0
+   r := l + \WAttrib(win, "clipw" | "width")
+   b := t + \WAttrib(win, "cliph" | "height")
+   nx := MARGIN
+   ny := MARGIN
+
+   xmul := real(r - l - 2 * nx) / (mnv_vright - mnv_vleft)
+   ymul := real(b - t - 2 * ny) / (mnv_vbottom - mnv_vtop)
+
+   d := abs(xmul / (ymul * mnv_aspr))
+   if d > 1.0 then {
+      xmul /:= d
+      nx := (r - l - xmul * (mnv_vright - mnv_vleft)) / 2
+      }
+   else {
+      ymul *:= d
+      ny := (b - t - ymul * (mnv_vbottom - mnv_vtop)) / 2
+      }
+
+   mnv_prjn := rectp(mnv_vleft, mnv_vtop, l + nx, t + ny, xmul, ymul)
+   return mnv_prjn
+end
+
+procedure mapevent(win, e)		#: navigate map as directed by action e
+   local win2, xywh, ltrb
+
+   if type(win) ~== "window" then {	# handle missing optional win argument
+      e := win
+      win := \&window | runerr(140)
+      }
+
+   case e of {
+
+      &resize: {
+         EraseArea(win)
+         mapgen(win)
+         }
+
+      &lpress: {
+         win2 := Clone(win, "linewidth=4", "linestyle=solid", "fg=orange")
+         xywh := Sweep(win2)
+         Uncouple(win2)
+         if xywh[3|4] < 10 then
+            return
+         xywh[3] +:= xywh[1]
+         xywh[4] +:= xywh[2]
+         ltrb := project(invp(mnv_prjn), xywh)
+
+         mnv_vleft := get(ltrb)
+         mnv_vtop := get(ltrb)
+         mnv_vright := get(ltrb)
+         mnv_vbottom := get(ltrb)
+         EraseArea(win)
+         mapgen(win)
+         }
+
+      !"01" | Key_Home: {
+         mnv_vleft := mnv_mleft
+         mnv_vright := mnv_mright
+         mnv_vtop := mnv_mtop
+         mnv_vbottom := mnv_mbottom
+         EraseArea(win)
+         mapgen(win)
+         }
+
+      Key_Up:    mnv_pan(win,  0, -1)
+      Key_Down:  mnv_pan(win,  0, +1)
+      Key_Left:  mnv_pan(win, -1,  0)
+      Key_Right: mnv_pan(win, +1,  0)
+
+      !"+=":  mnv_inout(win, -0.20)
+      !"-_":  mnv_inout(win, +0.25)
+
+      !"Qq":  exit()
+
+      default:	fail
+
+      }
+
+   return
+end
+
+procedure mnv_pan(win, px, py)		# process panning action
+   local n, l, r, t, b, w, h, nx, ny, dx, dy, xyxy
+
+   n := if &shift then 10 else 100
+   nx := n * px
+   ny := n * py
+
+   l := \WAttrib(win, "clipx") | 0
+   t := \WAttrib(win, "clipy") | 0
+   r := l + \WAttrib(win, "clipw" | "width")
+   b := t + \WAttrib(win, "cliph" | "height")
+   w := r - l - abs(nx)
+   h := b - t - abs(ny)
+
+   if nx > 0 then {
+      CopyArea(win, l + nx, t, w, h, l, t)
+      EraseArea(win, r - nx, t, nx, h)
+      }
+   else if nx < 0 then {
+      CopyArea(win, l, t, w, h, l - nx, t)
+      EraseArea(win, l, t, -nx, h)
+      }
+
+   if ny > 0 then {
+      CopyArea(win, l, t + ny, w, h, l, t)
+      EraseArea(win, l, b - ny, w, ny)
+      }
+   else if ny < 0 then {
+      CopyArea(win, l, t, w, h, l, t - ny)
+      EraseArea(win, l, t, w, -ny)
+      }
+
+   xyxy := project(invp(mnv_prjn), [l, t, l + nx, t + ny])
+   dx := xyxy[3] - xyxy[1]
+   dy := xyxy[4] - xyxy[2]
+   mnv_vleft +:= dx
+   mnv_vright +:= dx
+   mnv_vtop +:= dy
+   mnv_vbottom +:= dy
+   mapgen(win)
+
+   return
+end
+
+procedure mnv_inout(win, f)		# process zooming action
+   local xc, yc
+
+   xc := (mnv_vleft + mnv_vright) / 2
+   yc := (mnv_vtop + mnv_vbottom) / 2
+
+   mnv_vleft +:= f * (mnv_vleft - xc)
+   mnv_vright +:= f * (mnv_vright - xc)
+   mnv_vtop +:= f * (mnv_vtop - yc)
+   mnv_vbottom +:= f * (mnv_vbottom - yc)
+
+   EraseArea(win)
+   mapgen(win)
+   return
+end
diff --git a/ipl/gprocs/mirror.icn b/ipl/gprocs/mirror.icn
new file mode 100644
index 0000000..fd1076e
--- /dev/null
+++ b/ipl/gprocs/mirror.icn
@@ -0,0 +1,66 @@
+############################################################################
+#
+#	File:     mirror.icn
+#
+#	Subject:  Procedure to mirror tile
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 15, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  mirror(win)	mirrors win using p2mm symmetry and returns the result as a
+#		hidden window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure mirror(win, x, y, w, h)	# mirror with p2mm symmetry
+   local width, height, sym, x1, y1
+
+   /win := &window
+   /x := 0
+   /y := 0
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+
+   if w < 0 then {
+      w := -w
+      x -:= w
+      }
+
+   if h < 0 then {
+      h := -h
+      y -:= h
+      }
+
+   width := 2 * w
+   height := 2 * h
+
+   sym := WOpen("canvas=hidden", "size=" || width || "," || height) | fail
+
+   CopyArea(win, sym, x, y, w, h)
+
+   every x := 0 to w - 1 do 
+      CopyArea(sym, sym, x, 0, 1, h, width - x - 1, 0)
+
+   every y := 0 to h - 1 do
+      CopyArea(sym, sym, 0, y, width, 1, 0, height - y - 1)
+
+   return sym
+
+end
diff --git a/ipl/gprocs/modlines.icn b/ipl/gprocs/modlines.icn
new file mode 100644
index 0000000..6fe2151
--- /dev/null
+++ b/ipl/gprocs/modlines.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     modlines.icn
+#
+#	Subject:  Procedure to produce trace of modular lines
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 3, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  For a description of the method used here, see
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 90-95.
+#	
+############################################################################
+#
+#  Links:  calls, gobject, gtrace
+#
+############################################################################
+
+link calls
+link gobject
+link gtrace
+
+#  modlines produces a trace of lines between points selected modulo n,
+#  where n is the number of points on a supporting curve.  k is an
+#  offset factor.  A trace of the supporting curve is produced by call.
+#
+procedure modlines(call, m, k, limit)
+   local points, n, i
+
+   /limit := 500			# maximum number of points allowed
+
+   points := point_list(call, limit)
+
+   n := *points				# number of points on supporting curve
+
+   every i := 0 to m do {
+#     i1 := i % n + 1
+#     i2 := (i * k) % n + 1
+      suspend points[(i % n + 1) | ((i * k) % n + 1)]
+      }
+
+end
diff --git a/ipl/gprocs/navitrix.icn b/ipl/gprocs/navitrix.icn
new file mode 100644
index 0000000..ad8a79a
--- /dev/null
+++ b/ipl/gprocs/navitrix.icn
@@ -0,0 +1,279 @@
+############################################################################
+#
+#	File:     navitrix.icn
+#
+#	Subject:  Procedures to perform file navigation
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 10, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This package provides an interface for file navigation.  It is
+#  intended for use with another application with a visual interface.
+#
+############################################################################
+#
+#  The code is based on Unix but may work in other Unix-like environments.
+#
+#  Directories are shown with a trailing slash.  Clicking on a directory
+#  moves there.  Clicking on a file name selects it.  The text of the
+#  button used to dismiss the navigator is put in the global variable
+#  nav_state, while the name of the selected file is put in the global
+#  variable nav_file.
+#
+#  nav_keyboard() processes keyboard shortcuts.  A return character is
+#  equivalent to clicking on the Okay button.  Other characters cause
+#  the top list entry to be positioned at a name that starts with or is
+#  close to the character.
+#
+#  The other application needs only to know this:
+#
+#	The navigator is initialized by calling nav_init().  This opens a
+#	hidden window, assigned to the global variable nav_window, for
+#	the navigator.  It also assigns the navigator root vidget to the
+#	global variable nav_root.
+#
+#	To use the navigator, the other application needs to change the
+#	canvas status nav_window to normal so it can accept user events
+#	and hide it again when it has been "dismissed".  The navigator
+#	puts the selected file in nav_file as mentioned above.
+#
+#	If the application wants to support the navigator's keyboard
+#	shortcuts, it needs to set the shortcut procedure to nav_keyboard
+#	when the navigator window is active.
+#
+#  A typical event loop for using the navigator is:
+#
+#  repeat {			# event loop
+#     case Active() of {
+#        &window   :  {		# application window
+#           root_cur := root
+#           shortcuts_cur := shortcuts
+#           }
+#        nav_window   :  {	# navigation window
+#           root_cur := nav_root
+#           shortcuts_cur := nav_keyboard
+#           }
+#        }
+#     ProcessEvent(root_cur, , shortcuts_cur)
+#     case nav_state of {
+#        &null   :  next
+#        "Okay"  :  load_pattern()
+#        }
+#     nav_state := &null
+#     WAttrib(nav_window, "canvas=hidden")
+#     }
+#
+#  where process_file() is a procedure that does something with the
+#  file.
+#
+#  Note that the value of nav_state determines what needs to be done.  It is
+#  null when the navigator has not been used since the last event.  If
+#  the navigator is dismissed with "Cancel" instead of "Okay", nothing
+#  needs to be done except hide the navigator window and set the nav_state
+#  to null.
+#
+#  Coupled with this is a procedure (or more than one) that makes the
+#  navigator window visible, as in
+#
+#	procedure open_cb()
+#	   WAttrib(nav_window, "canvas=normal")
+#	   ...
+#	   return
+#	end
+#
+#  If there is more than one use of the navigator, the callbacks that
+#  enable it can set process_file to the appropriate companion procedure.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics, UNIX
+#
+############################################################################
+#
+#  Links: vsetup
+#
+############################################################################
+
+link vsetup
+
+$include "keysyms.icn"
+
+global directory
+global dir
+global file_list
+global files
+
+# Globals used to communicate with the application that uses the navigator
+
+global nav_file
+global nav_root
+global nav_state
+global nav_vidgets
+global nav_window
+
+procedure nav_init()
+   local window_save, atts
+
+   window_save := &window		# save current subject window
+   &window := &null			# clear for new subject
+   atts := navig_atts()
+   put(atts, "canvas=hidden")
+   (WOpen ! atts) | stop("*** can't open navigation window")
+   nav_vidgets := navig()		# initialize interface
+   nav_window := &window		# name navigation window
+   &window := window_save 		# restore previous subject window
+
+   files := nav_vidgets["files"]
+   nav_root := nav_vidgets["root"]
+
+   nav_file := &null
+
+   nav_refresh()
+
+   return
+
+end
+
+procedure nav_files_cb(vidget, value)
+   static last_file, last_time
+
+   initial {
+      last_file := ""
+      last_time := 0
+      }
+
+   if /value then {
+      last_time := 0
+      return
+      }
+
+   if value ?:= tab(upto('/')) then {
+      chdir(value)
+      nav_refresh()
+      return
+      }
+
+   nav_file := value
+
+   if (value == last_file) then {
+      last_file := ""
+      nav_state := "Okay"
+      return
+      }
+
+   last_time := 0
+   last_file := value
+
+   return
+
+end
+
+procedure nav_refresh()
+   local ls, input
+   static x, y
+
+   initial {
+      x := nav_vidgets["placeholder"].ax
+      y := nav_vidgets["placeholder"].ay
+      directory := ""
+      }
+
+   input := open("pwd", "p")
+
+   WAttrib( nav_window, "drawop=reverse")
+   DrawString(nav_window, x, y, directory)
+   DrawString(nav_window, x, y, directory := !input)
+   WAttrib(nav_window, "drawop=copy")
+
+   close(input)
+
+   file_list := []
+
+   ls := open("ls -a -p .", "p")
+
+   every put(file_list, !ls)
+
+   VSetItems(files, file_list)
+
+   close(ls)
+
+   return
+
+end
+
+procedure nav_okay_cb()
+
+   if /nav_file then {
+      Notice("No file selected.")
+      fail
+      }
+
+   nav_state := "Okay"
+
+   return
+
+end
+
+procedure nav_keyboard(e)
+
+   case e of {
+      "\r"      :  nav_okay_cb()
+      Key_Home  :  VSetState(files, 1)
+      Key_End   :  VSetState(files, *file_list)
+      default   :  if type(e) == "string" then nav_locate(e)
+      }
+
+   return
+
+end
+
+procedure nav_locate(e)
+   local i
+   static pos
+
+   initial pos := list(1)
+
+   every i := 1 to *file_list do {
+      if file_list[i] >>= e then break
+      }
+
+   pos[1] := i
+
+   VSetState(files, pos)
+
+   return
+
+end
+
+procedure nav_cancel_cb()
+
+   nav_state := "Cancel"
+
+   return
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure navig_atts()
+   return ["size=294,412", "bg=pale gray", "label=Navitrix"]
+end
+
+procedure navig(win, cbk)
+return vsetup(win, cbk,
+   ["navig:Sizer:::0,0,294,412:Navitrix",],
+   ["cancel:Button:regular::86,378,49,20:Cancel",nav_cancel_cb],
+   ["files:List:w::13,50,273,314:",nav_files_cb],
+   ["okay:Button:regular::21,378,49,20:Okay",nav_okay_cb],
+   ["placeholder:Button:regularno::20,22,65,17:    ",],
+   ["refresh:Button:regular::224,378,56,20:Refresh",nav_refresh],
+   ["border:Rect:grooved::18,374,55,28:",nav_okay_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/optwindw.icn b/ipl/gprocs/optwindw.icn
new file mode 100644
index 0000000..e034c6a
--- /dev/null
+++ b/ipl/gprocs/optwindw.icn
@@ -0,0 +1,177 @@
+############################################################################
+#
+#	File:     optwindw.icn
+#
+#	Subject:  Procedures to open window with standard options
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 10, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	optwindow() opens a window, interpreting command options to
+#	set various window attributes.
+#
+############################################################################
+#
+#  optwindow(opttable, attribute...) -- open window based on option table
+#
+#  optwindow returns a new X-window configured according to a table of
+#  options such as that returned by options().  If a window cannot be
+#  opened, the program is aborted.
+#
+#  If any attribute arguments are supplied they are passed to the open call
+#  ahead of anything generated from the option table.
+#
+#  In general, upper-case letters are used for generic window options, and
+#  any letters not listed below are reserved for future use.  This leaves
+#  the lower-case letters for program-specific options.
+#
+#  The following options are recognized:
+#
+#	-B color	background color	default: "pale gray"
+#	-F color	foreground color	default: "black"
+#	-L label	window label (title) 	default: &progname (trimmed)
+#	-T font		text font		default: unspecified
+#
+#	-D display	window device		default: unspecified
+#	-X xpos		x position		default: unspecified
+#	-Y ypos		y position		default: unspecified
+#	-W width	window width		default: 500
+#	-H height	window height		default: 300
+#	-M margin	frame margin		default: 0
+#
+#	-S width,height	window size		default: 500,300 + margins
+#	-P xpos,ypos	window position		default: unspecified
+#	-G [wxh][+x+y]  geometry, in usual X terms (but NOTE: no negative x | y)
+#
+#	-!		echo the window creation call on stderr (for debugging)
+#
+#  -G is translated into -X -Y -W -H and overrides those values.
+#  -P and -S override values from -G, -X, -Y, -W, and -H.
+#
+#  Table values for {B,F,L,X,Y,W,H,M,P,S} are guaranteed to be set upon return.
+#
+#  The "margin" is the internal border between the actual window frame and the
+#  area used for display; you don't usually want to write right up to the edge.
+#  If a negative value is given for -M, a standard margin of 10 pixels is set.
+#  -M is added twice (for two margins) to -W and -H when calculating the actual
+#  window size so that -W and -H reflect the actual usable area.  If -W and -H
+#  are derived from -G, which specifies actual window sizes, -M is twice
+#  subtracted so that -W and -H always reflect the usable dimensions.
+#
+#  winoptions() can be used to combine the above options with other options
+#  for the options() call.
+#
+#  Example:
+#
+#	# get option table; allow standard options plus "-f filename"
+#	opts := options(args, winoptions() || "f:")
+#
+#	# set defaults if not given explicitly
+#	/opts["W"] := 400			# usable width
+#	/opts["H"] := 400			# usable height
+#
+#	# open the window
+#	win := optwindow(opts, "cursor=off")
+#
+#	# save actual values given by the window manager
+#	h := opts["H"]				# usable height
+#	w := opts["W"]				# usable width
+#	m := opts["M"]				# specified margin
+#
+#  (The usable area, then, is from (m,m) to (m+w, m+h).
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+$include "vdefns.icn"
+
+
+procedure winoptions()
+   return "!B:D:F:L:T:X+Y+W+H+M+G:P:S:"
+end
+
+
+procedure optwindow(opts, args[])		#: open window with options
+   local a, w
+   /opts["F"] := "black"
+   /opts["B"] := VBackground
+   /opts["L"] := (&progname ? { while tab(upto('/')+1); tab(0)})
+   /opts["W"] := 500
+   /opts["H"] := 300
+   (/opts["M"] := 0) | (if opts["M"] < 0 then opts["M"] := 10)
+   \opts["G"] ? {
+      if any(&digits) then {
+         opts["W"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("G")
+         tab(any('xX')) | Optw_Err("G")
+         opts["H"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("G")
+      }
+      if not pos(0) then {
+         opts["X"] := integer(tab(any('+-'))||tab(many(&digits)))|Optw_Err("G")
+         opts["Y"] := integer(tab(any('+-'))||tab(many(&digits)))|Optw_Err("G")
+      }
+      if not pos(0) then
+         Optw_Err("G")
+   }
+   \opts["P"] ? {
+      opts["X"] := integer(tab(many('+-0123456789'))) | Optw_Err("P")
+      move(1)
+      opts["Y"] := integer(tab(many('+-0123456789'))) | Optw_Err("P")
+      if not pos(0) then
+         Optw_Err("P")
+   }
+   \opts["S"] ? {
+      opts["W"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("S")
+      move(1)
+      opts["H"] := integer(tab(many(&digits))) - 2*opts["M"] | Optw_Err("S")
+      if not pos(0) then
+         Optw_Err("S")
+   }
+   if \opts["X"] & \opts["Y"] then
+      put(args, "pos=" || opts["X"] || "," || opts["Y"])
+   put(args, "display=" || \opts["D"])
+   put(args, "width=" || (opts["W"] + 2 * opts["M"]))
+   put(args, "height=" || (opts["H"] + 2 * opts["M"]))
+   put(args, "fg=" || opts["F"])
+   put(args, "bg=" || opts["B"])
+   push(args, "x")
+   push(args, opts["L"])
+   if \opts["!"] then {
+      writes(&errout, "open(\"", args[1])
+      every writes(&errout, "\",\"", args[2 to *args])
+      write(&errout, "\")")
+      }
+   w := open ! args | stop(args[1], ": can't open window")
+   if \opts["T"] then
+      Font(w, opts["T"]) | stop(args[1], ": invalid font: ", opts["T"])
+
+   # store actual values returned after window placement
+   WAttrib(w, "pos") ? {
+      opts["X"] := integer(tab(many('+-0123456789')))
+      move(1)
+      opts["Y"] := integer(tab(many('+-0123456789')))
+   }
+   opts["P"] := opts["X"] || "," || opts["Y"]
+   opts["W"] := WAttrib(w, "width") - 2 * opts["M"]
+   opts["H"] := WAttrib(w, "height") - 2 * opts["M"]
+   opts["S"] := WAttrib(w, "width") || "," || WAttrib(w, "height")
+   return w
+end
+
+procedure Optw_Err(ch)
+   stop("bad specification: -", ch, " ", &subject)
+end
diff --git a/ipl/gprocs/orbits.icn b/ipl/gprocs/orbits.icn
new file mode 100644
index 0000000..5377a61
--- /dev/null
+++ b/ipl/gprocs/orbits.icn
@@ -0,0 +1,82 @@
+############################################################################
+#
+#	File:     orbits.icn
+#
+#	Subject:  Procedures to produce traces of orbits
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures produce traces of orbits.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 65-73.
+#
+#  The arguments specify the starting positions, the extent of the
+#  drawing, the number of segments, and various parameters that
+#  control the orbit.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure orbit1(x, y, extent, n, t1, t2, k1, k2, radius1, sscale,
+   xfact, yfact)
+   local incr1, incr2, real_n, angle1, angle2, i, radius2, loff
+
+   radius1 *:= extent			#scaling
+   loff := 0.5 * extent
+   sscale *:= extent
+
+   real_n := real(n)
+   incr1 := 2 * &pi * t1 / n
+   incr2 := 2 * &pi * t2 / n
+   angle1 := angle2 := 0
+
+   every i := 1 to n do {
+      radius2 := sscale * (1 - i / real_n)
+      angle1 +:= incr1
+      angle2 +:= incr2
+      suspend Point(x + xfact * (loff + radius1 * cos(k1 * angle1) +
+         radius2 * cos(angle2)),
+         y + yfact * (loff + radius1 * sin(k2 * angle1) +
+         radius2 * sin(angle2)))
+      }
+
+end
+
+procedure orbit2(x, y, extent, n, t1, t2, k1, k2, radius1, sscale,
+   xfact, yfact, roff, rfact, rratio, div)
+   local incr1, incr2, rangle, angle1, angle2, i, radius2, loff
+
+   rangle := 2 * &pi / div * rratio
+   radius1 *:= extent			#scaling
+   loff  := 0.5 * extent
+   sscale *:= extent
+
+   incr1 := 2 * &pi * t1 / n
+   incr2 := 2 * &pi * t2 / n
+   angle1 := angle2 := 0
+
+   every i := 1 to n do {
+      radius2 := sscale * (roff + rfact * cos(i * rangle))
+      angle1 +:= incr1
+      angle2 +:= incr2
+      suspend Point(x + xfact * (loff + radius1 * cos(k1 * angle1) +
+         radius2 * cos(angle2)),
+         y + yfact * (loff + radius1 * sin(k2 * angle1) +
+         radius2 * sin(angle2)))
+      }
+
+end
diff --git a/ipl/gprocs/overlay.icn b/ipl/gprocs/overlay.icn
new file mode 100644
index 0000000..38c661f
--- /dev/null
+++ b/ipl/gprocs/overlay.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     overlay.icn
+#
+#	Subject:  Procedure to overlay an image in a window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  overlay(window, image) writes the image in the window, a line at a time.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  xcompat
+#
+############################################################################
+
+link xcompat
+
+procedure overlay(window, name)
+   local pixmap, width, height, x
+
+   pixmap := XBind(, , "image=" || name) |
+      stop("*** cannot bind image")
+
+   width := WAttrib(pixmap, "width")
+   height := WAttrib(pixmap, "height")
+
+   every x := 0 to width - 1 do
+      CopyArea(pixmap, window, x, 0, 1, height, x, 0)
+
+   close(pixmap)
+
+   return
+
+end
+
diff --git a/ipl/gprocs/palettes.icn b/ipl/gprocs/palettes.icn
new file mode 100644
index 0000000..a0f596e
--- /dev/null
+++ b/ipl/gprocs/palettes.icn
@@ -0,0 +1,405 @@
+############################################################################
+#
+#	File:     palettes.icn
+#
+#	Subject:  Procedures for programmer-defined palettes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement programmer-defined palettes.  They overload
+#  and build on top of the built-in palette mechanism.
+#
+############################################################################
+#
+#  Data structures:
+#
+#	Palette_() is a record that holds the information for a
+#	programmer-defined palette.  Its fields are:
+#
+#		name:    the name the palette is known by
+#		keys:  the string of the palette characters
+#		table:   a table keyed by the palette characters
+#			 whose corresponding values are the colors
+#
+#	Color_() is a record that holds the components of an RGB
+#	color in separate r, g, and b fields.
+#
+#	PDB_ is a table whose keys are the names of programmer-
+#	defined palettes and whose corresponding values are the
+#       palettes.  PDB_ is a global variable and provides the
+#	way for programmer-defined palette procedures to access
+#	a particular database.  If it is null, a new database is
+#	created.
+#
+#  Procedures:
+#
+#	BuiltinPalette(name)
+#		succeeds if name is the name of a built-in palette but
+#		fails otherwise.
+#
+#	CreatePalette(name, keys, colors)
+#		creates a new palette with the given colors and
+#		corresponding keys.  The colors used are the given ones.
+#
+#	InitializePalettes()
+#		initializes the built-in palette mechanism; it is called
+#		by the first palette procedure that is called.
+#
+#	Measure(color1, color2) returns the a measure of the distance
+#		 between color1 and color2 in RGB space.
+#
+#	NearColor(name, color)
+#		returns a color close to color in the palette name.
+#
+#	PaletteChars(win, palette)
+#		returns the palette characters of palette.  It extends
+#		the standard version.
+#
+#	PaletteColor(win, palette, key)
+#		returns color in palette for the given key. It extends
+#		the standard version.
+#
+#	PaletteKey(win, palette, color)
+#		returns the key in palette closest to the given color.
+#
+#	RGB(color)
+#		parses RGB color and returns a corresponding record.
+#
+#	makepalette(name, clist)
+#		makes a palette from the list of colors, choosing
+#		keys automatically.
+#
+#	palette_colors(palette)
+#
+#		returns the list of colors in palette.
+#
+#  Procedures fail in case of errors. This leaves control and error
+#  reporting to programs that use this module.  This module is intended
+#  to be used by programs that manage the necessary data and supply
+#  the table through PDB_.  The problem with this is that there is
+#  no way to differentiate errors.  A solution would be to post error
+#  messages in a global variable.
+#
+#  Limitations and problems:
+#
+#	The names of built-in palettes may not be used for programmer-
+#	defined ones.
+#
+#	PaletteGrays() is not implemented for programmer-defined
+#	palettes.  The library version should work for built-in
+#	palettes with this module linked.
+#
+#	Transparency is not yet implemented for DrawImage().
+#
+#	ReadImage() does not yet support programmer defined palettes.
+#
+#	Not tested:  Capture(), which may work.
+#
+#	There is some library code that checks for the names of
+#	built-in palettes in an ad-hoc fashion.  It therefore is
+#	not advisable to use names for programmer-defined palettes
+#	that begin with "c" or "g" followed by a digit.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imrutils, lists, sort
+#
+############################################################################
+
+link imrutils
+link lists
+link sort
+
+global PDB_
+
+record Palette_(name, keys, table)
+record Color_(r, g, b)
+
+#  Check for built-in palette
+
+procedure BuiltinPalette(name)			#: check for built-in palette
+
+   BuiltinPalette := proc("PaletteChars", 0)
+
+   return BuiltinPalette(name)
+
+end
+
+procedure CreatePalette(name, keys, colors)	#: create palette
+   local i, k, t
+
+   initial InitializePalettes()
+
+   if BuiltinPalette(name) then fail
+
+   if *keys ~= *cset(keys) then fail	# duplicate keys
+
+   if *keys ~= *colors then fail	# mismatch
+
+   t := table()
+
+   every i := 1 to *colors do
+      t[keys[i]] := ColorValue(colors[i]) | fail
+
+   PDB_[name] := Palette_(name, keys, t)
+
+   return PDB_[name]
+
+end
+
+#  Extended version of DrawImage()
+
+procedure DrawImage(args[])			#: draw image
+   local palette_pixels, palette_lookup, keys, c, i, row, imr
+   static draw_image
+
+   initial draw_image := proc("DrawImage", 0)
+
+   if type(args[1]) ~== "window" then push(args, &window)
+
+   imr := imstoimr(args[4]) | return draw_image ! args
+
+   if BuiltinPalette(imr.palette) then return draw_image ! args
+
+   palette_lookup := (\PDB_[imr.palette]).table | fail
+   palette_pixels := copy(palette_lookup)
+
+   keys := cset(imr.pixels)
+
+   every !palette_pixels := []		# empty lists for coordinates
+
+   every c := !keys do {
+      i := 0
+      imr.pixels ? {
+         while row := move(imr.width) do {
+            row ? {
+               every put(palette_pixels[c], upto(c) - 1, i)
+               }
+            i +:= 1
+            }
+         }
+      }
+
+   every c := !keys do {
+      Fg(palette_lookup[c]) | fail		# fails for invalid character
+      DrawPoint ! palette_pixels[c]
+      }
+
+   return
+
+end
+
+#  Initialize defined palette mechanism
+
+procedure InitializePalettes()			#: initialize palettes
+
+   /PDB_ := table()
+
+   if type(PDB_) ~== "table" then runerr(777)
+
+   InitializePalettes := 1		# make this procedure a no-op
+
+   return
+
+end
+
+procedure Measure(s1, s2)			#: measure of RGB distance
+   local color1, color2
+
+   color1 := RGB(s1)
+   color2 := RGB(s2)
+
+   return (color1.r - color2.r) ^ 2 + (color1.g - color2.g) ^ 2 +
+      (color1.b - color2.b) ^ 2
+
+end
+
+#  Get color close to specified key
+
+procedure NearColor(name, s)			#: close color in palette
+   local palette_lookup, k, measure, close_key, color
+
+   measure := 3 * (2 ^ 16 - 1) ^ 2	# maximum
+
+   color := ColorValue(s) | fail
+
+   palette_lookup := (\PDB_[name]).table | fail
+
+   every k := key(palette_lookup) do
+      if measure >:= Measure(palette_lookup[k], color) then {
+        close_key := k
+        if measure = 0 then break
+        }
+
+   return \close_key
+
+end
+
+#  Extended version of PaletteChars()
+
+procedure PaletteChars(args[])			#: characters in palette
+   local name
+   static palette_chars
+
+   initial {
+      InitializePalettes()
+      palette_chars := proc("PaletteChars", 0)
+      }
+
+   if type(args[1]) == "window" then get(args)
+
+   name := args[1]
+
+   if BuiltinPalette(name) then return palette_chars(name)
+   else return (\PDB_[name]).keys
+
+end
+
+#  Extended version of PaletteColor()
+
+procedure PaletteColor(args[])			#: color for key in palette
+   local palette_lookup, name, s
+   static palette_color
+
+   initial {
+      InitializePalettes()
+      palette_color := proc("PaletteColor", 0)
+      }
+
+   if type(args[1]) == "window" then get(args)
+
+   name := args[1]
+   s := args[2]
+
+   if BuiltinPalette(name) then return palette_color(name, s)
+
+   palette_lookup := (\PDB_[name]).table | fail
+
+   return \palette_lookup[s]
+
+end
+
+#  Extended version of PaletteKey()
+
+procedure PaletteKey(args[])			#: key for color in palette
+   local name, s
+   static palette_key
+
+   initial {
+      InitializePalettes()
+      palette_key := proc("PaletteKey", 0)
+      }
+
+   if type(args[1]) == "window" then get(args)
+
+   name := args[1]
+   s := args[2]
+
+   if BuiltinPalette(name) then return palette_key(name, s)
+   else return NearColor(name, s)
+
+end
+
+procedure RGB(s)				#: convert RGB color to record
+   local color
+
+   color := Color_()
+
+   ColorValue(s) ? {
+      color.r := tab(upto(',')) &
+      move(1) &
+      color.g := tab(upto(',')) &
+      move(1) &
+      color.b := tab(0)
+      } | fail
+
+   return color
+
+end
+
+procedure makepalette(name, clist)		#: make palette automatically
+   local keys
+   static alphan
+
+   initial alphan := &digits || &letters
+
+   if *clist = 0 then fail
+
+   keys :=
+      if *clist < *alphan then alphan
+      else &cset
+
+   CreatePalette(name, keys[1+:*clist], clist) | fail
+
+   return
+
+end
+
+procedure palette_colors(p)			#: list of palette colors
+   local clist
+
+   clist := []
+
+   every put(clist, PaletteColor(p, !PaletteChars(p)))
+
+   return clist
+
+end
+
+procedure keyseq(palette, colors[])		#: sequence of palette keys
+   local chars
+
+   chars := PaletteChars(palette)
+
+   suspend upto(PaletteKey(palette, !colors), chars)
+
+end
+
+procedure color_range(color, range)		#: adjust RGB range
+   local r, g, b
+
+   range := 2 ^ 16 / range
+
+   color ? {
+      r := tab(upto(','))
+      move(1)
+      g := tab(upto(','))
+      move(1)
+      b := tab(0)
+      return (r * range) || "," || (g * range) || "," || (b * range)
+      }
+
+end
+
+procedure colorseq(palette)			#: sequence of palette colors
+
+   suspend PaletteColor(palette, !PaletteChars(palette))
+
+end
+
+procedure sort_colors(colors)
+
+   return isort(colors, value)
+
+end
+
+procedure value(s)			#: RGB magnitude
+   local color
+
+   color := RGB(s)
+
+   return color.r ^ 2 + color.g ^ 2 + color.b ^ 2
+
+end
diff --git a/ipl/gprocs/pattread.icn b/ipl/gprocs/pattread.icn
new file mode 100644
index 0000000..d9613d5
--- /dev/null
+++ b/ipl/gprocs/pattread.icn
@@ -0,0 +1,42 @@
+############################################################################
+#
+#	File:     pattread.icn
+#
+#	Subject:  Procedure to read pattern
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 10, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  Reads BLP or row file and produces pattern in row form.
+#
+############################################################################
+#
+#  Links:  patutils
+#
+############################################################################
+
+link patutils
+
+procedure pattread(file)
+   local line, rows
+
+   line := read(file) | fail
+
+   line ? {
+      if upto("#", line) then rows := pat2rows(line)
+      else {
+         rows := [line]
+         while put(rows, read(file))	# read in row pattern
+         }
+      }
+
+   return rows
+
+end
diff --git a/ipl/gprocs/patutils.icn b/ipl/gprocs/patutils.icn
new file mode 100644
index 0000000..8da4da3
--- /dev/null
+++ b/ipl/gprocs/patutils.icn
@@ -0,0 +1,584 @@
+############################################################################
+#
+#	File:     patutils.icn
+#
+#	Subject:  Procedures to manipulate patterns
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     July 8, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate graphic pattern
+#  representations.  These procedures are intended for bi-level patterns
+#  representable by 0s and 1s.
+#
+#  A row pattern is a list of strings, with each string representing
+#  a row in the pattern.
+#
+#	DrawTile(win, xoff, yoff, pattern, magnif, mode)
+#	DrawRows(win, xoff, yoff, rows, magnif, mode)
+#	bits2hex(s)
+#	decspec(pattern)
+#	eqpats(prws, rows2)
+#	getpatt(line)
+#	getpattnote(line)
+#	hex2bits(s)
+#	hexspec(pattern)
+#	legalpat(tile)
+#	legaltile(tile)
+#	pat2xbm(pattern, name)
+#	tilebits(rows)
+#	pdensity(pattern)
+#	pix2pat(window, x, y, cols, rows)
+#	readpatt(input)
+#	readpattline(input)
+#	rowbits(pattern)
+#	pat2rows(pattern)
+#	rows2pat(rlist)
+#	showbits(pattern)
+#	tiledim(pattern)
+#	xbm2rows(input)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  convert
+#
+############################################################################
+
+link convert
+
+record tdim(w, h)
+
+#
+#  Draw a tile at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure DrawTile(win, xoff, yoff, pattern, magnif, mode)
+   local x, y, row, pixel, dims, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: pattern :=: mode
+      win := &window
+      }
+
+   /magnif := 1
+
+   y := yoff
+
+   if \mode then {
+      dims := tiledim(pattern)
+      EraseArea(xoff, yoff, dims.w * magnif, dims.h * magnif)
+      }
+
+   every row := rowbits(pattern) do {		# draw a row
+      x := xoff
+      arglist := []
+
+      if magnif = 1 then {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y)
+            x +:= 1
+            }
+         y +:= 1
+         }
+      else {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         }
+      if *arglist = 0 then next
+      if magnif = 1 then DrawPoint ! arglist else FillRectangle ! arglist
+      }
+
+   return
+
+end
+#
+#  Draw rows at a given location.  If mode is nonnull, the
+#  area on which the tile is drawn is erased.
+
+procedure DrawRows(win, xoff, yoff, rows, magnif, mode)
+   local x, y, row, pixel, arglist
+
+   if type(win) ~== "window" then {
+      win :=: xoff :=: yoff :=: rows :=: magnif :=: mode
+      win := &window
+      }
+
+   /magnif := 1
+
+   y := yoff
+
+   if \mode then
+      EraseArea(xoff, yoff, *rows[1] * magnif, *rows * magnif)
+
+   every row := !rows do {		# draw a row
+      x := xoff
+      arglist := []
+
+      if magnif = 1 then {
+         every pixel := !row do {
+            if pixel == "1" then put(arglist, x, y)
+            x +:= 1
+            }
+         y +:= 1
+         }
+      else {
+         every pixel := !row do {
+            if pixel = "1" then put(arglist, x, y, magnif, magnif)
+            x +:= magnif
+            }
+         y +:= magnif
+         }
+      if *arglist = 0 then next
+      if magnif = 1 then DrawPoint ! arglist else FillRectangle ! arglist
+      }
+
+   return
+
+end
+
+#
+#  Convert bit string to hex pattern string
+
+procedure bits2hex(s)
+   static bittab
+   local hex
+
+   initial {
+      bittab := table()
+      bittab["0000"] := "0"
+      bittab["1000"] := "1"
+      bittab["0100"] := "2"
+      bittab["1100"] := "3"
+      bittab["0010"] := "4"
+      bittab["1010"] := "5"
+      bittab["0110"] := "6"
+      bittab["1110"] := "7"
+      bittab["0001"] := "8"
+      bittab["1001"] := "9"
+      bittab["0101"] := "a"
+      bittab["1101"] := "b"
+      bittab["0011"] := "c"
+      bittab["1011"] := "d"
+      bittab["0111"] := "e"
+      bittab["1111"] := "f"
+      }
+
+   hex := ""
+
+   s ? {
+       while hex := bittab[move(4)] || hex
+       if not pos(0) then hex := bittab[left(tab(0), 4, "0")] || hex
+       }
+
+   return hex
+
+end
+
+#
+#  Convert pattern specification to decimal form
+
+procedure decspec(pattern)
+   local cols, chunk, dec
+
+   pattern ? {
+      if not upto("#") then return pattern
+      cols := tab(upto(','))
+      move(2)
+      chunk := (cols + 3) / 4
+      dec := cols || ","
+      while dec ||:= integer("16r" || move(chunk)) || ","
+      }
+
+   return dec[1:-1]
+
+end
+
+procedure eqpats(rows1, rows2)		#: test row patterns for equality
+   local i
+
+   if (*rows1 ~= *rows2) | (*rows1[1] ~= *rows2[1]) then fail
+
+   every i := 1 to *rows1 do
+      if rows1[i] ~== rows2[i] then fail
+
+   return rows2
+
+end
+
+#
+#  Get pattern from line.  It trims off leading and trailing whitespace
+#  and removes any annotation (beginning with a # after the first whitespace
+
+procedure getpatt(line)
+
+   line ? {
+      tab(many(' \t'))
+      return tab(upto(' \t') | 0)
+      }
+
+end
+
+#
+#  Get pattern annotation.  It returns an empty string if there is
+#  no annotation.
+
+procedure getpattnote(line)
+
+   line ? {
+      tab(many(' \t'))			# remove leading whitespace
+      tab(upto(' \t')) | return ""	# skip pattern
+      tab(upto('#')) | return ""	# get to annotation
+      tab(many('# \t'))			# get rid of leading junk
+      return tab(0)			# annotation
+      }
+
+end
+
+#  Convert hexadecimal string to bits
+
+procedure hex2bits(s)
+   static hextab
+   local bits
+
+   initial {
+      hextab := table()
+      hextab["0"] := "0000"
+      hextab["1"] := "0001"
+      hextab["2"] := "0010"
+      hextab["3"] := "0011"
+      hextab["4"] := "0100"
+      hextab["5"] := "0101"
+      hextab["6"] := "0110"
+      hextab["7"] := "0111"
+      hextab["8"] := "1000"
+      hextab["9"] := "1001"
+      hextab["a"] := "1010"
+      hextab["b"] := "1011"
+      hextab["c"] := "1100"
+      hextab["d"] := "1101"
+      hextab["e"] := "1110"
+      hextab["f"] := "1111"
+      }
+
+   bits := ""
+
+   map(s) ? {
+      while bits ||:= hextab[move(1)]
+      }
+
+   return bits
+
+end
+
+#
+#  Convert pattern to hexadecimal form
+
+procedure hexspec(pattern)
+   local cols, chunk, hex
+
+   pattern ? {
+      if find("#") then return pattern
+      cols := tab(upto(','))
+      move(1)
+      chunk := (cols + 3) / 4
+      hex := cols || ",#"
+      while hex ||:= right(exbase10(tab(upto(',') | 0), 16), chunk, "0") do
+         move(1) | break
+      }
+
+   return hex
+
+end
+
+#
+#  Succeed if tile is legal and small enough for (X) pattern.  Other
+#  windows systems may be more restrictive.
+
+procedure legalpat(tile)
+
+   if not legaltile(tile) then fail
+
+   tile ? {
+      if 0 < integer(tab(upto(','))) <= 32 then return tile
+      else fail
+      }
+
+end
+
+#
+#  Succeed if tile is legal.  Accepts tiles that are too big for
+#  patterns.
+
+procedure legaltile(tile)
+
+   map(tile) ? {				# first check syntax
+      (tab(many(&digits)) & =",") | fail
+      if ="#" then (tab(many('0123456789abcdef')) & pos(0)) | fail
+      else {
+         while tab(many(&digits)) do {
+            if pos(0) then break	# okay; end of string
+            else ="," | fail
+            }
+         if not pos(0) then fail	# non-digit
+         }
+      }
+
+   return hexspec(decspec(tile)) == tile
+
+end
+
+#
+#  Convert pattern specification to an XBM image file.
+
+procedure pat2xbm(pattern, name)
+   local dims, chunk, row
+
+   /name := "noname"
+
+   dims := tiledim(pattern)
+
+
+   write("#define ", name, "_width ", dims.w)
+   write("#define ", name, "_height ", dims.h)
+   write("static char ", name, "_bits[] = {")
+
+   chunk := (dims.w + 3) / 4
+
+   pattern ? {
+      tab(upto('#') + 1)
+      while row := move(chunk) do {
+         if *row % 2 ~= 0 then row := "0" || row
+         row ? {
+            tab(0)
+            while writes("0x", move(-2), ",")
+            }
+         write()
+         }
+      }
+
+   write("};")
+
+end
+
+#
+#  Count the number of bits set in a tile
+
+procedure tilebits(rows)
+   local bits
+
+   bits := 0
+
+   every bits +:= !!rows
+
+   return bits
+
+end
+
+#
+#  Compute density (percentage of black bits) of pattern
+
+procedure pdensity(pattern)
+
+   local dark, dims
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      dark := 0
+      every rowbits(pattern) ? {
+         every upto('1') do
+            dark +:= 1
+            }
+      return dark / real(dims.w * dims.h)
+      }
+
+end
+
+#
+#  Procedure to produce pattern specification from a square section of a window.
+
+procedure pix2pat(window, x, y, cols, rows)
+   local c, j, tile, pattern, pixels, y0
+
+   pattern := ""
+
+   every y0 := 0 to rows - 1 do {
+      pixels := ""
+      every j := 0 to cols - 1 do
+         every c := Pixel(window, x + j, y0 + y, 1, 1) do
+            pixels ||:= (if c == "0,0,0" then "1" else "0")
+      pattern ||:= bits2hex(pixels)
+      }
+
+   if *pattern = 0 then fail		# out of bounds specification
+   else return cols || ",#" || pattern
+
+end
+
+#
+#  Read pattern.  It skips lines starting with a #,
+#  empty lines, and trims off any trailing characters after the
+#  first whitespace of a pattern.
+
+procedure readpatt(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(upto(' \t') | 0)
+         }
+
+   fail
+
+end
+
+#  
+#  Read pattern line.  It skips lines starting with a # and empty lines but
+#  does not trim off any trailing characters after the first whitespace of
+#  a pattern.
+
+procedure readpattline(input)
+   local line
+
+   while line := read(input) do
+      line ? {
+         if pos(0) | ="#" then next
+         return tab(0)
+         }
+
+   fail
+
+end
+
+#
+#  Generate rows of bits in a pattern.  Doesn't work correctly for small
+#  patterns.  (Why?)
+
+procedure rowbits(pattern)
+   local row, dims, chunk, hex
+
+   dims := tiledim(pattern)
+
+   hexspec(pattern) ? {
+      tab(upto(',') + 2)
+      hex := tab(0)
+      chunk := *hex / dims.h
+      hex ? {
+         while row := right(hex2bits(move(chunk)), dims.w, "0") do
+            suspend reverse(row)
+         }
+      }
+
+end
+
+#
+#  Produce a list of the rows of a pattern
+
+procedure pat2rows(pattern)
+   local rlist
+
+   rlist := []
+
+   every put(rlist, rowbits(pattern))
+
+   return rlist
+
+end
+
+#
+#  Convert row list to pattern specification
+
+procedure rows2pat(rlist)
+   local pattern
+
+   pattern := *rlist[1] || ",#"
+
+   every pattern ||:= bits2hex(!rlist)
+
+   return pattern
+
+end
+
+#  Show bits of a pattern
+
+procedure showbits(pattern)
+
+   every write(rowbits(pattern))
+
+   write()
+
+   return
+
+end
+
+
+#
+#  Produce dimensions of the tile for a pattern
+
+procedure tiledim(pattern)
+   local cols
+
+   hexspec(pattern) ? {
+      cols := integer(tab(upto(',')))
+      =",#" | fail
+      return tdim(cols, *tab(0) / ((cols + 3) / 4))
+      }
+
+end
+
+#
+#  Generate rows of bits from an XBM file
+
+procedure xbm2rows(input)
+   local image, bits, row, hex, width, height, chunks
+
+   image := ""
+
+   read(input) ? {
+      tab(find("width") + 6)
+      tab(upto(&digits))
+      width := integer(tab(many(&digits)))
+      }
+
+   read(input) ? {
+      tab(find("height") + 6)
+      tab(upto(&digits))
+      height := integer(tab(many(&digits)))
+      }
+
+   chunks := (width / 8) + if (width % 8) > 0 then 1 else 0
+
+   while image ||:= reads(input, 500000)	# Boo! -- can do better
+
+   image ? {
+      every 1 to height do {
+         row := ""
+         every 1 to chunks do {
+            tab(find("0x") + 2)
+            hex := move(2)			# a bit of optimization
+            row ||:= case hex of {
+              "00":    "00000000"
+              "ff":    "11111111"
+               default: reverse(right(hex2bits(hex), 8, "0"))
+               }
+            }
+         suspend left(row, width)
+         }
+      }
+
+end
diff --git a/ipl/gprocs/patxform.icn b/ipl/gprocs/patxform.icn
new file mode 100644
index 0000000..fb5ba97
--- /dev/null
+++ b/ipl/gprocs/patxform.icn
@@ -0,0 +1,504 @@
+############################################################################
+#
+#	File:     patxform.icn
+#
+#	Subject:  Procedures to transform patterns in row form
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 26, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	pborder(rows, l, r, t, b, c)
+#	pcaten(rows1, rows2, dir)
+#	pcenter(rows, w, h)
+#	pcrop(rows, l, r, t, b)
+#	pdisplay(rows)
+#	pdouble(rows, dir)
+#	pflip(rows, dir)
+#	phalve(rows, dir, choice)
+#	pinvert(rows)
+#	pminim(rows)
+#	por(rows1, rows2)
+#	protate(rows, dir)
+#	pscramble(rows, dir)
+#	pshift(rows, shift, dir)
+#	ptrim(rows, c)
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  patutils, random, strings
+#
+############################################################################
+
+link patutils
+link random
+link strings
+
+#
+#  Place a border around a pattern.  l, r, t, and b specify the number of bits
+#  to add at the left, right, top, and bottom, respectively.  c specifies
+#  the color of the border, "0" for white, "1" for black.
+
+procedure pborder(rows, l, r, t, b, c)	#: place border around pattern
+   local i, row, left, right
+
+   /l := 1
+   /r := 1
+   /t := 1
+   /b := 1
+   /c := "0"
+
+   if l = r = t = b = 0 then return rows
+
+   row := repl(c, *rows[1] + l + r)
+   left := repl(c, l)
+   right := repl(c, r)
+
+   every i := 1 to *rows do
+       rows[i] := left || rows[i] || right
+
+   every 1 to t do
+      push(rows, row)
+
+   every 1 to b do
+      put(rows, row)
+
+   return rows
+
+end
+
+#
+#  Concatenate patterns
+
+procedure pcaten(rows1, rows2, dir)	#: concatenate patterns
+   local rows, i
+
+   # if art is nonnull, delete duplicate line at boundary
+
+   if (*rows1 ~= *rows2) | (*rows1[1] ~= *rows2[1]) then
+      stop("nonconformal patterns in pcaten()")
+
+   /dir := "h"
+
+   case dir of {
+      "h"  :  {
+         rows := []
+         every i := 1 to *rows1 do
+            put(rows, rows1[i] || rows2[i])
+         }
+      "v"  :  {
+         rows := copy(rows1)
+         every put(rows, !rows2)
+         }
+      default:  stop("invalid direction specification in pcaten()")
+      }
+
+   return rows
+
+end
+
+#
+#  Concatenate patterns pattern style
+
+procedure pcatenp(rows1, rows2, dir)
+   local rows, i
+
+   if (*rows1 ~= *rows2) | (*rows1[1] ~= *rows2[1]) then
+      stop("nonconformal patterns in pcaten()")
+
+   /dir := "h"
+
+   rows2 := copy(rows2)		# may delete row or column
+
+   case dir of {
+      "h"  :  {
+         repeat {
+            every i := 1 to *rows1 do
+               if rows1[i][-1] ~== rows2[i][1] then break break 	
+            every i := 1 to *rows2 do
+               rows2[i][1] := ""
+            break
+            }
+         rows := []
+         every i := 1 to *rows1 do
+            put(rows, rows1[i] || rows2[i])
+         }
+      "v"  :  {
+         if rows1[-1] == rows2[1] then	# eliminate duplicate
+            get(rows2)
+         rows := copy(rows1)
+         every put(rows, !rows2)
+         }
+      default:  stop("invalid direction specification in pcaten()")
+      }
+
+   return rows
+
+end
+
+#
+#  Centers non-white portion of pattern
+
+procedure pcenter(rows, w, h)		#: center pattern
+   local rw, rh, vert, horz, t, l
+
+   rows := ptrim(rows)
+
+   rw := *rows[1]
+   rh := *rows
+
+   if (rh = h) & (rw = w) then return rows
+   if (rh > h) | (rw > w) then fail
+
+   horz := w - rw
+   vert := h - rh
+   l := horz / 2
+   t := vert / 2
+
+   return pborder(rows, l, horz - l, t, vert - t)
+
+end
+
+#
+#  Crop a pattern.  l, r, t, and b specify the number of bits
+#  to crop at the left, right, top, and bottom, respectively.
+
+procedure pcrop(rows, l, r, t, b)	#: crop pattern
+   local i
+
+   /l := 0
+   /r := 0
+   /t := 0
+   /b := 0
+
+   if l = r = t = b = 0 then return rows
+
+   if ((*rows[1] - l - r) | (*rows - t - b)) < 2 then fail
+
+   every 1 to t do
+      get(rows)
+
+   every 1 to b do
+      pull(rows)
+
+   every i := 1 to *rows do
+       rows[i] := rows[i][l + 1 : -r]
+
+   return rows
+
+end
+
+#
+#  Display pattern
+
+procedure pdisplay(rows, pat)			#: display pattern
+
+   /pat := "01"			# mapping string
+
+   every write(map(!rows, "01", pat))
+
+   return
+
+end
+         
+#
+#  Creates a tile in which each pixel doubled.  dir determines the
+#  direction in which the doubling is done.  If dir is "b" or null, it's
+#  done both horizontally and vertically.  If dir is "v", it's only done
+#  vertically, while if dir is "h", it's done only horizontally.
+
+procedure pdouble(rows, dir)		#: double pattern
+   local row, newrows
+
+   newrows := []
+
+   case dir of {
+      "v":  {
+         every row := !rows do
+            put(newrows, row, row)
+         }
+      "h":  {
+         every row := !rows do
+            put(newrows, collate(row, row))
+         }
+      "b" | &null: return pdouble(pdouble(rows, "v"), "h")
+      }
+
+   return newrows
+
+end
+
+#
+#  Flip pattern.  The possible values of dir are "h" (horizontal flip),
+#  "v" (vertical flip), "l" (left diagonal), and "r" (right diagonal).
+#  (The left diagonal extends from the upper left corner to the bottom
+#  right corner; the right diagonal from the upper right to the lower
+#  left.
+
+procedure pflip(rows, dir)		#: flip pattern
+   local newrows, x, y, i
+
+   case dir of {
+      "l": {
+         newrows := list(*rows[1], repl("0", *rows))
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               if rows[y, x] == "1" then
+                  newrows[-x, -y] := "1"
+         }
+      "r": {
+         newrows := list(*rows[1], repl("0", *rows))
+         every y := 1 to *rows do
+            every x := 1 to *rows[1] do
+               if rows[y, x] == "1" then
+                  newrows[x, y] := "1"
+         }
+      "h":  {
+         newrows := copy(rows)
+         every i := 1 to *rows do
+            newrows[i] := reverse(newrows[i])
+         }
+      "v":  {
+         newrows := copy(rows)
+         every i := 1 to *rows / 2 do
+           newrows[i] :=: newrows[-i]
+         }
+      default:  stop("*** illegal flip specification in pflip()")
+      }
+
+   return newrows
+      
+end
+
+#  Creates a tile in every other pixel is discarded.  dir determines the
+#  direction is which the halving is done.  If dir is "b" or null, it's
+#  done both vertically and horizontally.  If dir is "v", it's only done
+#  vertically, while if dir is "v", it's done only vertically.
+#  If choice is "o" or null, odd-numbered rows or columns are kept;
+#  if "e", the even-numbered ones.
+
+procedure phalve(rows, dir, choice)	#: halve pattern by bits
+   local newrows, i
+
+   choice := if choice === ("o" | &null) then 1 else 0
+   newrows := []
+
+   case dir of {
+      "v": {
+         every i := choice to *rows by 2 do
+            put(newrows, rows[i])
+         }
+      "h":  every put(newrows, decollate(!rows, choice))
+      "b" | &null: return phalve(phalve(rows, "v", choice), "h", choice)
+      }
+
+   return newrows
+
+end
+
+#
+#  Invert white and black bits in pattern specification
+
+procedure pinvert(rows)			#: invert B&W pattern
+   local i
+
+   rows := copy(rows)
+
+   every i := 1 to *rows do
+      rows[i] := map(rows[i], "10", "01")
+
+   return rows
+
+end
+
+#
+#  Reduce pattern to its smallest equivalent form (with at least 4 columns).
+#  Limited to square patterns for portability -- other possibilities exist
+#  for operating on and/or producing patterns that are not square.
+
+
+procedure pminim(rows)			#: minimize pattern
+   local halfw, halfh, i
+
+#  if (*rows ~= *rows[1]) | (*rows % 2 ~= 0) then return rows
+
+   repeat {
+  
+      if *rows[1] < 4 then break
+
+      halfw := *rows[1] / 2
+      halfh := *rows / 2
+   
+      every i := 1 to halfh do			# check rows in top and bottom
+         if (rows[i] ~== rows[i + halfh]) |
+            (rows[i][1+:halfw] ~== rows[i][0-:halfw]) then break break
+   
+      every 1 to halfh do			# reducible; remove rows
+         pop(rows)
+   
+      every i := 1 to halfh do			# truncate rows
+         rows[i] := rows[i][1+:halfw]
+   
+      }
+
+   return rows
+
+end
+
+#  For the logical "or" of two row bit patterns
+
+procedure por(rows1, rows2)		#: "or" patterns
+   local rows, i
+
+   if *rows1 ~= *rows2 then fail	# nonconformal
+   if *rows1[1] ~= *rows2[1] then fail	# nonconformal
+
+   rows := copy(rows1)
+
+   every i := 1 to *rows do {
+      rows2[i] ? {			# overlay 1s of row2 on row1
+         while tab(upto('1')) do {
+            rows[i][&pos] := "1"
+            move(1) | break
+            }
+         }
+      }
+
+   return rows
+
+end
+
+#  Create rotated copy of a pattern.  If dir is "cw" or "90", rotation is 90
+#  degrees clockwise; if "ccw" or "-90", 90 degrees counter-clockwise.
+#  If dir is "180", rotation is 180 degrees.  The default is "cw".
+
+procedure protate(rows, dir)		#: rotate pattern
+   local newrows, i, row, pix
+
+   /dir := "cw"
+
+   case string(dir) of {
+      "ccw" | "-90":  {			# counter-clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do  {
+            i := 0
+            every pix := !row do
+               newrows[i -:= 1] ||:= pix
+            }
+        }
+      "cw" | "90" | &null:  {			# clockwise
+         newrows := list(*rows[1], "")
+         every row := !rows do {
+            i := 0
+            every pix := !row do
+               newrows[i +:= 1] := pix || newrows[i]
+            }
+         }
+      "180": {
+         newrows := []
+         every push(newrows, reverse(!rows))
+         }
+      default:  stop("*** illegal rotation specification in protate()")
+   }
+
+   return newrows
+
+end
+
+#
+#  Scrambles a pattern by shuffling it.  If dir is "h", the columns of each row
+#  are scrambled; if "v", the the rows are scrambled.  If "b", bits are
+#  scrambled throughout the pattern.
+
+procedure pscramble(rows, dir)		#: scramble pattern
+   local i, all
+
+   case dir of {
+      "h":  {
+          every i := 1 to *rows do
+             rows[i] := shuffle(rows[i])
+          }
+      "v":  rows := shuffle(rows)
+      "b" | &null:  {
+         all := ""
+         every all ||:= !rows
+         all := shuffle(all)
+         every i := 1 to *rows do {
+            rows[i] := left(all, *rows[1])
+            all[1 +: *rows[1]] := ""
+            }
+         }
+      default:   stop("*** illegal specification in scramble()")
+      }
+
+   return rows
+
+end 
+      
+
+#
+#  Create bit-shifted copy of a pattern.  If dir is "h", then the
+#  shift is horizontal; if "v", vertical. The default is horizontal.
+#  Positive shift is to the right for horizontal shifts, downward for vertical
+#  shifts.  The default shift is 0 and the default direction is horizontal.
+
+procedure pshift(rows, shift, dir)	#: bit shift pattern
+   local i
+
+   /shift := 0
+
+   case dir of {
+      "h" | &null: {			# horizontal shift
+         every i := 1 to *rows do
+            rows[i] := rotate(rows[i], -shift)
+         }
+      "v": {				# vertical shift
+         if shift > 0 then
+            every 1 to shift do
+               push(rows, pull(rows))
+         else if shift < 0 then
+            every 1 to -shift do
+               put(rows, pop(rows))
+         }
+      default:  stop("*** illegal specification in pshift()")
+      }
+
+   return rows
+
+end
+
+#
+#  Trim border from pattern;  c gives color; default "1"
+
+procedure ptrim(rows, c)		#: trim pattern
+   
+   /c := '1'
+   c := cset(c)
+
+   while (*rows > 2) & not(upto(c, rows[1])) do
+      get(rows)
+
+   while (*rows > 2) & not(upto(c, rows[-1])) do
+      pull(rows)
+
+   rows := protate(rows, "cw")
+
+   while (*rows > 2) & not(upto(c, rows[1])) do
+      get(rows)
+
+   while (*rows > 2) & not(upto(c, rows[-1])) do
+      pull(rows)
+ 
+   return protate(rows, "ccw")
+
+end
diff --git a/ipl/gprocs/pixelmap.icn b/ipl/gprocs/pixelmap.icn
new file mode 100644
index 0000000..7160e28
--- /dev/null
+++ b/ipl/gprocs/pixelmap.icn
@@ -0,0 +1,59 @@
+############################################################################
+#
+#	File:     pixelmap.icn
+#
+#	Subject:  Procedure to create image from pixel list
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  pixelmap(name, p, args[]) reads the pixel list in file name and
+#  constructs an image, applying p ! args to each pixel.  If p is
+#  omitted or null, the pixels are used as-is.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure pixelmap(name, p, args[])
+   local input, width, height, x, y, win
+
+   /p := 1
+   push(args)			# place holder
+
+   input := open(name) | stop("*** cannot open pixel list")
+
+   read(input) ? {
+      ="width=" &
+      width := tab(many(&digits)) &
+      =" height=" &
+      height := tab(many(&digits))
+      } | stop("*** invalid pixel list header")
+
+   win := WOpen("width=" || width, "height=" || height)
+
+   every y := 0 to height - 1 do
+      every x := 0 to width - 1 do {
+         args[1] := read(input) | stop("*** short data in pixel list")
+         Fg(win, p ! args)
+         DrawPoint(x, y)
+         }
+
+   return win
+
+end
diff --git a/ipl/gprocs/popular.icn b/ipl/gprocs/popular.icn
new file mode 100644
index 0000000..0a68a09
--- /dev/null
+++ b/ipl/gprocs/popular.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     popular.icn
+#
+#	Subject:  Procedure to show "popularity" of colors in image string
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 17, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure shows the "popularity" of colors in an image string.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links:  imrutils, wopen
+#
+############################################################################
+
+link imrutils
+link wopen
+
+procedure popularity(ims)	#: color popularity in image string
+   local imr, color_tbl, color_list, color
+
+   imr := imstoimr(ims)
+
+   color_tbl := table(0)
+
+   every color_tbl[PaletteColor(imr.palette, !imr.pixels)] +:= 1
+
+   color_list := sort(color_tbl, 4)
+
+   write("dimensions: ", imr.width, "x", imr.height)
+   write("pixels: ", *imr.pixels)
+   write("palette: ", imr.palette)
+   write("number of different colors: ", *color_tbl)
+   write()
+   write("color popularity:")
+   write()
+
+   while color := pull(color_list) do
+      write(left(pull(color_list), 20), right(color, 6))
+
+end
diff --git a/ipl/gprocs/psrecord.icn b/ipl/gprocs/psrecord.icn
new file mode 100644
index 0000000..a72129d
--- /dev/null
+++ b/ipl/gprocs/psrecord.icn
@@ -0,0 +1,555 @@
+############################################################################
+#
+#	File:     psrecord.icn
+#
+#	Subject:  Procedures for PostScript record of window
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 10, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# 	Contributors: Stephen B. Wampler and Ralph E. Griswold
+#
+############################################################################
+#
+#	These procedures intercept graphics calls in order to produce
+#	a PostScript copy of what is drawn.  The record is decidedly
+#	imperfect.
+#
+############################################################################
+#
+#     These procedures produce a PostScript record of the screen display
+#  of an Icon program.  The technique used is to intercept calls to
+#  graphics functions and write PostScript before calling the built-in
+#  versions.
+#
+#     Because the X emulation is imperfect, psrecord works best for
+#  programs designed with it in mind.  Not all function calls are
+#  intercepted; some such as CopyArea cannot be handled at all.  The
+#  list of functions is in the internal routine PS_swap().  It is assumed
+#  that there is only a single window and a single graphics context;
+#  programs that switch among multiple graphics contexts will not be
+#  recorded properly.
+#
+#     PostScript recording is enabled by calling PSEnable(window, filename)
+#  any time after after the window has been opened.  (The procedures in
+#  "autopost.icn" may be used for this.)  Defaults for PSEnable are
+#  &window and "xlog.ps".  At the end, PSDone() should be called to
+#  properly terminate the file; when PSDone() is not called, the file is
+#  still be legal but lacks the "showpage" command needed for printing.
+#
+#     If the argument to PSDone is non-null, no showpage is written.
+#  This is recommended for Encapsulated PostScript that is to be
+#  placed in documents, since otherwise the bounding box resulting
+#  from showpage may interfere with document layout.  showpage is, of
+#  course, needed for PostScript that is to be printed stand-alone.
+#
+#     Additional procedures provide more detailed control but must be used
+#  with care.  PSDisable() and PSEnable() turn recording off and back on;
+#  any graphics state changes during this time (such as changing the
+#  foreground color) are lost.  PSSnap() inserts a "copypage" command in
+#  the output; this prints a snapshot of the partially constructed page
+#  without erasing it.  PSRaw() writes a line of PostScript to the output
+#  file.
+#
+#     PSStart(window, filename) is similar to PSEnable except that it
+#  always starts a fresh output file each time it is called.
+#
+#     The output file is legal Encapsulated PostScript unless PSSnap is
+#  used; PSSnap renders the output nonconforming because by definition
+#  an EPS file consists of a single page and does not contain a "copypage"
+#  command.  It should be possible to postprocess such output to make a
+#  set of legal EPS files.
+#
+#     Some of the other limitations are as follows:
+#         Only a few font names are recognized, and scaling is inexact.
+#         Newlines in DrawString() calls are not interpreted.
+#         Output via write() or writes() is not recorded.
+#         The echoing of characters by read() or reads() is not recorded.
+#         DrawCurve output is approximated by straight line segments.
+#         Window resizing is ignored.
+#         Drawing arguments must be explicit; few defaults are supplied.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global PS_active, PS_f, PS_win, PS_width, PS_height
+
+#########################  External Functions  #########################
+
+#  PSEnable(window, filename) -- enable PostScript recording.
+#
+#  window and filename are significant only on the very first call.
+
+procedure PSEnable(w, f)		#: enable PostScript recording
+   initial PS_init(w, f)
+   if /PS_active := 1 then
+      PS_swap()
+   return
+end
+
+#  PSSnap() -- take snapshot at this point
+
+procedure PSSnap()			#: take PostScript snapshot
+   static inited
+   if /PS_active then
+      fail
+   if /inited := 1 then {
+      seek(PS_f, 1)
+      write(PS_f, "%! nonconforming.......")	# overwrite 1st line
+      seek(PS_f, 0)
+   }
+   PS_out("copypage")
+   return
+end
+
+#  PSRaw(s) -- output a line of raw PostScript (at user's own risk)
+
+procedure PSRaw(s)			#: output raw PostScript
+   if /PS_active then
+      fail
+   return write(PS_f, s)
+end
+
+#  PSDisable() -- temporarily turn off recording
+
+procedure PSDisable()			#: disable PostScript recording
+   if \PS_active := &null then
+      PS_swap()
+   return
+end
+
+#  PSDone(sw) -- terminate output
+
+procedure PSDone(sw)			#: terminate PostScript recording
+   initial PS_init()
+   PSDisable()
+   if /sw then PS_out("showpage") 	# if sw nonnull, do not output
+   PS_out("%%EOF")
+   close(PS_f)
+   return
+end
+
+#########################  Internal Functions  #########################
+
+#  PS_swap() -- swap local functions for the real versions
+
+procedure PS_swap()
+   PS_attrib :=: WAttrib
+   PS_bg :=: Bg
+   PS_clip :=: Clip
+   PS_drawarc :=: DrawArc
+   PS_drawcircle :=: DrawCircle
+   PS_drawcurve :=: DrawCurve
+   PS_drawline :=: DrawLine
+   PS_drawrect :=: DrawRectangle
+   PS_drawpoint :=: DrawPoint
+   PS_drawsegment :=: DrawSegment
+   PS_drawstring :=: DrawString
+   PS_erasearea :=: EraseArea
+   PS_fg :=: Fg
+   PS_fillarc :=: FillArc
+   PS_fillcircle :=: FillCircle
+   PS_fillrect :=: FillRectangle
+   PS_fillpoly :=: FillPolygon
+   PS_flush :=: WFlush
+   PS_font :=: Font
+   return
+end
+
+#  PS_init(w, f) -- initialize recording system
+
+procedure PS_init(a[])
+   if /PS_active then PSStart ! a
+   return
+end
+
+procedure PSStart(a[])
+local fname, scale, psw, psh, llx, lly
+
+   if \PS_active then PSDone()
+   PS_afix(a)
+   PS_win := \a[1] | \&window | runerr(140, a[1])
+   fname := \a[2] | "xlog.ps"
+   PS_f := open(fname, "w") | stop("can't open", fname)
+
+   # calculate output scaling
+   # max (&default) scaling is 1.0 (72 pixels per inch)
+   # max size image allowed comes within 0.5" of all four borders
+   PS_width := WAttrib(PS_win, "width")
+   PS_height := WAttrib(PS_win, "height")
+   scale := 1.0
+   scale >:= 72 * (8.5 - 0.5 - 0.5) / PS_width
+   scale >:= 72 * (11.0 - 0.5 - 0.5) / PS_height
+
+   # position window in center of page
+   psw := integer(scale * PS_width + 0.9999)	# width in ps coords
+   psh := integer(scale * PS_height + 0.9999)	# height
+   llx := integer((72 * 8.5 - psw) / 2)		# center horizontally
+   lly := integer((72 * 11.0 - psh) / 2)	# center vertically
+   if lly + psh < 72 * 9.5 then
+      lly := integer(72 * 9.5 - psh)		# but not over 1.5" from top
+
+   # write EPS header
+   PS_out("%!PS-Adobe-3.0 EPSF-3.0")
+   PS_out("%%BoundingBox:", llx, lly, llx + psw + 1, lly + psh + 1)
+   PS_out("%%Creator:", &progname)
+   PS_out("%%CreationDate:", &dateline)
+   PS_out("%%EndComments")
+   PS_out()
+
+   every PS_out(![			# output PostScript file header
+
+      # define variables now so that bound procs get correct versions
+      "/BGR 0 def /BGG 0 def /BGB 0 def",
+
+      # shorthand procedures
+      "/bd {bind def} bind def",
+      "/m {moveto} bd",
+      "/l {lineto} bd",
+      "/s {stroke} bd",
+      "/f {fill} bd",
+
+      # construct a rectangular path; usage is: w h x y <r>
+"/r {moveto dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath} bd",
+
+      # procedures for remembering state
+      "/fg {setrgbcolor} bd",					# foreground
+      "/bg {/BGB exch def /BGG exch def /BGR exch def} bd",	# background
+      "/ft {findfont exch dup neg matrix scale makefont setfont} bd", # font
+
+      # A new clip path may not be inside old path as needed by PS.
+      # Save the old context, pop back to full-screen graphics state,
+      # restore other context, and set clip path.
+      "/cp {currentfont currentrgbcolor grestore gsave setrgbcolor setfont",
+      "     r clip newpath } bd",
+
+      # drawing procedures
+      "/t {moveto show newpath} bd",				# text string
+      "/p {0.5 0 360 arc fill} bd",				# point
+      "/g {moveto lineto stroke} bd",				# line segment
+      "/pf {closepath fill} bd",				# filled polygon
+      "/c {0 360 arc stroke} bd",				# circle
+      "/cf {0 360 arc fill} bd",				# filled circle
+      "/a {gsave translate 1.0 exch scale arc stroke grestore} bd",	# arc
+      "/af {gsave translate 1.0 exch scale 0 0 moveto arc fill grestore} bd",
+      "/er {gsave r BGR BGG BGB setrgbcolor fill grestore} bd",	# erase area
+   ])
+
+   # establish coordinate system
+   PS_out(llx, lly + psh, "translate")
+   PS_out(psw + 1, -(psh + 1), "0 0 r clip newpath")
+   PS_out(scale, -scale, "scale")
+   PS_out("0.5 0.5 translate")
+   PS_out("gsave")				# save full-window gpx env
+
+   # swap our routines for those of Icon
+   if /PS_active := 1 then
+      PS_swap()
+
+   # note graphics values in PS file
+   Font(PS_win, Font(PS_win))
+   Fg(PS_win, Fg(PS_win))
+   Bg(PS_win, Bg(PS_win))
+
+   PS_out(PS_width, PS_height, "0 0 er")	# fill background
+   write(PS_f)
+return
+end
+
+#  PS_out(s, s, ...) -- output strings to PS file, with spaces between
+
+procedure PS_out(a[])
+   if /a[1] then
+      return
+   writes(PS_f, get(a))
+   while writes(PS_f, " ", get(a))
+   write(PS_f)
+   return
+end
+
+#  PS_path(a, s) -- output path from a[2..*] followed by command s
+
+procedure PS_path(a, s)
+   local i
+
+   PS_out(a[2], a[3], "m")
+   every i := 4 to *a - 3 by 2 do
+      PS_out(a[i], a[i+1], "l")
+   PS_out(a[-2], a[-1], "l", s)
+   return
+end
+
+#  PS_afix(a) -- fix arg list to ensure that first arg is a window
+
+procedure PS_afix(a)
+   if not (type(a[1]) == "window") then
+      push(a, &window)
+   return a
+end
+
+####################  Icon Function Substitutes  ####################
+
+procedure PS_flush(a[])		# replaces WFlush
+   # we don't know why they're flushing, but we'll flush, too
+   flush(PS_f)
+   return PS_flush ! a
+end
+
+
+procedure PS_bg(a[])		# replaces Bg
+   PS_afix(a)
+   # note that following line fails if there is no a[2]
+   PS_out(PS_color(a[2]), "bg")
+   return PS_bg ! a
+end
+
+procedure PS_fg(a[])		# replaces Fg
+   PS_afix(a)
+   # note that following line fails if there is no a[2]
+   PS_out(PS_color(a[2]), "fg")
+   return PS_fg ! a
+end
+
+procedure PS_color(color)	# parse color, return string of PS r, g, b
+   local r, g, b
+   (ColorValue(PS_win, color) | fail) ? {
+      r := tab(many(&digits));  move(1)
+      g := tab(many(&digits));  move(1)
+      b := tab(many(&digits))
+      }
+   return (r / 65535.0) || " " || (g / 65535.0) || " " || (b / 65535.0)
+end
+
+procedure PS_drawpoint(a[])	# replaces DrawPoint
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 2 do
+      PS_out(a[i], a[i+1], "p")
+   return PS_drawpoint ! a
+end
+
+procedure PS_drawsegment(a[])	# replaces DrawSegment
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 4 do
+      PS_out(a[i], a[i+1], a[i+2], a[i+3], "g")
+   return PS_drawsegment ! a
+end
+
+procedure PS_drawline(a[])	# replaces DrawLine
+   local i
+
+   PS_afix(a)
+   if *a == 5 then
+      PS_out(a[2], a[3], a[4], a[5], "g")
+   else
+      PS_path(a, "s")
+   return PS_drawline ! a
+end
+
+procedure PS_drawcurve(a[])	# replaces DrawCurve -- approx with line segs
+   local i
+
+   PS_afix(a)
+   PS_path(a, "s")
+   return PS_drawcurve ! a
+end
+
+procedure PS_drawrect(a[])	# replaces DrawRectangle
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 4 do
+      PS_out(a[i+2], a[i+3], a[i], a[i+1], "r s")
+   return PS_drawrect ! a
+end
+
+procedure PS_fillrect(a[])	# replaces FillRectangle
+   local i
+
+   PS_afix(a)
+   every i := 2 to *a by 4 do
+      PS_out(a[i+2], a[i+3], a[i], a[i+1], "r f")
+   return PS_fillrect ! a
+end
+
+procedure PS_fillpoly(a[])	# replaces FillPolygon
+   local i
+
+   PS_afix(a)
+   PS_path(a, "pf")
+   return PS_fillpoly ! a
+end
+
+
+procedure PS_clip(a[])		# replaces Clip
+   PS_area(a, "cp")
+   return PS_clip ! a
+end
+
+procedure PS_erasearea(a[])	# replaces EraseArea
+   PS_area(a, "er")
+   return PS_erasearea ! a
+end
+
+procedure PS_area(a, cmd)	# generate w, h, x, y, and cmd, with defaults
+   local x, y, w, h
+   PS_afix(a)
+
+   x := \a[2] | 0
+   y := \a[3] | 0
+   w := (0 ~= \a[4]) | PS_width
+   h := (0 ~= \a[5]) | PS_height
+   PS_out(w, h, x, y, cmd)
+end
+
+procedure PS_drawcircle(a[])	# replaces DrawCircle
+   PS_arc(a, 0, "")
+   return PS_drawcircle ! a
+end
+
+procedure PS_fillcircle(a[])	# replaces FillCircle
+   PS_arc(a, 0, "f")
+   return PS_fillcircle ! a
+end
+  
+procedure PS_drawarc(a[])	# replaces DrawArc
+   PS_arc(a, 1, "")
+   return PS_drawarc ! a
+end
+
+procedure PS_fillarc(a[])	# replaces FillArc
+   PS_arc(a, 1, "f")
+   return PS_fillarc ! a
+end
+
+procedure PS_arc(a, n, f)	# handle draw/fill arc/circle, append f to cmd
+   local x, y, w, h, ar, a1, a2, r, i
+   static mul
+   initial mul := 180 / &pi
+
+   PS_afix(a)
+   every i := 2 to *a by (5 + n) do {
+      x := a[i]
+      y := a[i+1]
+      w := a[i+2] 
+      h := a[i+2+n]
+      a1 := (\a[i+n+3] * mul) | 0.0
+      a2 := (\a[i+n+4] * mul) | 360.0
+      if n = 1 then {		# if DrawArc
+         r := w / 2.0			# radius
+         x +:= r			# center coordinates
+         y +:= r
+         }
+      else
+         r := w
+      if w = h & abs(a2) > 359.99 then	# if circle
+         PS_out(x, y, r, "c" || f)
+      else {				# general case
+         if a2 < 0 then {
+            a1 := a1 + a2	# ensure counterclockwise arc (in PS coords)
+            a2 := -a2
+            }
+         if w = 0 then
+            ar := 0.0
+         else
+            ar := real(h) / real(w)
+         PS_out("0 0", r, a1, a1 + a2, ar, x, y, "a" || f)
+         }
+      }
+   return
+end
+
+procedure PS_font(a[])	     	# replaces Font (very crudely)
+   local ret, xname, psname, n
+
+   PS_afix(a)
+   if not (ret := PS_font ! a) then
+      fail
+   if xname := \a[2] then {
+      map(xname) ? {
+         if tab(many(&digits)) & ="x" & tab(many(&digits)) & pos(0) then
+            psname := "/Courier"
+         else if find("fixed" | "courier" | "typewriter") & find("bold") then
+            psname := "/Courier-Bold"
+         else if find("fixed" | "courier" | "typewriter") then
+            psname := "/Courier"
+         else if find("helvetica" | "sans") & find("bold") then
+            psname := "/Helvetica-Bold"
+         else if find("helvetica" | "sans") & find("oblique") then
+            psname := "/Helvetica-Oblique"
+         else if find("helvetica" | "sans") then
+            psname := "/Helvetica"
+         else if find("times") & find("bold")then
+            psname := "/Times-Bold"
+         else if find("times") & find("italic")then
+            psname := "/Times-Italic"
+         else if find("times") then
+            psname := "/Times-Roman"
+         else if find("bold") then
+            psname := "/Palatino-Bold"
+         else if find("italic") then
+            psname := "/Palatino-Italic"
+         else
+            psname := "/Palatino-Roman"
+         }
+      n := WAttrib(PS_win, "ascent") + 1	# could possibly be smarter
+      PS_out(n, psname, "ft  %", xname)
+      }
+   return ret
+end
+
+procedure PS_drawstring(a[])		# replaces DrawString
+   PS_afix(a)
+   PS_psstring(a[4])
+   PS_out("", a[2], a[3], "t")
+   return PS_drawstring ! a
+end
+
+procedure PS_psstring(s)		# output a string as a PS string
+   s ? {
+      writes(PS_f, "(")
+      while writes(PS_f, tab(upto('()\\'))) do
+         writes(PS_f, "\\", move(1))
+      writes(PS_f, tab(0), ")")
+   }
+   return
+end
+
+#  PS_attrib() -- handle WAttrib calls
+#
+#  Any attribute that is accepted here should also be checked and set to
+#  the correct value during initialization in order to catch attributes
+#  that were set on the open() call.
+
+procedure PS_attrib(alist[])		# replaces WAttrib
+   local win, ret, name, val, a
+
+   PS_afix(alist)
+   ret := alist
+   ret := PS_attrib ! alist
+   win := pop(alist)			# remove window arg
+   every a := !alist do a ? {		# process each attribute
+      name := tab(upto('=')) | next
+      move(1)
+      val := tab(0)
+      case name of {
+         "fg":    Fg(win, val)
+         "bg":    Bg(win, val)
+         "font":  Font(win, val)
+         }
+      }
+   return a ~=== ret			# return value or fail if WAttrib failed
+end
diff --git a/ipl/gprocs/putpixel.icn b/ipl/gprocs/putpixel.icn
new file mode 100644
index 0000000..a31ee68
--- /dev/null
+++ b/ipl/gprocs/putpixel.icn
@@ -0,0 +1,163 @@
+############################################################################
+#
+#	File:     putpixel.icn
+#
+#	Subject:  Procedure to write quantized, processed pixel
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures assist pixel-by-pixel image construction.
+#
+#	PutPixel(W, x, y, k)	draws a single pixel after applying
+#				dithering, color quantization, and
+#				gamma correction.
+#
+#	PixInit(gamma, cquant, gquant, drandom)
+#				initializes parameters for PutPixel().
+#
+############################################################################
+#
+#     PutPixel([win,] x, y, colr) sets the pixel at (x,y) to the given color
+#  after applying dithering, color quantization, and gamma correction.
+#  It is designed for constructing images a pixel at a time.  The window's
+#  foreground color is left set to the adjusted color.
+#
+#     Colr can be any value acceptable to Fg.  Mutable colors are not
+#  dithered, quantized, or gamma-corrected.
+#
+#     PixInit(gamma, cquant, gquant, drandom) may be called before PutPixel
+#  to establish non-default parameters.  The default gamma value is 1.0
+#  (that is, no correction beyond Icon's usual gamma correction).
+#  cquant and gquant specify the number of color and grayscale quantization
+#  steps; the defaults are 6 and 16 respectively.  If gquant + cquant ^ 3
+#  exceeds 256 there is a potential for running out of colors.  drandom
+#  is the fraction (0 to 1) of the dithering to be done randomly; the
+#  default is zero.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global XPP_qtab, XPP_gtab, XPP_dtab, XPP_rtab, XPP_gadjust
+
+#  PixInit -- set parameters and build tables
+
+procedure PixInit(gamma, cquant, gquant, drandom)  #: initialize pixel processing
+   local PIXRANGE, NRANDOM, cstep, gstep, indx, appx, gcor, i
+
+   /gamma := 1.0			# gamma correction factor
+   /cquant := 6				# color quantization steps
+   /gquant := 16			# grayscale quantization
+   /drandom := 0.0			# fraction of dithering to do randomly
+
+   NRANDOM := 500			# size of random number table
+   PIXRANGE := 255			# pixel value range 0..255
+
+   if gamma < 0.01 then			# ensure legal values
+      gamma := 2.5
+   cquant <:= 2
+   gquant <:= 2
+   drandom <:= 0.0
+   drandom >:= 1.0
+
+   cstep := (PIXRANGE / (cquant-1.0))	# color step size
+   gstep := (PIXRANGE / (gquant-1.0))	# grayscale step size
+
+   # build 4 x 4 dither table (choose one)
+   # XPP_dtab := [0,8,2,10,12,4,14,6,3,11,1,9,15,7,13,5]  # ordered dither
+   XPP_dtab := [0,6,9,15,11,13,2,4,7,1,14,8,12,10,5,3]  # magic square dither
+   every i := 1 to 16 do	# normalize
+      XPP_dtab[i] := (XPP_dtab[i]/15.0 - 0.5) * (cstep - 3) * (1.0 - drandom)
+
+   # build list of scaled random numbers for dithering
+   XPP_rtab := list(NRANDOM)
+   every !XPP_rtab := (?0 - 0.5) * 2 * (cstep - 3) * drandom
+
+   # build table for combined quantization and gamma correction
+   XPP_qtab := list(PIXRANGE+1)
+   every i := 0 to PIXRANGE do {
+      indx := integer((i + cstep / 2) / cstep)
+      appx := cstep * indx
+      gcor := PIXRANGE * ((real(appx) / real(PIXRANGE)) ^ (1.0 / gamma))
+      XPP_qtab[i+1] := integer(gcor + 0.5)
+      }
+   # build similar table for grayscale
+   XPP_gtab := list(PIXRANGE+1)
+   every i := 0 to PIXRANGE do {
+      indx := integer((i + gstep / 2) / gstep)
+      appx := gstep * indx
+      gcor := PIXRANGE * ((real(appx) / real(PIXRANGE)) ^ (1.0 / gamma))
+      XPP_gtab[i+1] := integer(gcor + 0.5)
+      }
+   # grayscale adjustment for different quantization
+   XPP_gadjust := (gstep - 3) / (cstep - 3)
+   return
+end
+
+#  PutPixel -- write a pixel
+
+procedure PutPixel(win, x, y, color)		   #: write pixel
+   local i, r, g, b
+
+   initial if /XPP_qtab then PixInit()
+
+   # default win to &window if omitted
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: color
+      win := &window
+      }
+
+   # convert color to 8-bit r, g, b
+   if type(color) == "integer" then {
+      # mutable -- don't quantize
+      Fg(win, color)
+      DrawPoint(win, x, y)
+      return
+      }
+
+   (color | ColorValue(color) | fail) ? (
+      (r := tab(many(&digits))) & move(1) &
+      (g := tab(many(&digits))) & move(1) &
+      (b := tab(many(&digits)))
+      )
+
+   # convert three 0..65535 ints to 0..255
+   r := (r + 255) / 257
+   g := (g + 255) / 257
+   b := (b + 255) / 257
+
+   # get dither table index based on coordinates
+   i := iand(x, 3) + 4 * iand(y, 3) + 1
+
+   if r = g = b then {
+      g := integer(g + XPP_gadjust * (XPP_dtab[i] + ?XPP_rtab))
+      (g <:= 1) | (g >:= 256)
+      r := g := b := 257 * XPP_gtab[g]
+      }
+   else {
+      r := integer(r + XPP_dtab[i] + ?XPP_rtab + 1.5)
+      g := integer(g - XPP_dtab[i] + ?XPP_rtab + 1.5)
+      b := integer(b + XPP_dtab[i] + ?XPP_rtab + 1.5)
+      (r <:= 1) | (r >:= 256)
+      (g <:= 1) | (g >:= 256)
+      (b <:= 1) | (b >:= 256)
+      r := 257 * XPP_qtab[r]
+      g := 257 * XPP_qtab[g]
+      b := 257 * XPP_qtab[b]
+      }
+
+   # finally, put the pixel on the screen
+   Fg(win, r || "," || g || "," || b)
+   DrawPoint(win, x, y)
+   return
+end
diff --git a/ipl/gprocs/randarea.icn b/ipl/gprocs/randarea.icn
new file mode 100644
index 0000000..130a0a4
--- /dev/null
+++ b/ipl/gprocs/randarea.icn
@@ -0,0 +1,65 @@
+############################################################################
+#
+#	File:     randarea.icn
+#
+#	Subject:  Procedures to generate random points in areas
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures generate randomly selected points with specified
+#  areas.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure randrect(x, y, w, h)
+
+   w := integer(w) | stop("*** bad value")
+   h := integer(h) | stop("*** bad value")
+
+   x -:= 1
+   y -:= 1
+   
+   suspend Point(x + ?|w, y + ?h)
+
+end
+
+procedure randellip(x, y, w, h)
+   local r1, r2, xc, yc, xp, yp, xq, yq, theta, rp, r
+
+   w := integer(w) | stop("*** bad value")
+   h := integer(h) | stop("*** bad value")
+
+   r1 := w / 2
+   r2 := h / 2
+   xc := x + r1
+   yc := y + r2
+
+   x -:= 1
+   y -:= 1
+   
+   repeat {
+      xq := x + ?w
+      yq := y + ?h
+      xp := xq - xc
+      yp := yq - yc
+      theta := -atan(yp, xp)
+      rp := sqrt(xp ^ 2 + yp ^ 2)
+      r := sqrt((r1 * cos(theta)) ^ 2 + (r2 * sin(theta)) ^ 2)
+      if r > rp then suspend Point(xq, yq)
+      }
+
+end
diff --git a/ipl/gprocs/randfigs.icn b/ipl/gprocs/randfigs.icn
new file mode 100644
index 0000000..4097f07
--- /dev/null
+++ b/ipl/gprocs/randfigs.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     randfigs.icn
+#
+#	Subject:  Procedures to generate random figures
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 27, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures generate random geometrical figures.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+#
+#  random_points(width, height) generates an infinite sequence of
+#  randomly chosen points within the area bounded by 0, 0 and width - 1,
+#  height - 1.
+
+procedure random_points(width, height)
+
+   suspend |Point(?width - 1, ?height - 1)
+
+end
+
+#
+#  random_lines(width, height) generates an infinite sequence of
+#  randomly chosen lines within the area bounded by 0, 0 and width - 1,
+#  height - 1.
+
+procedure random_lines(width, height)
+
+   suspend |Line(Point(?width - 1, ?height - 1),
+      Point(?width - 1, ?height - 1))
+
+end
diff --git a/ipl/gprocs/rawimage.icn b/ipl/gprocs/rawimage.icn
new file mode 100644
index 0000000..8385c5b
--- /dev/null
+++ b/ipl/gprocs/rawimage.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:	  rawimage.icn
+#
+#	Subject:  Procedures to write and read images in raw format
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures write and read raw image files.  The format of a raw
+#  image file is:
+#
+#	width,height
+#	<palette entries with 2 hex digits, a blank, and a color specification>
+#	<blank line>
+#	<image data consisting of pairs of hext digits in row-primary order>
+#
+#  These procedures are slow and should only be used when the image file
+#  formats that Icon can read and write are not sufficient.
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions
+#
+############################################################################
+
+link wopen
+
+$define LineLen 64
+
+procedure WriteRaw(win, x, y, w, h)
+   local nextid, palette, line, c, temp, tempname
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := &window
+      }
+
+   /w := WAttrib(win, "width")
+   /h := WAttrib(win, "height")
+   /x := 0
+   /y := 0
+
+   tempname := "/tmp/reg." || map("mmhhss", "mm:hh:ss", &clock)
+   temp := open(tempname, "w") | stop("*** cannot open temporary file")
+
+
+   line := ""
+
+   palette := table()
+
+   nextid := create !"0123456789abcdef" || !"0123456789abcdef"
+
+   every c := Pixel(win, x, y, w, h) do {
+      /palette[c] := @nextid
+      line ||:= palette[c]
+      line ?:= {
+         write(temp, move(LineLen)) & tab(0)
+         }
+      }
+
+   write(temp, "" ~== line)
+
+   write(w, ",", h)
+
+   palette := sort(palette, 4)
+
+   while c := get(palette) do
+      write(get(palette), " ", c)
+
+   write()			# separator
+
+   close(temp)
+   temp := open(tempname) | stop("*** cannot find temporary file")
+
+   while writes(reads(temp, 10000))	# copy image data
+
+   close(temp)
+   remove(tempname)
+
+   return 
+
+end
+
+procedure ReadRaw(win, s, x, y)
+   local input, palette, c, temp, size, width, height, line
+
+   if type(win) ~== "window" then {
+      win :=: s :=: x :=: y
+      win := &window
+      }
+
+   input := open(s) | stop("*** cannot read raw image file")
+
+   temp := WOpen("size=" || (size := read(input)), "canvas=hidden") |
+      stop("*** malformed raw image file")
+
+   size ? {
+      width := integer(tab(upto(','))) &
+      move(1) &
+      height := integer(tab(0)) | stop("invalid raw image header")
+      }
+
+   palette := table()
+
+   while line := read(input) do
+      line ? {
+         palette[move(2) | break] := (move(1), tab(0))
+         }
+
+   x := y := 0
+
+   repeat {
+      line := read(input) | break
+      line ? {
+         while c := move(2) do {
+            Fg(temp, palette[c]) | stop("***invalid color: ", c)
+            DrawPoint(temp, x, y)
+            x +:= 1
+            if x = width then {
+               x := 0
+               y +:= 1
+               }
+            }
+         }
+      }
+
+   CopyArea(temp, win, 0, 0, width, height, x, y)
+
+   return
+           
+end
diff --git a/ipl/gprocs/repeats.icn b/ipl/gprocs/repeats.icn
new file mode 100644
index 0000000..524ea61
--- /dev/null
+++ b/ipl/gprocs/repeats.icn
@@ -0,0 +1,53 @@
+############################################################################
+#
+#	File:     repeats.icn
+#
+#	Subject:  Procedure to repeat image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 23, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces repeats of an image specified number of times.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  tile, wopen
+#
+############################################################################
+
+link tile
+link wopen
+
+procedure repeats(name, i, j)		#: repeat image
+   local opts, prefix, win1, win2, width, height
+   local auto, wdim, hdim, limit
+
+   /i := 1			# horizontal repeats
+   /j := 1			# vertical repeats
+
+   win1 := WOpen("canvas=hidden", "image=" || name) | fail
+   width := WAttrib(win1, "width")
+   height := WAttrib(win1, "height")
+   hdim := height * i
+   wdim := width * j
+
+   win2 := WOpen("canvas=hidden", "width=" || wdim, "height=" || hdim) |
+      stop(&errout, "*** cannot open window for repeat")
+
+   tile(win1, win2)
+
+   WClose(win1)
+
+   return win2
+end
diff --git a/ipl/gprocs/rgbcomp.icn b/ipl/gprocs/rgbcomp.icn
new file mode 100644
index 0000000..544e108
--- /dev/null
+++ b/ipl/gprocs/rgbcomp.icn
@@ -0,0 +1,98 @@
+############################################################################
+#
+#	File:     rgbcomp.icn
+#
+#	Subject:  Procedures to perform computations on RGB values
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     January 14, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  rgbsum(s1, s2) returns a color whose RGB components are the sums of the
+#  components for s1 and s2.
+#
+#  rgbdif(s1, s2) returns a color whose RGB components are the differences of
+#  the components for s1 and s2. 
+#
+#  rgbavg(s1, s2) returns a color whose RGB components are the averages of
+#  the components for s1 and s2.
+#
+#  rsgcomp(s) returns the color that is the complement of s.
+#
+#  The results may not be what's expected in some cases.
+#
+############################################################################
+#
+#  Requires:   Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, rgbrec
+#
+############################################################################
+
+link numbers
+link rgbrec
+
+$define MaxIntensity (2 ^ 16 - 1)
+
+procedure rgbsum(s1, s2)
+   local rgb1, rgb2
+
+    rgb1 := rgbrec(s1) | fail
+    rgb2 := rgbrec(s2) | fail
+
+   return rgbrec(
+      max(rgb1.r + rgb2.r, MaxIntensity),
+      max(rgb1.g + rgb2.g, MaxIntensity),
+      max(rgb1.b + rgb2.b, MaxIntensity)
+      )
+
+end
+
+procedure rgbdif(s1, s2)
+   local rgb1, rgb2
+
+    rgb1 := rgbrec(s1) | fail
+    rgb2 := rgbrec(s2) | fail
+
+   return rgbrec(
+      min(rgb1.r - rgb2.r, 0),
+      min(rgb1.g - rgb2.g, 0),
+      min(rgb1.b - rgb2.b)
+      )
+
+end
+
+procedure rgbavg(s1, s2)
+   local rgb1, rgb2
+
+    rgb1 := rgbrec(s1) | fail
+    rgb2 := rgbrec(s2) | fail
+
+   return rgbrec(
+      (rgb1.r + rgb2.r) / 2,
+      (rgb1.g + rgb2.g) / 2,
+      (rgb1.b + rgb2.b) / 2
+      )
+
+end
+
+procedure rgbcomp(s)
+   local rgb
+
+    rgb := rgbrec(s) | fail
+
+   return rgbrec(
+      MaxIntensity - rgb.r,
+      MaxIntensity - rgb.g,
+      MaxIntensity - rgb.b
+      )
+
+end
diff --git a/ipl/gprocs/rgbrec.icn b/ipl/gprocs/rgbrec.icn
new file mode 100644
index 0000000..48092b1
--- /dev/null
+++ b/ipl/gprocs/rgbrec.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     rgbrec.icn
+#
+#	Subject:  Procedure to produce RGB record from color specification
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a three-field RGB record from an Icon color
+#  specification.  It fails id its argument is not a valid color specifi-
+#  cation.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record rgb(r, g, b)
+
+procedure rgbrec(s)
+   local result
+
+   s := ColorValue(s) | fail
+
+   result := rgb()
+
+   s ? {
+      result.r := tab(upto(','))
+      move(1)
+      result.g := tab(upto(','))
+      move(1)
+      result.b := tab(0)
+      }
+
+   return result
+
+end
+
+
diff --git a/ipl/gprocs/rpolys.icn b/ipl/gprocs/rpolys.icn
new file mode 100644
index 0000000..4af3195
--- /dev/null
+++ b/ipl/gprocs/rpolys.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     rpolys.icn
+#
+#	Subject:  Procedure to produce traces of regular polygons
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 24, 1999
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# Generate points for a regular polygon with the specified number of
+# vertices and radius, centered at cx and cy.  The offset angle is theta;
+# default 0.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure rpoly(cx, cy, radius, vertices, theta)	#: generate polygon points
+   local incr, i
+
+   incr := 2 * &pi / vertices
+   /theta := 0			# starting angle
+
+   every i := 1 to vertices do {
+      suspend Point(cx + radius * cos(theta), cy + radius * sin(theta))
+      theta +:= incr
+      }
+
+end
diff --git a/ipl/gprocs/rstars.icn b/ipl/gprocs/rstars.icn
new file mode 100644
index 0000000..3372f2a
--- /dev/null
+++ b/ipl/gprocs/rstars.icn
@@ -0,0 +1,58 @@
+############################################################################
+#
+#	File:     rstars.icn
+#
+#	Subject:  Procedure to generate traces of regular stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 27, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure generates traces of regular stars.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+global size
+
+#
+#  Generate points on regular star with n vertices, jumping j vertices,
+#  centered at x and y, with scaled radius, with an initial offset angle,
+#  and with a specified frame size.
+
+procedure rstar(x, y, n, j, scale, offset, size)	#:  regular star
+   local i, jangle, angle
+
+   /x := 100				# defaults
+   /y := 100 
+   /n := 5
+   /j := 3
+   /scale := 0.45
+   /offset := 0.5
+   /size := 200
+
+   jangle := j * 2 * &pi / n
+
+   scale *:= size
+   offset *:= &pi
+
+   every i := 0 to n do {
+      angle := jangle * i + offset
+      suspend Point(
+          x + scale * cos(angle),
+          y + scale * sin(angle)
+         )
+      }
+
+end
diff --git a/ipl/gprocs/rstartbl.icn b/ipl/gprocs/rstartbl.icn
new file mode 100644
index 0000000..0e7ec66
--- /dev/null
+++ b/ipl/gprocs/rstartbl.icn
@@ -0,0 +1,46 @@
+############################################################################
+#
+#	File:     rstartbl.icn
+#
+#	Subject:  Procedure to produce calls for regular stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 8, 1993
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a table of calls from which regular stars
+#  can be produced.
+#
+############################################################################
+#
+#  See also:  rstars.icn
+#
+############################################################################
+#
+#  Links:  calls, rstars
+#
+############################################################################
+
+link calls
+link rstars
+
+procedure rstartbl()
+   local rstars
+
+   rstars := table()
+   rstars["rstar01"] := call(rstar, [300, 300,  5,  3, 0.45])
+   rstars["rstar02"] := call(rstar, [300, 300,  7,  3, 0.45])
+   rstars["rstar03"] := call(rstar, [300, 300, 20,  9, 0.45])
+   rstars["rstar04"] := call(rstar, [300, 300, 20,  7, 0.45])
+   rstars["rstar05"] := call(rstar, [300, 300, 51, 20, 0.45])
+   rstars["rstar06"] := call(rstar, [300, 300, 51, 25, 0.45])
+
+   return rstars
+
+end
diff --git a/ipl/gprocs/select.icn b/ipl/gprocs/select.icn
new file mode 100644
index 0000000..9557c00
--- /dev/null
+++ b/ipl/gprocs/select.icn
@@ -0,0 +1,99 @@
+############################################################################
+#
+#	File:     select.icn
+#
+#	Subject:  Procedure to get selection from window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: grecords
+#
+############################################################################
+
+link grecords
+
+procedure select(win)		#: interactive selection from window
+   local x0, x1, y0, y1, w, h, state, event
+
+   /win := &window
+
+   WAttrib(win, "drawop=reverse")
+   WAttrib(win, "linestyle=onoff")
+
+   state := "wait"
+   
+   while event := Event(win) do {
+      if event == "q" then {
+         DrawRectangle(win, \x0, y0, 0, 0)	# clear if already drawn
+         fail
+         }
+      case state of {
+         "wait": {			# waiting for selection
+            case event of {
+               &lpress: {
+                  x1 := x0 := &x	# initial coordinates
+                  y1 := y0 := &y
+                  DrawRectangle(win, x0, y0, 0, 0)	# start selection
+                  state := "select"	# now select the rectangle
+                  }
+               }
+            }
+         "select": {			# select the rectangle
+            case event of {
+               &ldrag: {		# selecting ...
+                  DrawRectangle(win, x0, y0, x1 - x0, y1 - y0) # erase
+                  x1 := &x		# new opposite corner
+                  y1 := &y
+                  DrawRectangle(win, x0, y0, x1 - x0, y1 - y0) # draw
+                  }
+               &lrelease: {		# got it!
+                  DrawRectangle(win, x0, y0, x1 - x0, y1 - y0) # erase
+                  x1 := &x		# new opposite corner
+                  y1 := &y
+                  if (x0 = x1) | (y0 = y1) then	# no area
+                     state := "wait"
+                  else {
+                     w := x1 - x0	# set up for action
+                     h := y1 - y0 
+                     DrawRectangle(win, x0, y0, w, h) # draw rectangle
+                     state := "act"	# now do something
+                     }
+                  }
+               }
+            }
+         "act": {
+            case event of {
+               "n":  {			# new selection
+                     state := "wait"
+                     DrawRectangle(win, x0, y0, w, h) # try again
+                     }
+               "q":  {			# quit
+                     DrawRectangle(win, x0, y0, w, h)
+                     fail
+                     }
+               "r":  {			# return selection
+                     DrawRectangle(win, x0, y0, w, h) #
+                     return rect(x0, y0, w, h)
+                     }
+               }
+            }
+         }
+      }
+
+end
diff --git a/ipl/gprocs/slider.icn b/ipl/gprocs/slider.icn
new file mode 100644
index 0000000..39c0dba
--- /dev/null
+++ b/ipl/gprocs/slider.icn
@@ -0,0 +1,210 @@
+############################################################################
+#
+#	File:     slider.icn
+#
+#	Subject:  Procedures for slider sensors
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures implement slider using the "evmux" event
+#	multiplexor instead of the usual vidget library.
+#
+#	slider(win, proc, arg, x, y, w, h, lb, iv, ub)  creates a slider.
+#
+#	slidervalue(h, v)			modifies a slider's value.
+#
+############################################################################
+#
+#  slider(win, proc, arg, x, y, w, h, lb, iv, ub)
+#
+#	establishes a slider and returns a handle for use with slidervalue().
+#
+#	x,y,w,h give the dimensions of the slider.  The slider runs vertically
+#	or horizontally depending on which of w and h is larger.  20 makes a
+#	nice width (or height).
+#
+#	lb and ub give the range of real values represented by the slider;
+#	lb is the left or bottom end.  iv is the initial value.
+#	proc(win, arg, value) is called as the slider is dragged to different
+#	positions.
+#
+#  slidervalue(h, v)
+#
+#	changes the position of the slider h to reflect value v.
+#	The underlying action procedure is not called.
+#
+############################################################################
+#
+#  Example:  A simple color picker
+#
+#	record color(red, green, blue)
+#	global win, spot
+#
+#		...
+#	    Fg(win, spot := NewColor(win))
+#	    Color(win, spot, "gray50")
+#	    FillArc(win, 10, 10, 100, 100)
+#	    Fg(win, "black")
+#	    h1 := slider(win, setcolor, 1, 110, 10, 20, 100, 0, 32767, 65535)
+#	    h2 := slider(win, setcolor, 2, 140, 10, 20, 100, 0, 32767, 65535)
+#	    h3 := slider(win, setcolor, 3, 170, 10, 20, 100, 0, 32767, 65535)
+#		...
+#
+#	procedure setcolor(win, n, v)
+#	    static fg
+#	    initial fg := color(32767, 32767, 32767)
+#	    fg[n] := v
+#	    Color(win, spot, fg.red || "," || fg.green || "," || fg.blue)
+#	end
+#
+#	Draw a filled circle in a mutable color that is initially gray.
+#	Draw three parallel, vertical sliders of size 20 x 100.  Their values
+#	run from 0 to 65535 and they are each initialized at the midpoint.
+#	(The values are only used internally; the sliders are unlabeled.)
+#
+#	When one of the sliders is moved, call setcolor(win, n, v).
+#	n, from the "arg" value when it was built, identifies the slider.
+#	v is the new value of the slider.   Setcolor uses the resulting
+#	color triple to set the color of the mutable color "spot".
+#
+#	Additional calls
+#	    every slidervalue(h1 | h2 | h3, 32767)
+#	    every setcolor(win, 1 to 3, 32767)
+#	would reset the original gray color.  Note that explicit calls to
+# 	setcolor are needed because slidervalue does not call it.
+#
+############################################################################
+#
+#  Links: evmux, graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  evmux.icn
+#
+############################################################################
+
+link evmux
+link graphics
+
+$define MARGIN 10
+
+record Slider_Rec(win, proc, arg, x, y, w, h, lb, ub, n)
+
+procedure slider(win, proc, arg, x, y, w, h, lb, iv, ub)
+   local r
+
+   r := Slider_Rec(win, proc, arg, x, y, w, h, lb, ub)
+   slidervalue(r, iv)
+   if h > w then 	# vertical slider
+      sensor(win, &lpress, Exec_Vert_Slider, r, x, y - MARGIN, w, h + 2*MARGIN)
+   else			# horizontal slider
+      sensor(win, &lpress, Exec_Horiz_Slider, r, x - MARGIN, y, w + 2*MARGIN, h)
+   return r
+end
+
+procedure slidervalue(r, v)
+   local n
+
+   Erase_Slider_Bar(r)			# erase old handle
+   if r.lb ~= r.ub then
+      v := real(v - r.lb) / (r.ub - r.lb)
+   else
+      v := 0.0
+   v <:= 0.0
+   v >:= 1.0
+   if r.h > r.w then			# if vertical
+      n := r.y + integer((1.0 - v) * (r.h - 1) + 0.5)
+   else
+      n := r.x + integer(v * (r.w - 1) + 0.5)
+   Set_Slider_Posn(r, n)		# redraw track and handle
+   return
+end
+
+procedure Set_Slider_Posn(r, n)
+   local c
+
+   r.n := n
+   if r.h > r.w then {
+      c := r.x + r.w / 2
+      BevelRectangle(r.win, c - 2, r.y, 4, r.h, -2)	# vertical track
+      BevelRectangle(r.win, r.x, r.n - 3, r.w, 6)	# horizontal bar
+      FillRectangle(r.win, r.x + 2, r.n - 1, r.w - 4, 2)
+      }
+   else {
+      c := r.y + r.h / 2
+      BevelRectangle(r.win, r.x, c - 2, r.w, 4, -2)	# horizontal track
+      BevelRectangle(r.win, r.n - 3, r.y, 6, r.h)	# vertical bar
+      FillRectangle(r.win, r.n - 1, r.y + 2, 2, r.h - 4)
+      }
+   return
+end
+
+procedure Erase_Slider_Bar(r)
+   if r.h > r.w then
+      EraseArea(r.win, r.x, \r.n - 3, r.w, 6)	# horizontal bar on vert. track
+   else
+      EraseArea(r.win, \r.n - 3, r.y, 6, r.h)	# vertical bar on horiz. track
+   return
+end
+
+procedure Exec_Vert_Slider(win, r, x, y)
+   local e, h, u, args, a, v
+
+   e := &lpress
+   repeat {
+      if type(e) == "integer" then {	# if a mouse event
+         y <:= r.y
+         y >:= r.y + r.h - 1
+         if y ~= r.n then {
+            Erase_Slider_Bar(r)
+            Set_Slider_Posn(r, y)
+            flush(r.win)
+            v := real(r.y + r.h - y - 1) / real(r.h - 1)	# 0.0 to 1.0
+            v := v * (r.ub - r.lb) + r.lb			# user range
+            r.proc(win, r.arg, v)
+            }
+         if e = &lrelease then
+            return
+         }
+      e := Event(win)
+      y := &y
+      }
+   return
+end
+
+procedure Exec_Horiz_Slider(win, r, x, y)
+   local e, h, u, args, a, v
+
+   e := &lpress
+   repeat {
+      if type(e) == "integer" then {	# if a mouse event
+         x <:= r.x
+         x >:= r.x + r.w - 1
+         if x ~= r.n then {
+            Erase_Slider_Bar(r)
+            Set_Slider_Posn(r, x)
+            flush(r.win)
+            v := real(x - r.x) / real(r.w - 1)		# 0.0 to 1.0
+            v := v * (r.ub - r.lb) + r.lb		# user range
+            r.proc(win, r.arg, v)
+            }
+         if e = &lrelease then
+            return
+         }
+      e := Event(win)
+      x := &x
+      }
+   return
+end
diff --git a/ipl/gprocs/spirals.icn b/ipl/gprocs/spirals.icn
new file mode 100644
index 0000000..52bc7cc
--- /dev/null
+++ b/ipl/gprocs/spirals.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     spirals.icn
+#
+#	Subject:  Procedure to produce traces of fractal stars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Draw spiral with n segments and t rotations, starting at (x,y).
+#  The extent determines the size of the drawing.
+#
+#  The eccentricity is e (1 gives circle) and the reduction factor is r.
+#  The angular increment is incr and the y scaling factor is yfact.
+#
+############################################################################
+#
+#  Links:  gobject, numbers
+#
+############################################################################
+
+link gobject
+link numbers
+
+procedure spiral(x, y, extent, n, t, e, r, incr, yfact)
+   local i, c, s, angle, redrad, x1, y1
+
+   incr := dtor(incr)
+
+   every i := 0 to n do {
+      redrad := r ^ div(i, n)
+      angle := (incr * i) / n
+      x1 := redrad * cos(t * angle)
+      y1 := redrad * e * sin(t * angle)
+      c := cos(angle)
+      s := sin(angle)
+      suspend Point(x + extent / 2 * (1 + x1 * c - y1 * s),
+         y + extent / 2 * yfact * (1 + x1 * s + y1 * c))
+      }
+
+end
diff --git a/ipl/gprocs/spokes.icn b/ipl/gprocs/spokes.icn
new file mode 100644
index 0000000..853de2d
--- /dev/null
+++ b/ipl/gprocs/spokes.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     spokes.icn
+#
+#	Subject:  Procedure to draw spokes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  spokes(x, y, radius1, radius2, n, m) draws spokes.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure spokes(x, y, radius1, radius2, n, m)
+   local angle1, incr1, angle2, incr2
+
+   angle1 := 0.0
+   incr1 := 2 * &pi / n
+
+   every 1 to n do {
+      suspend rays(x + radius1 * cos(angle1), y + radius1 * sin(angle1),
+         radius2, m, angle1)
+      angle1 +:= incr1
+      }
+
+end
+
+procedure rays(xc, yc, r, m, angle)
+   local incr
+
+   incr := 2 * &pi / m 
+
+   every 1 to m do {
+      suspend Point(xc, yc)
+      suspend Point(xc + r * cos(angle), yc + r * sin(angle))
+      suspend Point(xc, yc)
+      angle +:= incr
+      }
+
+end
+
diff --git a/ipl/gprocs/strpchrt.icn b/ipl/gprocs/strpchrt.icn
new file mode 100644
index 0000000..4a152d8
--- /dev/null
+++ b/ipl/gprocs/strpchrt.icn
@@ -0,0 +1,126 @@
+############################################################################
+#
+#	File:     strpchrt.icn
+#
+#	Subject:  Procedure for dynamic stripchart for windows
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	A stripchart models a continuous roll of paper that is marked along
+#	the right edge while it moves continuously to the left.  This is
+#	also known as a chart recording.
+#
+#	stripchart(window, x, y, width, height)	creates a stripchart.
+#
+#	sadvance(sc)				advances a stripchart.
+#
+#	smark(sc, y1, y2)			marks a stripchart.
+#
+############################################################################
+#
+#
+#   stripchart(window, x, y, width, height)
+#
+#	establishes a stripchart and returns a record sc for use with
+#	other procedures.
+#
+#	The chart can be marked by calling smark() or by drawing directly
+#	at location (sc.x, y) where y is arbitrary.
+#
+#   sadvance(sc)
+#
+#	advances the stripchart by one pixel.
+#
+#   smark(sc, y1, y2)
+#
+#	marks the current position of the stripchart from y1 to y2.  y2 may
+#	be omitted, in which case a single pixel at (sc.x, y1) is marked.
+#
+#	If the chart has not been advanced since the last mark at y1,
+#	nothing happens.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+record StripChart_Rec(win, x0, y, w, h, x, n, last)
+
+
+## stripchart(win, x, y, w, h) - create stripchart of size w by h at (x, y)
+
+procedure stripchart(win, x, y, w, h)		#: create stripchart
+   if type(win) ~== "window" then
+      return stripchart((\&window | runerr(140)), win, x, y, w)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   EraseArea(win, x, y, w, h)
+   return StripChart_Rec(win, x, y, w, h, x, 0, list(y + h, -1))
+end
+
+
+## sadvance(sc, n) - advance stripchart n pixels (default 1)
+
+procedure sadvance(sc, n)			#: advance stripchart
+
+   /n := 1
+   every 1 to n do {
+      if sc.x < (sc.x0 + sc.w - 1) then
+         sc.x +:= 1
+      else
+         CopyArea(sc.win, sc.x0 + 1, sc.y, sc.w - 1, sc.h, sc.x0, sc.y)
+      EraseArea(sc.win, sc.x, sc.y, 1, sc.h)
+      sc.n +:= 1
+      }
+   return
+end
+
+
+## smark (sc, y1, y2) - mark stripchart from y1 to y2.
+
+procedure smark(sc, y1, y2)			#: mark stripchart
+   y1 := integer(y1)
+   if sc.last[y1] <:= sc.n then
+      DrawLine(sc.win, sc.x, y1, sc.x, \y2) | DrawPoint(sc.win, sc.x, y1)
+   return
+end
+
+
+
+#  ## test program.
+#  #
+#  #  usage:  stripchart [n]
+#  #
+#  link graphics
+#  procedure main(args)
+#     local win, sc, n, y, d
+#     Window("size=500,200", args)
+#     n := integer(args[1]) | 700
+#     sc := stripchart()
+#     y := 80
+#     d := 40
+#     every 1 to n do {
+#        smark(sc, y +:= 2 * (?0 - ?0))
+#        smark(sc, y + (d +:= 2 * (?0 - ?0)))
+#        sadvance(sc)
+#        }
+#     WDone()
+#     end
diff --git a/ipl/gprocs/subturtl.icn b/ipl/gprocs/subturtl.icn
new file mode 100644
index 0000000..6464eb1
--- /dev/null
+++ b/ipl/gprocs/subturtl.icn
@@ -0,0 +1,275 @@
+############################################################################
+#
+#	File:     subturtl.icn
+#
+#	Subject:  Procedures for turtle-graphics (subset version)
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     January 30, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures implement a simplified subset of the turtle.icn
+#  package.  The main omissions are scaling, TWindow(), THome(), and
+#  high-level primitives like TCircle().  Some procedures accept fewer
+#  arguments, omit defaults, or omit the return value.
+#
+############################################################################
+#
+#  The procedures are as follows:
+#
+#  TDraw(n) -- move forward and draw
+#  TSkip(n) -- skip forward without drawing
+#	The turtle moves forward n units.  n can be negative to move
+#	backwards.
+#
+#  TDrawto(x, y) -- draw to the point (x,y)
+#	The turtle turns and draws a line to the point (x,y).
+#	The heading is also set as a consequence of this movement.
+#
+#  TGoto(x, y) -- set location
+#	The turtle moves to the point (x,y) without drawing.
+#	The turtle's heading remains unaltered.
+#
+#  TRight(d) -- turn right
+#  TLeft(d) -- turn left
+#	The turtle turns d degrees to the right or left of its current
+#	heading.  Its location does not change, and nothing is drawn.
+#
+#  TFace(x, y) -- set heading
+#	The turtle turns to face directly to face the point (x,y).
+#	If the turtle is already at (x,y), the heading does not change.
+#
+#  TX() -- query current x position
+#  TY() -- query current y position
+#	The x- or y-coordinate of the turtle's current location is
+#	returned.
+#
+#  THeading() -- query heading
+#	The turtle's heading (in degrees) is returned.
+#
+#  TSave() -- save turtle state
+#  TRestore() -- restore turtle state
+#	TSave saves the current turtle window, location, and heading
+#	on an internal stack.  TRestore pops the stack and sets
+#	those values, or fails if the stack is empty.
+#
+#  TReset() -- clear screen and reinitialize
+#	The window is cleared, the turtle moves to the center of the
+#	screen without drawing, the heading is set to -90 degrees, and
+#	the TRestore() stack is	cleared.  These actions restore the
+#	initial conditions.
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  See also:  turtle.icn
+#
+############################################################################
+
+link graphics
+
+global T_x, T_y			# current location
+global T_deg			# current heading
+global T_stack			# turtle state stack
+
+
+#  TInit() -- initialize turtle system, opening window if needed
+
+procedure TInit()			#: initialize turtle system
+
+   initial {
+      if /&window then
+         WOpen("width=500", "height=500") | stop("can't open window")
+      T_stack := []
+      T_x := WAttrib("width") / 2 + 0.5
+      T_y := WAttrib("height") / 2 + 0.5
+      T_deg := -90.0
+   }
+
+   return
+
+end
+
+
+#  TReset() -- clear screen and stack, go to center, head -90 degrees
+
+procedure TReset()			#: reset turtle system
+   initial TInit()
+
+   EraseArea()
+   T_stack := []
+   T_x := WAttrib("width") / 2 + 0.5
+   T_y := WAttrib("height") / 2 + 0.5
+   T_deg := -90.0
+
+   return
+
+end
+
+
+#  TDraw(n) -- move forward n units while drawing a line
+
+procedure TDraw(n)			#: draw with turtle
+   local rad, x, y
+   initial TInit()
+
+   rad := dtor(T_deg)
+   x := T_x + n * cos(rad)
+   y := T_y + n * sin(rad)
+   DrawLine(T_x, T_y, x, y)
+   T_x := x
+   T_y := y
+
+   return
+
+end
+
+
+#  TDrawto(x, y) -- draw line to (x,y)
+
+procedure TDrawto(x, y)			#: draw to with turtle
+   initial TInit()
+
+   TFace(x, y)
+   DrawLine(T_x, T_y, x, y)
+   T_x := x
+   T_y := y
+
+   return
+
+end
+
+
+#  TSkip(n) -- move forward n units without drawing
+
+procedure TSkip(n)			#: skip with turtle
+   local rad
+   initial TInit()
+
+   rad := dtor(T_deg)
+   T_x +:= n * cos(rad)
+   T_y +:= n * sin(rad)
+
+   return
+
+end
+
+
+#  TGoto(x, y) -- move to (x,y) without drawing
+
+procedure TGoto(x, y)			#: goto with turtle
+   initial TInit()
+   T_x := x
+   T_y := y
+
+   return
+
+end
+
+
+#  TRight(d) -- turn right d degrees
+
+procedure TRight(d)			#: turn turtle right
+   initial TInit()
+
+   T_deg +:= d
+   T_deg %:= 360		# normalize
+
+   return
+
+end
+
+
+#  TLeft(d) -- turn left d degrees
+
+procedure TLeft(d)			#: turn turtle left
+   initial TInit()
+
+   T_deg -:= d
+   T_deg %:= 360		# normalize
+
+   return
+
+end
+
+
+#  TFace(x, y) -- turn to face (x,y), unless already there
+
+procedure TFace(x, y)			#: turn turtle to face point
+   initial TInit()
+
+   if x ~= T_x | y ~= T_y then
+      T_deg := rtod(atan(y - T_y, x - T_x))
+
+   return
+
+end
+
+
+#  TX() -- return current x location
+
+procedure TX(x)				#: turtle x coordinate
+   initial TInit()
+
+   return T_x
+
+end
+
+
+#  TY() -- return current y location
+
+procedure TY(y)				#: turtle y coordinate
+   initial TInit()
+
+   return T_y
+
+end
+
+
+#  THeading() -- return current heading
+
+procedure THeading()			#: turtle heading
+   initial TInit()
+
+   return T_deg
+
+end
+
+
+#  TSave() -- save turtle state
+
+procedure TSave()			#: save turtle state
+   initial TInit()
+
+   push(T_stack, T_deg, T_y, T_x)
+
+   return
+
+end
+
+
+#  TRestore() -- restore turtle state
+
+procedure TRestore()			#: restore turtle state
+   initial TInit()
+
+   T_x := pop(T_stack)
+   T_y := pop(T_stack)
+   T_deg := pop(T_stack)
+
+   return
+
+end
diff --git a/ipl/gprocs/symrand.icn b/ipl/gprocs/symrand.icn
new file mode 100644
index 0000000..c3fb3a3
--- /dev/null
+++ b/ipl/gprocs/symrand.icn
@@ -0,0 +1,48 @@
+############################################################################
+#
+#	File:     symrand.icn
+#
+#	Subject:  Procedures to generate random points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  rand(x, y, extentx, extenty, n) generates random points in a rectangle.
+#
+#  symrand(x, y, extentx, extenty, size, n) generates points symmetrically.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+#  Generate n random points within a rectangular area.
+
+procedure rand(x, y, extentx, extenty, n)
+
+   every 1 to n do 
+      suspend Point(x + ?extentx + 1, y + ?extenty + 1)
+
+end
+
+procedure symrand(x, y, extentx, extenty, size, n)
+   local xp, yp
+
+   every 1 to n do {
+      xp := x + ?extentx + 1
+      yp := y + ?extenty + 1
+      suspend Point(xp | size - xp, yp | size - yp) |
+         Point(yp | size - yp, xp | size - xp)
+      }
+
+end
diff --git a/ipl/gprocs/tieedit.icn b/ipl/gprocs/tieedit.icn
new file mode 100644
index 0000000..a5fa744
--- /dev/null
+++ b/ipl/gprocs/tieedit.icn
@@ -0,0 +1,876 @@
+############################################################################
+#
+#	File:     tieedit.icn
+#
+#	Subject:  Procedures to create and edit binary arrays
+#
+#	Authors:  Ralph E. Griswold and Gregg M. Townsend
+#
+#	Date:     January 19, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This package 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: interact, patxform, vdialog, vsetup, dialog, wopen
+#
+############################################################################
+
+link interact
+link patxform
+link vdialog
+link vsetup
+link dialog
+link wopen
+
+global cellsize
+global flip_horiz				# icon for horizontal flip
+global flip_left				# icon for left flip
+global flip_right				# icon for right flip
+global flip_vert				# icon for vertical flip
+global grid_height
+global grid_pane
+global grid_root
+global grid_rows
+global grid_state
+global grid_window
+global grid_width
+global grid_vidgets
+global hbits					# number of bits horizontally
+global hi_horiz					# highlighted icon for h-flip
+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_rot_180				# highlighted icon for 180 rot
+global hi_rot_90				# highlighted icon for 90-rot
+global hi_rot_m90				# highlighted icon for -90 rot
+global hi_vert					# highlighted icon for v-flip
+global ident					# icon for identity
+global maxsize					# maximum grid dimensions
+global mode					# pattern/tile display mode
+global old_pat					# old pattern for undo
+global rotate_180				# icon for 180-degree rotation
+global rotate_90				# icon for 90-degree rotation
+global rotate_m90				# icon for -90-degree rotation
+global subservient				# application status
+global sym_image_current			# current drawing images
+global sym_image_next				# next drawing images
+global sym_state				# drawing state
+global symmet_xpos
+global symmet_yoff
+global symmetries				# general symmetry state
+global tile_touched				# tile modification switch
+global vbits					# number of bits veritcally
+global xform_xpos
+global xform_ypos
+
+$define MaxCell   	 24			# maximum size of grid cell
+$define IconSize	 16			# size of button icons
+$define MaxPatt		 32
+$define InfoLength	 40			# length of lines in info box
+
+record pattrec(tile)
+
+procedure copy_tile()
+   local output
+
+   output := open("/tmp/tieclip", "w") | {
+      Notice("Cannot copy tile.")
+      fail
+      }
+
+   write(output, rows2pat(grid_rows))
+
+   close(output)
+
+   return
+
+end
+
+#  draw editing grid
+
+procedure grid()
+   local x, y
+
+   EraseArea(grid_pane)
+   every x := 0 to hbits * cellsize by cellsize do
+      DrawLine(grid_pane, x, 0, x, vbits * cellsize)
+   every y := 0 to vbits * cellsize by cellsize do
+      DrawLine(grid_pane, 0, y, hbits * cellsize, y)
+
+   return
+
+end
+
+#  editing grid
+
+procedure grid_cb(vidget, e)
+   local x, y, i, j
+   static xpos, ypos
+
+   initial {
+      xpos := grid_vidgets["grid"].ax
+      ypos := grid_vidgets["grid"].ay
+      }
+
+   if e === (&lpress | &rpress | &ldrag | &rdrag) then {
+      j := (&x - xpos) / cellsize
+      i := (&y - ypos) / 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
+
+#  file menu
+
+procedure grid_file_cb(vidget, menu)
+
+   return case menu[1] of {
+      "read  @R"  :  read_tile()
+      "open  @O"  :  open_gif()
+      "ims   @M"  :  open_ims()
+      "write @W"  :  write_tile()
+      "copy  @C"  :  copy_tile()
+      "paste @P"  :  paste_tile()
+      "quit  @Q"  :  return_tile()
+      "save  @S"  :  save_image()
+      }
+
+   return
+
+end
+
+procedure grid_init()
+   local e, i, j, x, y, v, h, input, window_save, atts
+   local shift_up, shift_left, shift_right, shift_down, pixmap
+   local clear, invert, scramble, trim, enlarge, resize, crop
+
+   symmetries := 0				# initially no symmetries
+
+   sym_state := [				# initially no symmetries
+      [1, -1, -1, -1],
+      [-1, -1, -1, -1]
+      ]
+
+   tile_touched := &null
+
+#  Set up vidgets
+
+   window_save := &window		# save current subject window
+   &window := &null			# clear for new subject
+   atts := grid_ui_atts()
+   put(atts, "canvas=hidden")
+   (WOpen ! atts) | stop("*** can't open drawdown editor window")
+   grid_vidgets := grid_ui()
+   grid_window := &window
+   &window := window_save 		# restore previous subject window
+
+   grid_root := grid_vidgets["root"]
+
+   xform_xpos := grid_vidgets["xform"].ux
+   xform_ypos := grid_vidgets["xform"].uy
+   grid_width := grid_vidgets["grid"].uw
+   grid_height := grid_vidgets["grid"].uh
+   maxsize := grid_width / 3
+
+   grid_pane := Clone(grid_window, "bg=white", "dx=" || grid_vidgets["grid"].ax,
+      "dy=" || grid_vidgets["grid"].ay)
+
+   Clip(grid_pane, 0, 0, grid_width, grid_height)
+
+   symmet_xpos := grid_vidgets["symregion"].ux
+   symmet_yoff := grid_vidgets["symregion"].uy
+
+   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"
+
+   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]
+      ]
+
+#  now place the images
+
+   place(xform_xpos, xform_ypos, 1, 0, shift_up)
+   place(xform_xpos, xform_ypos, 0, 1, shift_left)
+   place(xform_xpos, xform_ypos, 2, 1, shift_right)
+   place(xform_xpos, xform_ypos, 1, 2, shift_down)
+   place(xform_xpos, xform_ypos, 0, 4, flip_right)
+   place(xform_xpos, xform_ypos, 0, 5, flip_left)
+   place(xform_xpos, xform_ypos, 1, 4, flip_vert)
+   place(xform_xpos, xform_ypos, 1, 5, flip_horiz)
+   place(xform_xpos, xform_ypos, 0, 7, rotate_90)
+   place(xform_xpos, xform_ypos, 0, 8, rotate_m90)
+   place(xform_xpos, xform_ypos, 1, 7, rotate_180)
+   place(xform_xpos, xform_ypos, 0, 10, clear)
+   place(xform_xpos, xform_ypos, 1, 10, invert)
+   place(xform_xpos, xform_ypos, 2, 10, scramble)
+   place(xform_xpos, xform_ypos, 0, 12, trim)
+   place(xform_xpos, xform_ypos, 1, 12, enlarge)
+   place(xform_xpos, xform_ypos, 2, 12, resize)
+   place(xform_xpos, xform_ypos, 0, 14, crop)
+
+   place(symmet_xpos, symmet_yoff, 0, 0, hi_ident)
+   place(symmet_xpos, symmet_yoff, 1, 0, rotate_90)
+   place(symmet_xpos, symmet_yoff, 2, 0, rotate_m90)
+   place(symmet_xpos, symmet_yoff, 3, 0, rotate_180)
+   place(symmet_xpos, symmet_yoff, 0, 1, flip_right)
+   place(symmet_xpos, symmet_yoff, 1, 1, flip_left)
+   place(symmet_xpos, symmet_yoff, 2, 1, flip_vert)
+   place(symmet_xpos, symmet_yoff, 3, 1, flip_horiz)
+
+   VSetState(grid_vidgets["symstate"], "none ")
+
+   return
+
+end
+
+#  keyboard shortcuts
+
+procedure grid_shortcuts(e)
+
+   if (e === "\r") & \subservient then return_tile()	# subservient role
+
+   if &meta then case map(e) of {
+      "0"  :  read_rows()
+      "1"  :  write_rows()
+      "c"  :  copy_tile()
+      "i"  :  tile_info()
+      "m"  :  open_ims()
+      "n"  :  new_tile()
+      "o"  :  open_gif()
+      "p"  :  paste_tile()
+      "q"  :  return_tile()
+      "r"  :  read_tile()
+      "s"  :  save_image()
+      "z"  :  undo_xform()
+      "w"  :  write_tile()
+      }
+
+   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
+
+procedure new_tile()
+
+   case Dialog("New:", ["height", "width"], [*grid_rows, *grid_rows[1]], 3,
+      ["Okay", "Cancel"]) of {
+         "Cancel"  :  fail
+         "Okay"    :   {
+            icheck(dialog_value) | fail
+            grid_rows := list(dialog_value[1], repl("0", dialog_value[2]))
+            tile_touched := 1
+            return setup()
+            }
+      }
+
+   return
+
+end
+
+procedure open_gif()
+   local win, ims
+
+   repeat {
+      if OpenDialog("Open image:") == "Cancel" then fail
+      win := WOpen("canvas=hidden", "image=" || dialog_value) | {
+         Notice("Cannot open image.")
+         next
+         }
+      ims := Capture(win, "g2")
+      WClose(win)
+      setup_ims(ims)
+      return
+      }
+
+end
+
+procedure open_ims()
+   local ims, input
+
+   repeat {
+      if OpenDialog("Open ims:") == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open ims file.")
+         next
+         }
+      ims := read(input)
+      close(input)
+      setup_ims(ims)
+      return
+      }
+
+end
+
+procedure setup_ims(ims)
+   local width
+
+   grid_rows := []
+
+   ims ? {
+      width := tab(upto(','))
+      while tab(upto(',') + 1)
+#     while put(grid_rows, map(move(width), "01", "10"))
+      while put(grid_rows, move(width))
+      }
+
+   setup()
+
+   return
+
+end
+
+procedure paste_tile()
+   local input, tile
+
+   input := open("/tmp/tieclip") | {
+         Notice("Cannot paste tie-up file.")
+         fail
+         }
+
+   tile := read_pattern(input) | {
+      Notice("Cannot process matrix.")
+      close(input)
+      fail
+      }
+
+   close(input)
+
+   grid_rows := pat2rows(tile.tile)
+
+   return setup()
+
+end
+
+#  place icon
+
+procedure place(xoff, yoff, col, row, pattern)
+
+   DrawImage(grid_window, xoff + col * IconSize, 
+     yoff + row * IconSize, pattern)
+
+   return
+
+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 pattern to tile list
+
+procedure read_tile()
+   local input, tile
+   static file, line
+
+   initial line := "1"
+
+   repeat {
+      if TextDialog("Read tile:", ["file", "line"], [file, line], [60, 4]) ==
+         "Cancel" then fail
+      input := open(dialog_value[1]) | {
+         Notice("Cannot open file.")
+         next
+         }
+      file := dialog_value[1]
+      line := (0 < integer(dialog_value[2]))
+      every 1 to line - 1 do
+         read(input) | {
+            Notice("Not that many lines in file.")
+            close(input)
+            next
+            }
+      tile := read_pattern(input) | {
+         Notice("Cannot process matrix.")
+         close(input)
+         next
+         }
+      close(input)
+      grid_rows := pat2rows(tile.tile)
+      return setup()
+      }
+
+end
+
+#  read and add rows to tile list
+
+procedure read_rows()
+   local input
+   static file
+
+   repeat {
+      if OpenDialog("Read rows:") == "Cancel" then fail
+      input := open(dialog_value) | {
+         Notice("Cannot open file.")
+         next
+         }
+      file := dialog_value
+      grid_rows := []
+      while put(grid_rows, read(input))
+      close(input)
+      return setup()
+      }
+
+end
+
+procedure return_tile()
+
+   grid_state := "Done"
+
+   return
+
+end
+
+procedure save_image()
+
+   snapshot(grid_pane)
+
+   return
+
+end
+
+#  set bits of tile
+
+procedure setbit(i, j, c)
+   local x, y, xu, yu, xv, yv, xt, yt, action
+   static xpos, ypos
+
+   initial {
+      xpos := grid_vidgets["grid"].ax
+      ypos := grid_vidgets["grid"].ay
+      }
+
+   if (symmetries = 0) & (grid_rows[i + 1, j + 1] == c) then return	# optimization
+
+   x := j * cellsize + 1		# the selected cell itself
+   y := i * cellsize + 1
+   xt := i * cellsize + 1
+   yt := j * cellsize + 1
+
+   i +:= 1				# computational convenience
+   j +:= 1
+
+   xu := (hbits - j) * cellsize + 1	# opposite cells
+   yu := (vbits - i) * cellsize + 1
+   xv := (hbits - i) * cellsize + 1
+   yv := (vbits - j) * cellsize + 1
+
+   action := if c = 1 then FillRectangle else EraseArea
+
+   if sym_state[1, 1] = 1 then {		# cell itself
+      grid_rows[i, j] := c
+      action(grid_pane, x, y, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 2] = 1 then {		# 90 degrees
+      if grid_rows[j, -i] := c then			# may be out of bounds
+         action(grid_pane, xv, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 3] = 1 then {		# -90 degrees
+      if grid_rows[-j, i] := c then			# may be out of bounds
+         action(grid_pane, xt, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[1, 4] = 1 then {		# 180 degrees
+      grid_rows[-i, -j] := c
+      action(grid_pane, xu, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 1] = 1 then {		# left diagonal
+      if grid_rows[j, i] := c then			# may be out of bounds
+      action(grid_pane, xt, yt, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 2] = 1 then {		# right diagonal
+      if grid_rows[-j, -i] := c then			# may be out of bounds
+      action(grid_pane, xv, yv, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 3] = 1 then {		# vertical
+      grid_rows[-i, j] := c
+      action(grid_pane, x, yu, cellsize - 1, cellsize - 1)
+      }
+   if sym_state[2, 4] = 1 then {		# horizontal
+      grid_rows[i, -j] := c
+      action(grid_pane, xu, y, cellsize - 1, cellsize - 1)
+      }
+
+   return
+
+end
+
+#  set up editing grid and view area
+
+procedure setup()
+   local i, j
+
+   hbits := *grid_rows[1]
+   vbits := *grid_rows
+
+   if (hbits | vbits) > maxsize 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 >:= grid_width / (vbits + 4)
+   cellsize >:= grid_height / (hbits + 4)
+
+   grid()
+
+   every i := 1 to hbits do
+      every j := 1 to vbits do
+         if grid_rows[j, i] == "1" then
+            FillRectangle(grid_pane, (i - 1) * cellsize,
+               (j - 1) * cellsize, cellsize, cellsize)
+
+   return
+
+end
+
+procedure symstate_cb(vidget, value)
+   local row, col
+
+   #  Note:  the blanks at the end of these radio-button labels are
+   #  for interface formatting.
+
+   sym_state := case value of {
+      "none "  :  [[1, -1, -1, -1], [-1, -1, -1, -1]]
+      "all  "   :  [[1, 1, 1, 1], [1, 1, 1, 1]]
+      }
+
+   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]
+      ]
+
+   if value == "all  " then sym_image_next :=: sym_image_current
+
+   every col := 1 to 4 do
+      every row := 1 to 2 do
+         place(symmet_xpos, symmet_yoff, col - 1, row - 1,
+            sym_image_current[row, col])
+   return
+
+end
+
+#  symmetry buttons
+
+procedure symmet_cb(vidget, e)
+   local col, row, symcount
+
+   if e === (&lpress | &rpress | &mpress) then {
+      col := (&x - symmet_xpos) / IconSize + 1
+      row := (&y - symmet_yoff) / IconSize + 1
+      sym_state[row, col] *:= -1
+      sym_image_current[row, col] :=: sym_image_next[row, col]
+      place(symmet_xpos, symmet_yoff, 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 {
+      "new  @N"  :  new_tile()
+      "info @I"  :  tile_info()
+      }
+
+   return
+
+end
+
+#  show information about tile
+
+procedure tile_info()
+   local line1, line2, pattern, bits, density
+
+   pattern := rows2pat(grid_rows)
+   bits := tilebits(grid_rows)
+   density := left(bits / real(*grid_rows[1] * *grid_rows), 6)
+
+   line1 := left(*grid_rows[1] || "x" || *grid_rows || " b=" || bits || " d=" ||
+      density, InfoLength)
+   line2 := if *pattern > InfoLength then pattern[1+:(InfoLength - 3)] ||
+      "..." else left(pattern, InfoLength)
+
+   Notice(line1, line2)
+
+   return
+
+end
+
+#  undo transformation
+
+procedure undo_xform()
+
+   grid_rows := pat2rows(old_pat)
+
+   return setup()
+
+end
+
+#  write pattern
+
+procedure write_tile()
+   local output
+
+   repeat {
+      if SaveDialog("Write pattern") == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open file for writing.")
+         next
+         }
+      write(output, rows2pat(grid_rows))
+      close(output)
+      return
+      }
+
+end
+
+#  write rows
+
+procedure write_rows()
+   local output
+
+   repeat {
+      if SaveDialog("Write rows") == "Cancel" then fail
+      output := open(dialog_value, "w") | {
+         Notice("Cannot open file for writing.")
+         next
+         }
+      every write(output, !grid_rows)
+      close(output)
+      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(grid_rows, -1, "h")
+         4:   pflip(grid_rows, "r")
+         5:   pflip(grid_rows, "l")
+         7:   protate(grid_rows, 90)
+         8:   protate(grid_rows, -90)
+         10:  list(vbits, repl("0", hbits))
+         12:  ptrim(grid_rows)
+         14:  {
+           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, grid_rows)
+                     pcrop ! result
+                     }
+                 }
+            }
+         default:   fail
+         }
+      1: case row of {
+         0:   pshift(grid_rows, -1, "v")
+         2:   pshift(grid_rows, 1, "v")
+         4:   pflip(grid_rows, "v")
+         5:   pflip(grid_rows, "h")
+         7:   protate(grid_rows, 180)
+         10:  pinvert(grid_rows)
+         12:  {
+               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, grid_rows)
+                        pborder ! result
+                        }
+                    }
+                 }
+         default:   fail
+         }
+      2: case row of {
+         1:   pshift(grid_rows, 1, "h")
+         10:  pscramble(grid_rows, "b")
+         12:  {
+            case Dialog("Center:", ["width", "height"], [*grid_rows[1], *grid_rows], 
+               3, ["Okay", "Cancel"]) of {
+               "Cancel":  fail
+               "Okay": {
+                  icheck(dialog_value) | fail
+                  result := copy(params := dialog_value)
+                  push(result, grid_rows)
+                  pcenter ! result
+                    }
+                 }
+              }
+         default:   fail
+         }
+      default:   fail
+      }
+
+end
+
+#  transformation buttons
+
+procedure xform_cb(vidget, e)
+   local col, row
+
+   if e === (&lpress | &rpress | &mpress) then {
+      old_pat := rows2pat(grid_rows)
+      col := (&x - xform_xpos) / IconSize
+      row := (&y - xform_ypos) / IconSize
+      grid_rows := xform(col, row) | fail
+      return setup()
+      }
+
+end
+
+#===<<vib:begin>>===	modify using vib; do not remove this marker line
+procedure grid_ui_atts()
+   return ["size=635,568", "bg=pale gray", "label=Drawdown Editor"]
+end
+
+procedure grid_ui(win, cbk)
+return vsetup(win, cbk,
+   ["grid_ui:Sizer:::0,0,635,568:Drawdown Editor",],
+   ["file:Menu:pull::0,0,36,21:File",grid_file_cb,
+      ["read  @R","open  @O","ims   @M","write @W","copy  @C",
+      "paste @P","quit  @Q ","save  @S"]],
+   ["line1:Line:::0,22,660,22:",],
+   ["symmetries:Label:::22,316,70,13:symmetries",],
+   ["symstate:Choice::2:26,384,64,42:",symstate_cb,
+      ["all  ","none "]],
+   ["tile:Menu:pull::38,0,64,21:Drawdown",tile_cb,
+      ["new  @N","info @I"]],
+   ["transformations:Label:::5,33,105,13:transformations",],
+   ["symregion:Rect:grooved::24,338,68,36:",symmet_cb],
+   ["info:Rect:invisible::123,32,251,19:",],
+   ["xform:Rect:grooved::32,58,52,244:",xform_cb],
+   ["grid:Rect:sunken::123,58,500,500:",grid_cb],
+   )
+end
+#===<<vib:end>>===	end of section maintained by vib
diff --git a/ipl/gprocs/tieutils.icn b/ipl/gprocs/tieutils.icn
new file mode 100644
index 0000000..042e102
--- /dev/null
+++ b/ipl/gprocs/tieutils.icn
@@ -0,0 +1,424 @@
+############################################################################
+#
+#	File:     tieutils.icn
+#
+#	Subject:  Procedures related to weaving tie-ups
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 15, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#	imr2tie(imr)	converts g2 image record to tie-ip
+#
+#	pat2tie(pat)	converts bi-level pattern to tie-up string
+#
+#	pat2tier(pat)	converts bi-level pattern to tie-up record
+#
+#	showpat(pat, size, fg, bg)
+#			produces a hidden window for the pattern as a matrix
+#			with the specified foreground and background colors
+#
+#	str2matrix(shafts, treadles, s)
+#			produce matrix from binary string
+#
+#	testtie(s)	succeeds if s is a valid tie-up but fails otherwise
+#
+#	tie2imr(s)	converts tie-up to g2 image record
+#
+#	tie2pat(i, j, tie)
+#			converts tie-up to bi-level pattern
+#
+#	tie2coltier(s)	creates a black/white color tieup-record for
+#			  tie-up s
+#
+#	tie2tier(s)	creates a 0/1 tie-up record for tie-up s
+#
+#	tier2rstring(r)	creates a tie-up string from a tie-up record
+#
+#	twill(pattern, shift, shafts)
+#			twill tie-up
+#
+#	overunder(pattern, treadles)
+#			over/under tie-up structure
+#
+#	direct(shafts, treadles)
+#			direct tie-up
+#
+#	satin(counter, shafts, treadles)
+#			satin tie-up
+#
+#	tabby(shafts, treadles)
+#			tabby tie-up
+#
+#	general(pattern, shift, rep, shafts)
+#			general tie-up
+#
+#	exptie(expression, shafts, treadles)
+#			expression tie-up
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  cells, numbers,  wopen, patutils, imrutils, patxform
+#
+############################################################################
+
+link cells
+link numbers
+link wopen
+link patutils
+link patxform
+link imrutils
+
+record tie(shafts, treadles, matrix)
+
+procedure imr2tie(imr)			#: convert image record to tie-up
+
+   return imr.width || ";" || *imr.pixels / imr.width || ";" || imr.pixels
+
+end
+
+procedure pat2tie(pat)			#: convert pattern to tie-up string
+   local matrix, tieup, shafts, treadles
+
+   pat ? {		# OLD-STYLE BIT STRING TIE-UP
+      if shafts := tab(upto(',')) &
+      move(1) &
+      treadles := tab(upto(',')) &
+      move(1) then {
+         matrix := list(shafts)
+         while put(matrix, move(treadles))
+         }
+      else matrix := pat2rows(pat)
+      }
+
+   tieup := tie(*matrix[1], *matrix, matrix)
+
+   return tier2string(tieup)
+
+end
+
+procedure pat2tier(pat)			#: convert pattern to tie-up record
+   local matrix
+
+   matrix := pat2rows(pat)
+
+   return tie(*matrix[1], *matrix, matrix)
+
+end
+
+#  Set up empty palette grid
+
+procedure showpat(pat, cellsize, fg, bg)	#: image of bi-level pattern
+   local x, y, panel, row, rows, color, tieup
+
+   /cellsize := 10
+
+   rows := pat2rows(pat)
+
+   panel := makepanel(*rows[1], *rows, cellsize, fg, bg)
+
+   y := 1
+
+   every row := !rows do {
+      every x := 1 to *row do {
+         color := if row[x] == "1" then "black" else "white"
+         colorcell(panel, x, y, color)
+         }
+      y +:= 1
+      }
+
+   return panel
+ 
+end
+
+procedure str2matrix(shafts, treadles, tieup)
+   local matrix
+
+   matrix := []
+
+   tieup ? {
+      every 1 to treadles do 
+         put(matrix, move(shafts))
+      }
+
+   return matrix
+
+end
+
+procedure testtie(s)			#: test validity of tie-up s
+   local n, m, bits
+
+   s ? {
+      n := (0 < integer(tab(upto(';')))) &
+      move(1) &
+      m := (0 < integer(tab(upto(';')))) &
+      move(1) &
+      bits := tab(0)
+      } | fail					# bad header
+
+   if *(cset(bits) -- '01') > 0 then fail	# illegal characters
+
+   if *bits ~= (n * m) then fail		# wrong length
+
+   return s
+
+end
+
+procedure tie2imr(tie)			#: convert tie-up to image record
+   local width
+
+   tie ? {
+      width := tab(upto(';'))
+      move(1)
+      tab(upto(';') + 1)
+      return imstoimr(width || ",g2," || tab(0))
+      }
+
+end
+
+procedure tie2pat(shafts, treadles, tie)	#: convert tie-up record to ims
+   local tieup, matrix
+
+   tieup := tie2tier(shafts, treadles, tie)
+   matrix := tieup.matrix
+   return rows2pat(matrix)
+
+end 
+
+procedure tie2tier(shafts, treadles, tieup)	#: create 0/1 tie-up record
+   local matrix
+
+   matrix := []
+
+   tieup ? {
+      every 1 to treadles do 
+         put(matrix, move(shafts))
+      }
+
+   return tie(shafts, treadles, matrix)
+
+end
+
+procedure tie2coltier(tieup)		#: create color tie-up record
+   local result, shafts, treadles, rec
+
+   result := []
+
+   if not upto(';', tieup) then		# old-style tie-up
+      tieup := "8;8;" || tieup
+
+   tieup ? {
+      (
+         shafts := tab(upto(';')) &
+         move(1) &
+         treadles := tab(upto(';')) &
+         move(1)
+         ) | stop("*** invalid tieup")
+      every 1 to shafts do 
+         put(result, tcolors(move(treadles)))
+      }
+
+   return tie(shafts, treadles, result)
+
+end
+
+procedure tcolors(s)
+   local i, result
+
+   result := []
+
+   every i := 1 to *s do
+      put(result, if s[i] == "0" then "black" else "white")
+
+   return result
+
+end
+
+procedure tier2string(rec)	#: convert tie-up record to string
+   local result
+
+   result := ""
+
+   every result ||:= !rec.matrix
+
+   return result
+
+end
+
+procedure twill(pattern, shift, shafts, treadles)	#: twill tie-up
+   local row, rows
+
+   /treadles := shafts
+
+   row := overunder(pattern, treadles) | fail
+
+   rows := []
+
+   put(rows, row)
+
+   every 1 to shafts - 1 do
+      put(rows, row := rotate(row, shift))
+
+   return rows
+
+end
+
+procedure overunder(pattern, treadles)
+   local row, count, i
+
+   row := ""
+
+   count := 1			# odd/even over/under toggle
+
+   pattern ? {
+      while ="/" do {		#  INITIAL / NEEDS TO BE REMOVED
+         i := tab(many(&digits)) | fail
+         row ||:= repl(count, i)
+         count +:= 1
+         count %:= 2
+         }
+      if not pos(0) then fail
+      }
+      
+   return extend(row, treadles)
+
+end
+
+#  direct() supports a "generalized" tie-up when the number of shafts
+#  is not the same as the number of treadles.
+
+procedure direct(shafts, treadles)	#: direct tie-up
+   local row, i, rows, swap
+
+   /treadles := shafts			# normal direct tie-up
+
+   if shafts ~= treadles then {
+      shafts :=: treadles
+      swap := 1
+      }
+
+   rows := []
+
+   row := "1" || repl("0", treadles - 1)
+
+   put(rows, row)
+
+   every i := 1 to shafts - 1 do
+      put(rows, row := rotate(row, -1))
+
+   if /swap then return rows
+   else return pflip(protate(rows, -90), "v")
+
+end
+
+procedure satin(counter, shafts, treadles)	#: satin tie-up
+   local row, rows, m, k
+
+   rows := list(shafts, repl("0", treadles))
+
+   m := 1
+   rows[1, 1]  := "1"
+
+   every k := 2 to shafts do
+      rows[k, residue(m +:= counter, shafts, 1)] := "1"
+
+   return rows
+
+end
+
+procedure tabby(shafts, treadles)	#: tabby tie-up
+   local rows, row, i
+
+   rows := []
+
+   row := repl("01", (treadles + 1) / 2)
+
+   push(rows, row)
+
+   every i := 1 to shafts - 1 do
+      push(rows, row := rotate(row, 1))
+
+   return rows
+
+   return
+
+end
+
+procedure general(pattern, shift, rep, shafts)	#: general tie-up
+   local row, rows, i
+
+   row := overunder(pattern, shafts) | fail
+
+   rows := []
+
+   every 1 to rep do
+      put(rows, row)
+
+   every i := (1 to shafts - 1) \ (shafts / rep) do {
+      row := rotate(row, shift)
+      every 1 to rep do
+         put(rows, row)
+      }
+
+   rows := rows[1+:shafts]		# trim
+
+   return rows
+
+end
+
+procedure exptie(expression, shafts, treadles)	#: expression tie-up
+   local output, size, row, rows, values, input
+
+   size := shafts * treadles
+
+   output := open("/tmp/expr.icn", "w") | {
+      stop("*** cannot open file for tie-up expression")
+      fail
+      }
+
+   write(output, "$include \"/tmp/include.wvp\"")
+   write(output, "link seqfncs")
+   write(output, "procedure main()")
+   write(output, "   every write(", expression, " %  2) \\ ", size)
+   write(output, "end")
+
+   close(output)
+
+#  remove("/tmp/seqdraft.err")
+
+   if system("icont -s /tmp/expr >/dev/null 2>/tmp/seqdraft.err") ~= 0 then
+      fail
+
+   input := open("expr", "p")
+
+   values := ""
+   every values ||:= !input
+
+   close(input)
+
+   remove("expr")
+
+   rows := []
+
+   if *values < (shafts * treadles) then {
+      stop("*** short tie-up sequence")
+      fail
+      }
+
+   values ? {
+      while put(rows, move(shafts))
+      }
+
+   return rows
+
+end
diff --git a/ipl/gprocs/tile.icn b/ipl/gprocs/tile.icn
new file mode 100644
index 0000000..f66d314
--- /dev/null
+++ b/ipl/gprocs/tile.icn
@@ -0,0 +1,64 @@
+############################################################################
+#
+#	File:     tile.icn
+#
+#	Subject:  Procedure to tile window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     September 29, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure tiles a portion of win1 over the specified portion
+#  of win2, doubling to reduce the number of copies required.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure tile(win1, win2, x1, y1, w1, h1)	#: tile area with image
+   local w, h, wmax, hmax
+
+   /win1 := &window
+   /win2 := &window
+   /x1 := 0
+   /y1 := 0
+   /w1 := WAttrib(win1, "width")
+   /h1 := WAttrib(win1, "height")
+   wmax := WAttrib(win2, "width")
+   hmax := WAttrib(win2, "height")
+
+   if (w1 | h1) = 0 then fail
+
+   if w1 < 0 then {
+      w1 := -w1
+      x1 -:= w1
+      }
+
+   if h1 < 0 then {
+      h1 := -h1
+      y1 -:= h1
+      }
+
+   CopyArea(win1, win2, x1, y1, w1, h1)		# initial copy 
+
+   while w1 < wmax do {				# copy and double
+      CopyArea(win2, win2, 0, 0, w1, h1, w1, 0)
+      w1 *:= 2
+      }
+
+   while h1 < hmax do {				# copy and double
+      CopyArea(win2, win2, 0, 0, w1, h1, 0, h1)
+      h1 *:= 2
+      }
+
+   return
+
+end
diff --git a/ipl/gprocs/tiler.icn b/ipl/gprocs/tiler.icn
new file mode 100644
index 0000000..dae1997
--- /dev/null
+++ b/ipl/gprocs/tiler.icn
@@ -0,0 +1,74 @@
+############################################################################
+#
+#	File:     tiler.icn
+#
+#	Subject:  Procedures to tile window with image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     December 18, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  tileimg(win, image) tiles win with copies of image.
+#
+#  tileims(win, ims) tiles win with copies of the image specified by ims
+#
+#  Note that tileimg() uses the gamma value of win.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  imutils, tile
+#
+############################################################################
+
+link imutils
+link tile
+
+procedure tileimg(win, img)		#: tile image
+   local hidden
+
+   hidden := WOpen("canvas=hidden", "image=" || img, "gamma=" ||
+      WAttrib(win, "gamma")) | {
+      write(&errout, "*** cannot open image ", img)
+      fail
+      }
+
+   tile(hidden, win)
+
+   WClose(hidden)
+
+   return
+
+end
+
+procedure tileims(win, ims)		#: tile image string
+   local w, h
+
+   w := imswidth(ims)
+   h := imsheight(ims)
+
+   if ims ? {
+      tab(many(&digits)) & =",#"
+      } then {
+         WAttrib(win, "pattern=" || ims)
+         WAttrib(win, "fillstyle=textured")
+         FillRectangle(win)
+         }
+   
+   else {
+      DrawImage(win, 0, 0, ims) | fail
+      tile(win, win, 0, 0, w, h)
+      }
+
+   return
+
+end
diff --git a/ipl/gprocs/turtle.icn b/ipl/gprocs/turtle.icn
new file mode 100644
index 0000000..d81c5f7
--- /dev/null
+++ b/ipl/gprocs/turtle.icn
@@ -0,0 +1,446 @@
+############################################################################
+#
+#	File:     turtle.icn
+#
+#	Subject:  Procedures for turtle-graphics interface
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     August 8, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide a "turtle graphics" interface to Icon.
+#	With this approach, popularized by the Logo programming language,
+#	all drawing is done by a "turtle" that carries a pen over a drawing
+#	surface under program control.
+#
+#	TWindow(W)	sets the turtle window.
+#
+#	TDraw(n)	moves forward and draws.
+#
+#	TSkip(n)	skips forward without drawing.
+#
+#	TDrawto(x, y)	draws to the point (x,y).
+#
+#	TScale(n)	sets or queries current scaling factor.
+#
+#	TRight(d)	turns right d degrees.
+#
+#	TLeft(d)	turns left d degrees.
+#
+#	THeading(a)	sets or queries the heading.
+#
+#	TFace(x, y)	sets or queries the heading.
+#
+#	TX(x)		sets or queries the current x position.
+#
+#	TY(y)		sets or queries the current y position.
+#
+#	TGoto(x, y, a)	sets the location and optionally changes the heading.
+#
+#	THome()		moves to the window center and turns to face upward.
+#
+#	TReset()	clears the window and reinitializes.
+#
+#	TSave()		saves the turtle state.
+#
+#	TRestore()	restores the turtle state.
+#
+#	TRect(h, w)	draws a rectangle centered at the turtle.
+#
+#	TCircle(d)	draws a circle centered at the turtle.
+#
+#	TPoly(d, n)	draws a polygon centered at the turtle.
+#
+#	TFRect(h, w)	draws a filled rectangle centered at the turtle.
+#
+#	TFCircle(d)	draws a filled circle centered at the turtle.
+#
+#	TFPoly(d, n)	draws a filled polygon centered at the turtle.
+#
+############################################################################
+#
+#  In this package there is a single turtle which is itself invisible;
+#  it is known only by the marks it leaves on the window.  It remembers
+#  its location and heading between calls.
+#
+#  No explicit initialization is required.  The turtle begins at the
+#  center of the window with a heading of -90 degrees (that is, pointed
+#  towards the top of the window).
+#
+#  The turtle draws on &window unless a different window is specified by
+#  calling TWindow().  If no window is provided and &window is null,
+#  a 500x500 window is opened and assigned to &window.
+#
+#  Distances are measured in pixels and are always multiplied by a
+#  settable scaling factor, initially 1.  Angles are measured in degrees;
+#  absolute angles measure clockwise from the positive X axis.
+#
+############################################################################
+#
+#  The procedures are as follows:
+#
+#  TDraw(n) -- move forward and draw
+#  TSkip(n) -- skip forward without drawing
+#	The turtle moves forward n units.  n can be negative to move
+#	backwards.
+#	Default:  n = 1
+#
+#  TDrawto(x, y) -- draw to the point (x,y)
+#	The turtle turns and draws a line to the point (x,y).
+#	The heading is also set as a consequence of this movement.
+#	Default:  center of window
+#
+#  TScale(n) -- set or query current scaling factor.
+#	If n is supplied, the scaling factor applied to TDraw and TSkip
+#	arguments is *multiplied* (not replaced) by n.  The resulting
+#	(multiplied or unaltered) scaling factor is returned.
+#	The turtle's heading and location do not change.
+#
+#  TRight(d) -- turn right
+#  TLeft(d) -- turn left
+#	The turtle turns d degrees to the right or left of its current
+#	heading.  Its location does not change, and nothing is drawn.
+#	The resulting heading is returned.
+#	Default:  d = 90
+#
+#  THeading(a) -- set or query heading
+#	The turtle's heading (in degrees) is returned.  If a is supplied,
+#	the heading is first set to that value.  The location does not
+#	change.
+#
+#  TFace(x, y) -- set or query heading
+#	The turtle turns to face directly towards the point (x,y).
+#	If x and y are missing or the turtle is already at (x,y),
+#	the heading does not change.  The new heading is returned.
+#	Default: center of window
+#
+#  TX(x) -- set or query current x position
+#  TY(y) -- set or query current y position
+#	The unscaled x- or y-coordinate of the turtle's current location
+#	is returned.  If an argument is supplied, the coordinate value
+#	is first set, moving the turtle without drawing.  The turtle's
+#	heading does not change.
+#
+#  TGoto(x, y, a) -- set location and optionally change heading
+#	The turtle moves to the point (x,y) without drawing.
+#	The turtle's heading remains unaltered unless <a> is supplied,
+#	in which case the turtle then turns to a heading of <a>.
+#	Default:  center of window
+#
+#  THome() -- move to home (center of window) and point North
+#	The turtle moves to the center of the window without drawing
+#	and the heading is set to -90 degrees.  The scaling factor
+#	remains unaltered.
+#
+#  TReset() -- clear window and reinitialize
+#	The window is cleared, the turtle moves to the center of the
+#	window without drawing, the heading is set to -90 degrees, the
+#	scaling factor is reset to 1, and the TRestore() stack is
+#	cleared.  These actions restore the initial conditions.
+#
+#  TSave() -- save turtle state
+#  TRestore() -- restore turtle state
+#	TSave saves the current turtle window, location, heading, and
+#	scale on an internal stack.  TRestore pops the stack and sets
+#	those values, or fails if the stack is empty.
+#
+#  TRect(h, w) -- draw a rectangle centered at the turtle
+#  TCircle(d) -- draw a circle centered at the turtle
+#  TPoly(d, n) -- draw an n-sided regular polygon centered at the turtle
+#	These three procedures draw a figure centered at the turtle's
+#	current location.  The location and heading do not change.
+#	The base of the figure, if any, is directly behind the turtle.
+#
+#	TRect(h, w) draws a rectangle of height h and width w.
+#	"width" is the dimension perpendicular to the turtle's path.
+#	Default:  h = 1
+#		  w = h
+#
+#	TCircle(d) draws a circle of diameter d.
+#	Default:  d = 1
+#
+#	TPoly(d, n) draws an n-sided regular polygon whose circumscribed
+#	circle would have a diameter of d.
+#	Default:  d = 1
+#		  n = 3
+#
+#  TFRect(h, w) -- draw a filled rectangle centered at the turtle
+#  TFCircle(d) -- draw a filled circle centered at the turtle
+#  TFPoly(d, n) -- draw an n-sided filled polygon centered at the turtle
+#	These are like their counterparts above, but a solid figure is
+#	drawn instead of just an outline.
+#
+#  TWindow(win) -- set turtle window
+#	The turtle is moved to the given window, retaining its
+#	coordinates and heading.
+#	Default:   win = &window
+#
+#  These procedures do not attempt to provide a complete graphics interface;
+#  in particular, no control of color is provided.  Missing functions can
+#  be accomplished by calling the appropriate Icon routines.
+#
+#  Unlike most turtle graphics environments, there are no commands to
+#  lift and drop the pen.  Instead, use TSkip() to move without drawing,
+#  or set WAttrib("drawop=noop") if you really need a global "pen up"
+#  state.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+global T_x, T_y			# current location
+global T_deg			# current heading
+global T_scale			# current scaling
+global T_stack			# turtle state stack
+global T_win			# current window
+
+#  TWindow(win) -- set turtle window
+
+procedure TWindow(win)		#: set turtle window
+   /win := &window
+   if type(win) ~== "window" then
+      runerr(140, win)
+   T_win := win
+   return
+end
+
+#  TInit() -- initialize turtle system, opening window if needed
+
+procedure TInit()		#: initialize turtle system
+   TInit := 1			# suppress any subsequent calls
+   if /T_win then {
+      /&window := open("turtle", "g", "width=500", "height=500") |
+         stop("can't open window")
+      T_win := &window
+      }
+   T_stack := []
+   T_scale := 1.0
+   TGoto(, , -90.0)
+   return
+end
+
+#  TReset() -- clear window and stack, reset scaling, go to center, head -90
+
+procedure TReset()		#: reset turtle system
+   initial TInit()
+   T_stack := []
+   EraseArea(T_win, -WAttrib(T_win, "dx"), -WAttrib(T_win, "dy"))
+   T_scale := 1.0
+   return TGoto(, , -90.0)
+end
+
+#  THome() -- go to center and set heading to 90 degrees
+
+procedure THome()		#: return turtle to home
+   initial TInit()
+   return TGoto(, , -90.0)
+end
+
+#  TScale(n) -- set / return scaling
+
+procedure TScale(n)		#: turtle scaling
+   initial TInit()
+   if T_scale *:= (0.0 ~= \n) then
+      THeading(T_deg)
+   return T_scale
+end
+
+#  THeading(d), TLeft(d), TRight(d), TFace(x, y) -- set / return heading
+
+procedure THeading(d)		#: turtle heading
+   initial TInit()
+
+   T_deg := \d % 360		# set normalized heading
+   return T_deg
+end
+
+procedure TRight(d)		#: turn turtle right
+   initial TInit()
+   return THeading(T_deg + (\d | 90.0))
+end
+
+procedure TLeft(d)		#: turn turtle left
+   initial TInit()
+   return THeading(T_deg - (\d | 90.0))
+end
+
+procedure TFace(x, y)		#: face turtle
+   initial TInit()
+   /x := WAttrib(T_win, "width") / 2 + 0.5
+   /y := WAttrib(T_win, "height") / 2 + 0.5
+   if not (x = \T_x & y = \T_y) then
+      return THeading(rtod(atan(y - T_y, x - T_x)))
+   else
+      return THeading()
+end
+
+#  TX(x), TY(y) -- set or return current x / y location (unscaled).
+
+procedure TX(x)			#: turtle x coordinate
+   initial TInit()
+   return (T_x := \x) | T_x
+end
+
+procedure TY(y)			#: turtle y coordinate
+   initial TInit()
+   return (T_y := \y) | T_y
+end
+
+#  TDraw(n) -- move forward n units while drawing a line
+
+procedure TDraw(n)		#: draw with turtle
+   local rad
+   initial TInit()
+
+   /n := 1.0
+   rad := dtor(T_deg)
+   DrawLine(T_win, .T_x, .T_y,
+      T_x +:= T_scale * cos(rad) * n, T_y +:= T_scale * sin(rad) * n)
+   return
+end
+
+#  TSkip(n) -- move forward n units without drawing
+
+procedure TSkip(n)		#: skip with turtle
+   local rad
+   initial TInit()
+
+   /n := 1.0
+   rad := dtor(T_deg)
+   T_x +:= T_scale * cos(rad) * n
+   T_y +:= T_scale * sin(rad) * n
+   return
+end
+
+#  TGoto(x, y, a) -- move to (x,y) without drawing, and set heading if given
+
+procedure TGoto(x, y, a)	#: go to with turtle
+   initial TInit()
+   T_x := \x | WAttrib(T_win, "width") / 2 + 0.5
+   T_y := \y | WAttrib(T_win, "height") / 2 + 0.5
+   THeading(\a)
+   return
+end
+
+#  TDrawto(x, y, a) -- draw line to (x,y), and set heading if given
+
+procedure TDrawto(x, y, a)	#: draw to with turtle
+   initial TInit()
+   /x := WAttrib(T_win, "width") / 2 + 0.5
+   /y := WAttrib(T_win, "height") / 2 + 0.5
+   if /a then
+      TFace(x, y)
+   DrawLine(T_win, .T_x, .T_y, T_x := x, T_y := y)
+   THeading(\a)
+   return
+end
+
+#  TSave() -- save turtle state
+
+procedure TSave()		#: save turtle state
+   initial TInit()
+   push(T_stack, T_deg, T_y, T_x, T_scale, T_win)
+   return
+end
+
+#  TRestore() -- restore turtle state
+
+procedure TRestore()		#: restore turtle state
+   initial TInit()
+   T_win := pop(T_stack)
+   T_scale := pop(T_stack)
+   return TGoto(pop(T_stack), pop(T_stack), pop(T_stack))
+end
+
+
+############################################################################
+#
+#  Higher level routines.
+#  These do not depend on the internals of procs above.
+#
+############################################################################
+
+#  TRect(h, w) -- draw a rectangle centered at the turtle
+#  TFRect(h, w) -- draw a filled rectangle centered at the turtle
+
+procedure TRect(h, w)		#: draw rectangle centered at turtle
+   return T_rectangle(h, w, DrawLine)
+end
+
+procedure TFRect(h, w)		#: draw filled rectangle centered at turtle
+   return T_rectangle(h, w, FillPolygon)
+end
+
+procedure T_rectangle(h, w, xcall)
+   local l
+
+   /h := 1.0
+   /w := h
+   l := [T_win]
+   TSkip(h / 2.0);  TRight()
+   TSkip(w / 2.0);  put(l, TX(), TY());  TRight()
+   TSkip(h);        put(l, TX(), TY());  TRight()
+   TSkip(w);        put(l, TX(), TY());  TRight()
+   TSkip(h);        put(l, TX(), TY());  TRight()
+   TSkip(w / 2.0);  put(l, TX(), TY());  TLeft()
+   TSkip(-h / 2.0)
+   put(l, l[2], l[3])
+   xcall ! l
+   return
+end
+
+#  TCircle(d) -- draw a circle centered at the turtle
+#  TFCircle(d) -- draw a filled circle centered at the turtle
+
+procedure TCircle(d)		#: draw circle centered at turtle
+   local r
+   d := TScale() * (abs(\d) | 1.0)
+   r := d / 2.0
+   DrawArc(T_win, TX() - r, TY() - r, d, d)
+   return
+end
+
+procedure TFCircle(d)		#: draw filled circle centered at turtle
+   local r
+   d := TScale() * (abs(\d) | 1.0)
+   r := d / 2.0
+   FillArc(T_win, TX() - r, TY() - r, d, d)
+   return
+end
+
+#  TPoly(d, n) -- draw an n-sided regular polygon centered at the turtle
+#  TFPoly(d, n) -- draw an n-sided filled polygon centered at the turtle
+
+procedure TPoly(d, n)		#: draw polygon centered at turtle
+   return T_polygon(d, n, DrawLine)
+end
+
+procedure TFPoly(d, n)		#: draw filled polygon centered at turtle
+   return T_polygon(d, n, FillPolygon)
+end
+
+procedure T_polygon(d, n, xcall)
+   local r, a, da, cx, cy, x, y, l
+   r := TScale() * ((\d / 3.0) | 1.0)
+   n := abs(integer(\n + 0.5)) | 3.0
+   n <:= 2.0
+   da := dtor(360.0 / n)
+   a := dtor(THeading() + 180.0) + da / 2.0
+   x := (cx := TX()) + r * cos(a)
+   y := (cy := TY()) + r * sin(a)
+   l := [T_win, x, y]
+   every 1 to n do {
+      put(l, x := cx + r * cos(a+:=da))
+      put(l, y := cy + r * sin(a))
+      }
+   xcall ! l
+   return
+end
diff --git a/ipl/gprocs/twists.icn b/ipl/gprocs/twists.icn
new file mode 100644
index 0000000..bb1a4f4
--- /dev/null
+++ b/ipl/gprocs/twists.icn
@@ -0,0 +1,83 @@
+############################################################################
+#
+#	File:     twists.icn
+#
+#	Subject:  Procedures to produce traces of "twists"
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures produce traces of twisting orbits.  See
+#
+#	Geometric and Artistic Graphics; Design Generation with
+#	Microcomputers, Jean-Paul Delahaye, Macmillan, 1987, pp. 73-80.
+#
+#  The arguments specify the starting positions, the extent of the
+#  drawing, the number of segments, and various parameters that determine
+#  the orbits.
+#
+############################################################################
+#
+#  Links:  gobject
+#
+############################################################################
+
+link gobject
+
+procedure twist1(x, y, extent, n, t1, t2, j1, j2, k1, k2, rscale1, rscale2,
+sfact, sscale, soff, yfact)
+   local radius1, radius2, angle, s, s1, s2, c1, c2, i
+   local jangle1, jangle2, kangle1, kangle2, sangle
+   
+   radius1 := rscale1 * extent				# scaling
+   radius2 := rscale2 * extent
+
+   jangle1 := 2 * &pi / n * j1 * t1
+   jangle2 := 2 * &pi / n * j2 * t1
+   kangle1 := 2 * &pi / n * k1 * t2
+   kangle2 := 2 * &pi / n * k2 * t2
+   sangle := sfact * &pi / n
+
+   every i := 0 to n do {
+      s := sscale * cos(sangle * i) + soff
+      c1 := cos(jangle1 * i)
+      s1 := sin(jangle2 * i)
+      c2 := s * cos(kangle1 * i)
+      s2 := s * sin(kangle2 * i)
+      suspend Point(x + radius1 * c1 + radius2 * (c1 * c2 - s1 * s2),
+         y + yfact * (radius1 * s1 + radius2 * (s1 * c2 + c1 * s2)))
+      }
+
+end
+
+procedure twist2(x, y, extent, n, t1, t2, j1, j2, k1, k2, rscale1, rscale2,
+sfact, yfact)
+   local radius1, radius2, angle, s1, s2, c1, c2, i
+   local jangle1, jangle2, kangle1, kangle2, sangle
+
+   radius1 := rscale1 * extent				# scaling
+   radius2 := rscale2 * extent
+
+   jangle1 := 2 * &pi / n * j1 * t1
+   jangle2 := 2 * &pi / n * j2 * t1
+   kangle1 := 2 * &pi / n * k1 * t2
+   kangle2 := 2 * &pi / n * k2 * t2
+   sangle := sfact * &pi / n
+
+   every i := 0 to n do {
+      c1 := cos(jangle1 * i)
+      s1 := sin(jangle2 * i)
+      c2 := cos(kangle1 * i)
+      s2 := sin(kangle2 * i)
+      suspend Point(x + radius1 * c1 + radius2 * (c1 * c2 - s1 * s2),
+         y + yfact * (radius1 * s1 + radius2 * (s1 * c2 + c1 * s2)))
+      }
+
+end
diff --git a/ipl/gprocs/vbuttons.icn b/ipl/gprocs/vbuttons.icn
new file mode 100644
index 0000000..f6c2dd7
--- /dev/null
+++ b/ipl/gprocs/vbuttons.icn
@@ -0,0 +1,418 @@
+############################################################################
+#
+#	File:     vbuttons.icn
+#
+#	Subject:  Procedures for buttons
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vbutton
+#	Vtoggle
+#	Vcheckbox  (obsolete)
+#	Vmessage
+#	Vline
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links: vstyle
+#
+############################################################################
+
+link vstyle
+
+############################################################################
+# Vbutton
+############################################################################
+record Vbutton_rec (win, s, callback, id, style, aw, ah, data,
+   ax, ay, uid, P, D, V)
+
+procedure Vbutton(params[])
+   local self, frame, x, y, ins
+   static procs, type
+
+   initial {
+      procs := Vstd(event_Vbutton, draw_Vbutton, outline_Vidget,
+         resize_Vbutton, inrange_Vpane, init_Vbutton, couplerset_Vbutton)
+      type := proc("type", 0)	# protect attractive names
+      }
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vbutton_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vbutton()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid label passed to Vbutton()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vbutton()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vbutton()")
+
+   self.uid := Vget_uid()
+   Vset_style(self, self.style)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vbutton(self)
+   self.D.draw_off(self)
+end
+
+procedure couplerset_Vbutton(self)
+   self.V.draw(self)
+end
+
+#
+#  Dragging mouse over edge toggles mouse "on" or "off".
+#
+procedure event_Vbutton(self, e)
+   local out
+
+   if \self.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      self.D.draw_on(self)
+      repeat {
+	 e := Event(self.win)
+	 if self.V.inrange(self, &x, &y) then {
+	    if e === (&lrelease|&mrelease|&rrelease) then {
+	       self.D.draw_off(self)
+	       self.callback.V.set(self.callback, self)
+	       return self.id
+               }
+	    else if \out then {
+	       self.D.draw_on(self)
+	       out := &null
+               }
+            }
+	 else
+	    if e === (&ldrag|&mdrag|&rdrag) & /out then {
+	       self.D.draw_off(self)
+	       out := 1
+               }
+	    else if e === (&lrelease|&mrelease|&rrelease) then {
+	       self.D.draw_off(self)
+	       break
+               }
+         }
+      return
+      }
+end
+
+procedure init_Vbutton (self)
+   local p
+
+   p := \self.callback
+   self.callback := Vbool_coupler()
+   add_clients_Vinit(self.callback, p, self)
+   self.D.init(self)
+end
+
+procedure resize_Vbutton(s, x, y, w, h)
+   
+   resize_Vidget(s, x, y, w, h)
+   Vset_style(s, s.style)
+   s.D.init(s)
+end
+
+
+############################################################################
+# Vtoggle
+############################################################################
+
+procedure Vtoggle(params[])
+   local frame, x, y, ins, self
+   static procs, type
+
+   initial {
+      procs := Vstd(event_Vtoggle, draw_Vtoggle, outline_Vidget,
+         resize_Vidget, inrange_Vpane, init_Vbutton,
+         couplerset_Vbutton,,,,, set_value_Vtoggle)
+      type := proc("type", 0)
+      }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vbutton_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vtoggle()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid label passed to Vtoggle()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vtoggle()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vtoggle()")
+
+
+   self.uid := Vget_uid()
+   Vset_style(self, self.style)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vtoggle(self)
+   if \self.callback.value then
+      self.D.draw_on(self)
+   else
+      self.D.draw_off(self)
+end
+
+
+#
+#  Basically same functionality as for Vbutton with the exception
+#  of maintaining the state of the toggle between events.
+#
+procedure event_Vtoggle(self, e)
+   local out, new, original
+
+   if \self.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      if /self.callback.value then {
+         new := self.D.draw_on
+         original := self.D.draw_off
+      }
+      else {
+         new := self.D.draw_off
+         original := self.D.draw_on
+      }
+      new(self)
+      repeat {
+         e := Event(self.win)
+         if self.V.inrange(self, &x, &y) then {
+            if e === (&lrelease|&mrelease|&rrelease) then {
+               self.callback.V.toggle(self.callback, self)
+               self.data := self.callback.value
+               return self.id
+            }
+            else if \out then {
+               new(self)
+               out := &null
+            }
+         }
+         else
+            if e === (&ldrag|&mdrag|&rdrag) & /out then {
+               original(self)
+               out := 1
+            }
+            else if e === (&lrelease|&mrelease|&rrelease) then {
+               original(self)
+               break
+            }
+      }
+      return
+   }
+end
+
+procedure set_value_Vtoggle(self, value)
+
+   if \value then
+      self.callback.V.set(self.callback)
+   else
+      self.callback.V.unset(self.callback)
+
+   self.data := self.callback.value
+   draw_Vtoggle(self)
+   return
+end
+
+############################################################################
+# Vcheckbox
+############################################################################
+record Vcheckbox_rec (win, callback, id, size, aw, ah, data,
+   ax, ay, cw, uid, P, V, D)
+
+procedure Vcheckbox(params[])
+   local frame, x, y, ins, self, p
+   static procs
+
+   initial {
+      procs := Vstd(event_Vtoggle, draw_Vtoggle, outline_Vidget,
+                   resize_Vidget, inrange_Vpane,  ,
+                   couplerset_Vbutton,,,,, set_value_Vtoggle)
+   }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vcheckbox_rec ! params[1:5|0]
+   if ( \self.size, not numeric(self.size) ) then
+      _Vbomb("invalid size parameter to Vcheck_box()")
+   Vwin_check(self.win, "Vcheck_box()")
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.D := Vstd_draw(draw_off_Vcheckbox, draw_on_Vcheckbox)
+
+## Init
+#  PMIcon fix.
+#   self.cw := Clone(self.win, "linewidth=2")
+   self.cw := WAttrib(self.win, "linewidth")
+   /self.size := 15
+   self.aw := self.ah := self.size
+
+   p := \self.callback
+   self.callback := Vbool_coupler()
+   add_clients_Vinit(self.callback, p, self)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_on_Vcheckbox(self)
+   local x, y, sz
+
+   x := self.ax
+   y := self.ay
+   sz := self.size
+#  PMIcon fix.
+   WAttrib(self.win, "linewidth=2")
+   DrawSegment(self.win, x+1, y+1, x+sz-1, y+sz-1, x+1, y+sz-1, x+sz-1, y+1)
+#  PMIcon fix.
+   WAttrib(self.win, "linewidth="||self.cw)
+   self.V.outline(self)
+end
+
+procedure draw_off_Vcheckbox(self)
+   local x, y, sz
+
+   x := self.ax
+   y := self.ay
+   sz := self.size
+#  PMIcon fix.
+   WAttrib(self.win, "reverse=on", "linewidth=2")
+   DrawSegment(self.win, x+1, y+1, x+sz-1, y+sz-1, x+1, y+sz-1, x+sz-1, y+1)
+#  PMIcon fix.
+   WAttrib(self.win, "reverse=off", "linewidth="||self.cw)
+   self.V.outline(self)
+end
+
+############################################################################
+# Vmessage
+############################################################################
+
+procedure Vmessage(params[])
+   static procs, type
+   local frame, x, y, ins, self
+
+   initial {
+      procs := Vstd(null_proc, draw_Vmessage, outline_Vidget,
+         resize_Vidget, null_proc, init_Vmessage, null_proc)
+      type := proc("type", 0)	# protect attractive names
+      }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vbutton_rec ! params[1:3|0]
+   Vwin_check(self.win, "Vmessage()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid label passed to Vmessage()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.D := Vstd_draw()
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vmessage(self)
+
+   GotoXY(self.win, self.ax+self.D.basex, self.ay+self.D.basey)
+   writes(self.win, self.s)
+#   self.V.outline(self)
+end
+
+procedure init_Vmessage(self)
+   local TW, FH, ascent, descent
+
+   /self.s := ""
+   /self.aw := (TW := TextWidth(self.win, self.s))
+   ascent := WAttrib(self.win, "ascent")
+   descent := WAttrib(self.win, "descent")
+   /self.ah := FH := ascent + descent
+
+   self.D.basex := (self.aw - TW) / 2
+   self.D.basey := (self.ah - FH) / 2 + ascent
+end
+
+############################################################################
+# Vline
+#
+#  I know, I know, this vidgie is not well designed or efficient.
+############################################################################
+record Vline_rec (win, ax1, ay1, ax2, ay2, aw, ah, id, uid, P, V)
+
+procedure Vline(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(null_proc, draw_Vline, null_proc,
+                        resize_Vline, null_proc, null_proc,
+                        null_proc)
+   self := Vline_rec ! params[1:6|0]
+   Vwin_check(self.win, "Vline()")
+   if not numeric(self.ax1) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   if not numeric(self.ax2) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   if not numeric(self.ay1) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   if not numeric(self.ay2) then
+      _Vbomb("invalid coordinate parameter to Vline()")
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+
+   return self
+end
+
+procedure resize_Vline(frame, self)
+   local x, y, w, h, x1, y1, x2, y2
+
+   x := frame.ax
+   y := frame.ay
+   w := frame.aw
+   h := frame.ah
+   x1 := self.ax1
+   y1 := self.ay1
+   x2 := self.ax2
+   y2 := self.ay2
+
+   self.ax1 := x + ( (/x1, 0) | (x1 <= -1 , w+x1) |
+      (-1 < x1 < 0, w + x1*w) | (0 < x1 < 1, w*x1) | x1 )
+   self.ay1 := y + ( (/y1, 0) | (y1 <= -1 , h+y1) |
+      (-1 < y1 < 0, h + y1*h) | (0 < y1 < 1, h*y1) | y1 )
+   self.ax2 := x + ( (/x2, w) | (x2 <= -1 , w+x2) |
+      (-1 < x2 < 0, w + x2*w) | (0 < x2 < 1, w*x2) | x2 )
+   self.ay2 := y + ( (/y2, h) | (y2 <= -1 , h+y2) |
+      (-1 < y2 < 0, h + y2*h) | (0 < y2 < 1, h*y2) | y2 )
+end
+
+procedure draw_Vline(self)
+   DrawGroove(self.win, self.ax1, self.ay1, self.ax2, self.ay2)
+end
+
+procedure erase_Vline(self)
+   DrawGroove(self.win, self.ax1, self.ay1, self.ax2, self.ay2, 0)
+end
diff --git a/ipl/gprocs/vcoupler.icn b/ipl/gprocs/vcoupler.icn
new file mode 100644
index 0000000..c9172e9
--- /dev/null
+++ b/ipl/gprocs/vcoupler.icn
@@ -0,0 +1,327 @@
+############################################################################
+#
+#	File:     vcoupler.icn
+#
+#	Subject:  Procedures for coupler variables
+#
+#	Author:   Jon Lipp
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vcoupler
+#	Vrange_coupler
+#	Vstrset_coupler
+#	Vbool_coupler
+#	Vtable_coupler
+#	Vmenu_coupler
+#
+#  Utility procedures in this file:
+#
+#	add_clients_Vinit()
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+record Vcoupler_rec(value, callers, clients, id, curr_id, old_id, 
+                    allowed, locked, uid, V)
+
+############################################################################
+# Vcoupler
+############################################################################
+
+procedure Vcoupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vcoupler, add_client_Vcoupler,
+			init_Vcoupler, null_proc, null_proc,
+                        null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+
+procedure call_clients_Vcoupler(s, caller, val)
+   local i, c
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   every i := 1 to *s.clients do {
+      c := s.clients[i]
+      if type(c) == "procedure" then c(s.callers[i], val)
+      else if type(c) ? find("coupler") then c.V.set(c, caller, val)
+      else if type(c) == !Vrecset then {
+         # don't call yourself
+         if (type(\caller) == type(c) & \caller["uid"] === c["uid"]) then
+            next
+         c.V.couplerset(c, caller, val)
+         }
+      }
+end
+
+procedure set_Vcoupler(s, caller, val, call_clients)
+   if \s.locked then fail
+   s.value := val
+   if /call_clients then
+      call_clients_Vcoupler(s, caller, val)
+   return val
+end
+
+#
+#  Client is the client of course; caller is the vidget record to be passed
+#  to this client if type(client) == "procedure".
+#
+procedure add_client_Vcoupler(s, client, caller)
+local pl
+static image
+
+   initial image := proc("image", 0)		# protect attractive name
+
+   image(client) ? { if ="function" then
+      _Vbomb("Icon function" || tab(0) || "() not allowed as callback")
+   }
+   put (s.clients, client)
+   put (s.callers, caller)
+end
+
+procedure init_Vcoupler(s)
+  /s.clients := []
+  /s.callers := []
+  s.id := V_COUPLER
+end
+
+############################################################################
+# Vrange_coupler
+# Range couplers are Vcouplers whose values are limited to a
+# particular range of legal values.  Presently they must be numeric.
+# The default increment is 0.1.
+############################################################################
+record Vrange_coupler_rec(min, max, value, inc, callers, clients, real, id, 
+   locked, uid, V)
+
+procedure Vrange_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vrange_coupler,
+			add_client_Vcoupler,
+			init_Vrange_coupler, null_proc,
+                        null_proc, null_proc)
+
+   self := Vrange_coupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+#
+#  If the value passed is out of range, change caller
+procedure set_Vrange_coupler(s, caller, val, call_clients)
+   local theMax
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if \s.locked then fail
+   theMax := numeric(s.max) | (type(s.max) == !Vcoupler_recset, s.max.value) |
+     _Vbomb("illegal value in Vrange_coupler set")
+   val := (s.min > val, s.min) | (theMax < val, theMax)
+   s.value := val
+   if /s.real then val := integer(val)
+   if /call_clients then
+      call_clients_Vcoupler(s, caller, val)
+   return val
+end
+
+procedure init_Vrange_coupler(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /s.min := 0; /s.max := 1.0
+   if \s.value < s.min | \s.value > s.max then s.value := s.min
+
+   /s.value := \ s.min
+   s.real := (type(s.min|s.max) == "real", 1)
+  
+   /s.inc := 0.1*(s.max-s.min) 
+   if /s.real then s.inc := integer(s.inc)
+   init_Vcoupler(s)
+end
+
+############################################################################
+# strset_coupler
+############################################################################
+
+procedure Vstrset_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vstrset_coupler, 
+			add_client_Vcoupler,
+			init_Vstrset_coupler, null_proc,
+                        null_proc, null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+procedure set_Vstrset_coupler(s, id, val)
+   if \s.locked then fail
+   if !s.allowed === val then 
+      return set_Vcoupler(s, id, val)
+end
+
+procedure init_Vstrset_coupler(s)
+  /s.allowed := []
+  init_Vcoupler(s)
+end
+
+############################################################################
+# Vbool_coupler
+############################################################################
+
+procedure Vbool_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vbool_coupler, 
+			add_client_Vcoupler,
+			init_Vcoupler, unset_Vbool_coupler,
+			toggle_Vbool_coupler, eval_Vbool_coupler)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+procedure eval_Vbool_coupler(s)
+   return \s.value
+end
+
+procedure set_Vbool_coupler(s, caller)
+   if \s.locked then fail
+   s.value := 1
+   call_clients_Vcoupler(s, caller, 1)
+   return s.value
+end
+
+procedure unset_Vbool_coupler(s, caller)
+   s.value := &null
+   call_clients_Vcoupler(s, caller, &null)
+   return s.value
+end
+
+procedure toggle_Vbool_coupler(s, caller)
+   local newstate
+
+   newstate := (/s.value, 1)
+   return set_Vcoupler(s, caller, newstate)
+end
+
+############################################################################
+# Vtable_coupler
+############################################################################
+
+procedure Vtable_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vtable_coupler, 
+			add_client_Vcoupler,
+			init_Vtable_coupler, null_proc,
+                        null_proc, null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+procedure set_Vtable_coupler(s, id, key, val)
+   s.value[key] := val
+   call_clients_Vcoupler(s, id, val)
+end
+
+procedure init_Vtable_coupler(s) 
+  s.value := table()
+  init_Vcoupler(s)
+end
+
+############################################################################
+# Vmenu_coupler
+############################################################################
+
+procedure Vmenu_coupler(params[])
+   local self
+   static procs
+
+   initial procs := Vstd_coupler(set_Vmenu_coupler, 
+			null_proc,
+			null_proc, null_proc,
+                        null_proc, null_proc)
+
+   self := Vcoupler_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.V.init(self)
+   return self
+end
+
+
+procedure set_Vmenu_coupler(s, id, val)
+   if \s.locked then fail
+   s.old_id := s.curr_id
+   s.curr_id := id
+   s.value := val
+   (\s.old_id).V.couplerset(s.old_id, , val)
+   return val
+end
+ 
+
+############################################################################
+# Utilities 
+############################################################################
+
+#
+#  Takes the callback parameter passed in upon creation of a vidget and
+#  adds them to the client list of the coupler variable, checking if it
+#  is a list or not.
+#
+procedure add_clients_Vinit(cv, callbacks, vid)
+   local cb
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(\callbacks) == "list" then
+      every cb := !callbacks do cv.V.add_client(cv, \cb, vid)
+   else
+      cv.V.add_client(cv, \callbacks, vid)
+end
+
diff --git a/ipl/gprocs/vdialog.icn b/ipl/gprocs/vdialog.icn
new file mode 100644
index 0000000..e83833e
--- /dev/null
+++ b/ipl/gprocs/vdialog.icn
@@ -0,0 +1,296 @@
+############################################################################
+#
+#	File:     vdialog.icn
+#
+#	Subject:  Procedures for dialog boxes
+#
+#	Author:   Jon Lipp
+#
+#	Date:     November 5, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vdialog
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vbuttons, vtext
+#
+############################################################################
+
+link vbuttons
+link vtext
+
+record DL_pos_rec(x,y)		# dialog position record
+
+############################################################################
+#  Vdialog - allows a pop-up menu_frame to be associated with a button.
+#
+#  Open the dialogue, let the user edit fields, one entry per field.
+#  returns a list containing the values of the fields.
+#
+############################################################################
+record Vdialog_frame_rec(win, padx, pady, callback, aw, ah, lookup,
+   draw, id, ax, ay, uid, F, P,  V)
+
+procedure Vdialog(params[])
+   local self
+   static procs
+
+   initial {
+      procs := Vstd(event_Vframe, draw_Vframe, 1,
+                   resize_Vframe, inrange_Vpane, init_Vdialog,
+                   couplerset_Vpane, insert_Vdialog, remove_Vframe,
+                   lookup_Vframe, set_abs_Vframe)
+      if /V_OK then VInit()
+   }
+
+   self := Vdialog_frame_rec ! params[1:5|0]
+   Vwin_check(self.win, "Vdialog()")
+   if (\self.padx, not numeric(self.padx) ) then
+      _Vbomb("invalid padx parameter to Vdialog()")
+   if (\self.pady, not numeric(self.pady) ) then
+      _Vbomb("invalid pady parameter to Vdialog()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := Vstd_dialog(open_dialog_Vdialog, register_Vdialog,
+             format_Vdialog, unregister_Vdialog)
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure open_dialog_Vdialog(self, x, y, values, def_str)
+   local i, c, e, newfocus, tid, rv, now, val
+   local entry, r, def, sel, v, args, parent, posn
+   static xytable, type
+
+   initial {
+      xytable := table()
+      type := proc("type", 0)		# protect attractive name
+      }
+
+## Check ID and determine x and y values.
+   if \x then {
+      if WAttrib(self.win, "canvas") == ("normal" | "maximal") then  {
+	 x +:= WAttrib(self.win, "posx")
+	 y +:= WAttrib(self.win, "posy")
+	 }
+      }
+   else if \y then {
+      /xytable[y] := DL_pos_rec()
+      posn := xytable[y]
+      x := posn.x
+      y := posn.y
+      }
+
+   if WAttrib(self.win,"canvas") == ("normal" | "maximal") then  {
+      /x := WAttrib(self.win,"posx") + (WAttrib(self.win,"width")-self.aw) / 2
+      /y := WAttrib(self.win,"posy") + (WAttrib(self.win,"height")-self.ah) / 2
+      /x <:= 20
+      /y <:= 10
+      }
+
+## Sort text entry list.
+   self.F.text_entries := sort(self.F.text_entries)
+   every i := 1 to *self.F.text_entries do
+      self.F.text_lu[self.F.text_entries[i]] := i
+
+## Build arg list and open window
+   args := []
+   put(args, "size=" || self.aw || "," || self.ah)
+   put(args, "pos=" || \x || "," || \y)
+   put(args, "display=" || WAttrib(self.win, "display"))
+   put(args, "label=" || ("" ~== WAttrib(self.win, "label")))
+   put(args, "font=" || WAttrib(self.win, "font"))
+   put(args, "gamma=" || WAttrib(self.win, "gamma"))
+   if (c := Fg(self.win))[1] ~== "-" then
+      put(args, "fg=" || c)
+   if (c := Bg(self.win))[1] ~== "-" then
+      put(args, "bg=" || c)
+   parent := self.win
+   if not (self.win := WOpen ! args) then {
+      write(&errout, "can't open window for dialog")
+      writes(&errout, "window arguments:")
+      every writes(&errout, " ", !args | "\n")
+      stop()
+      }
+
+   every v := !self.draw do {
+      v.win := self.win
+      if type(v) == ("Vradio_frame_rec" | "Vscrollbar_frame_rec") then
+         every (!v.draw).win := self.win
+      }
+   self.V.resize(self, 0, 0, self.aw, self.ah)
+
+## Make a sorted list of self.F.entries
+   sel := sort(self.F.entries, 1)
+## set values of fields to value list, or default if entry is &null
+   every i := 1 to *sel do {
+      entry := sel[i][2]
+      val := values[i] | &null
+      (\entry).V.set_value(entry, val)
+      }
+   self.F.focus := &null
+   self.V.draw(self)
+
+## Find default button according to def_str.
+   if \def_str then
+      every i := !self.lookup do
+         if def_str == \i["s"] then {
+            def := i
+            break
+            }
+
+   self.F.focus := self.F.entries[self.F.text_entries[1]]
+   newfocus := \self.F.focus | \sel[1][2] | &null
+   (\self.F.focus).T.block(self.F.focus)
+
+## Call the user initialization callback, if any.
+   (\self.callback)(self)
+
+   repeat {
+      # outline the default button every time around, in case the outline was
+      # erased by a redraw call for the dialog (e.g. in ColorDialog())
+      BevelRectangle((\def).win, def.ax-5, def.ay-5, def.aw+10, def.ah+10,-2)
+
+      e := Event(self.win)
+      if e === "\r" then {
+         if \def then {
+            e := &lpress
+            &x := def.ax + 1
+            &y := def.ay + 1
+            Enqueue(def.win, &lrelease, def.ax + 1, def.ay + 1)
+         }
+         else next
+      }
+      if integer(e) < 0 then {
+         newfocus := self.V.lookup(self, &x, &y) | self.F.focus
+         if ((\newfocus).id) ~=== ((\self.F.focus).id) then
+            switch_focus_Vdialog(self, newfocus)
+      }
+      r := (\newfocus).V.event(newfocus, e, &x, &y) | &null
+      case r of {
+         V_NEXT: { 	#move to next entry
+            now := self.F.text_lu[self.F.focus.id]
+            tid := ((*self.F.text_entries >= now + 1) | 1)
+            switch_focus_Vdialog(self, self.F.entries[self.F.text_entries[tid]])
+            }
+         V_PREVIOUS: {	#move to previous entry
+            now := self.F.text_lu[self.F.focus.id]
+            tid := ((1 <= now - 1) | *self.F.text_entries)
+            switch_focus_Vdialog(self, self.F.entries[self.F.text_entries[tid]])
+            }
+         V_OK: {	# done, quit with changes
+            rv := []
+            every e := !sel do put(rv, e[2].data)
+            break
+            }
+         V_CANCEL: { 	# cancel changes, quit.
+            break
+            }
+      }
+      newfocus := self.F.focus
+   } # end repeat
+
+## close temporary window after saving its location for next time
+   (\posn).x := WAttrib(self.win, "posx")
+   (\posn).y := WAttrib(self.win, "posy")
+   WClose(self.win)
+
+## restore window fields
+   self.win := parent
+   every v := !self.draw do {
+      v.win := self.win
+      if type(v) == ("Vradio_frame_rec" | "Vscrollbar_frame_rec") then
+         every (!v.draw).win := self.win
+      }
+
+## flush pending events that may have accumulated on the parent window
+   while *Pending(self.win) > 0 do
+      Event(self.win)
+
+##  For Vtext vidgies, tell them to turn off their cursors.
+   every tid := !self.F.text_entries do
+      \(self.F.entries[tid]).T.CursorOn := &null
+
+   return \rv
+end
+
+procedure switch_focus_Vdialog(self, newfocus)
+   if (newfocus.id === !self.F.text_entries) then {
+      self.F.focus.T.unblock(self.F.focus)
+#      self.F.focus.T.erase_cursor(self.F.focus)
+      newfocus.T.block(newfocus)
+      self.F.focus := newfocus
+      }
+end
+
+procedure insert_Vdialog(self, vidget, x, y)
+   if /self | /vidget | /x | /y then
+      _Vbomb("incomplete or &null parameters to VInsert() for dialogs")
+   pad_and_send_Vdialog(self, vidget, x, y)
+end
+
+procedure register_Vdialog(self, vidget, x, y)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /self | /vidget | /x | /y then
+      _Vbomb("incomplete or &null parameters to VRegister()")
+   self.F.entries[vidget.id] := vidget
+   if type(vidget) ? find("text") then
+      put(self.F.text_entries, vidget.id)
+   pad_and_send_Vdialog(self, vidget, x, y)
+end
+
+procedure unregister_Vdialog(self, kid)
+local new, i
+
+   if (kid.id === !self.F.text_entries) then {
+      new := []
+      every i := !self.F.text_entries do if kid.id ~=== i then put(new, i)
+      self.F.text_entries := new
+      }
+   delete(self.F.entries, kid.id)
+   every i := 1 to *self.F.text_entries do
+      self.F.text_lu[self.F.text_entries[i]] := i
+   self.V.remove(self, kid, 1)
+end
+
+procedure pad_and_send_Vdialog(self, vidget, x, y)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if (x|y) < 0 | type(x|y) == "real" then
+      _Vbomb("must VRegister() or VInsert() a vidget to a dialog with absolute coordinates")
+   insert_Vframe(self, vidget, x+self.padx, y+self.pady)
+end
+
+procedure format_Vdialog(self)
+   self.V.resize(self, 0, 0,
+                 Vmin_frame_width(self)+self.padx-1,
+                 Vmin_frame_height(self)+self.pady-1)
+end
+
+procedure init_Vdialog(self)
+   init_Vframe(self)
+   /self.padx := 20
+   /self.pady := 20
+   self.F.entries := table()
+   self.F.text_entries := []
+   self.F.text_lu := table()
+end
diff --git a/ipl/gprocs/vfilter.icn b/ipl/gprocs/vfilter.icn
new file mode 100644
index 0000000..a79d1ae
--- /dev/null
+++ b/ipl/gprocs/vfilter.icn
@@ -0,0 +1,40 @@
+############################################################################
+#
+#	File:     vfilter.icn
+#
+#	Subject:  Procedure to change filter mode in sliders and scrollbars
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 3, 1998
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  VSetFilter(vidget, value) sets the appropriate field in the structure for
+#  vidget to change the filtering mode (null for no filtering, "1" for
+#  filtering).
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure VSetFilter(vidget, value)	#: filter mode of slider/scrollbar
+   local t
+
+   t := type(vidget)
+
+   case t of {
+      "Vscrollbar_frame_rec" :  vidget.callback.callers[2].discont := value
+      "Vslider_rec"          :  vidget.discont := value
+      default                :  stop("*** invalid type to VSetFilter: ", t)
+      }
+
+   return
+
+end
diff --git a/ipl/gprocs/vframe.icn b/ipl/gprocs/vframe.icn
new file mode 100644
index 0000000..0ac2a1a
--- /dev/null
+++ b/ipl/gprocs/vframe.icn
@@ -0,0 +1,355 @@
+############################################################################
+#
+#	File:     vframe.icn
+#
+#	Subject:  Procedures for pane frame vidgets
+#
+#	Author:   Jon Lipp
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+# 	Vframe
+#	Vroot_frame
+#
+#  Utility procedures in this file:
+#
+# 	Vmin_frame_width()
+#	Vmin_frame_height()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+############################################################################
+#	frame vidget -
+#       Keeps track of panes.  Frames can contain
+#       sub-frames in a hierarchy.  Frames know their own absolute
+#       coordinates and the relative sizes and positions of their
+#       children (panes and sub-frames).  They determine positioning
+#       and size of each child, and route events.
+############################################################################
+
+record Vframe_rec(win, aw, ah, callback, id, lookup, draw, ax, ay,
+   uid, P, F, V)
+
+#
+#  Creation procedure for a Vframe.
+#	Specify its "own" utility procedures (V field).
+#	Specify "special" procedures (format, in F field).
+#	Get a unique id (uid).
+#	check implicit insertion, insert if necessary.
+#
+procedure Vframe(params[])
+   local self, procs, spec_procs, frame, x, y, ins
+
+   procs := Vstd(event_Vframe, draw_Vframe, outline_Vidget,
+      resize_Vframe, inrange_Vpane, init_Vframe,
+      couplerset_Vpane, insert_Vframe, remove_Vframe,
+      lookup_Vframe, set_abs_Vframe)
+   spec_procs := Vstd_dialog( , , format_Vframe)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vframe_rec ! params[1:6|0]
+   Vwin_check(self.win, "Vframe()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vframe()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vframe()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := spec_procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  Initialize procedure for Vframe.  Other frame types call this.
+#
+procedure init_Vframe(s)
+   s.lookup := []
+   s.draw := []
+end
+
+#
+#  draw the contents of the frame.
+#
+procedure draw_Vframe(s, erased)
+local p
+
+#  PMIcon: fixed bug; drawig before resize.
+   if /s.aw | /s.ah then _Vbomb("frame not resized yet")
+   /erased & EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   every p := !s.draw do p.V.draw(p, "erased")
+   s.V.outline(s)
+end
+
+#
+#  Set the absolute coordinates of everything on the draw list;
+#  Don't do it for Vline, it is special.
+#  It used to be that if the vidget is a Vpane,
+#  a resize event was sent, so that it would notify its callback.
+#  That "feature" has been commented out in the code below.
+#
+procedure resize_Vframe(s, x,y,wid,h)
+   local w, slots
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   resize_Vidget(s, x, y, wid, h)
+   every w := !s.draw do {
+      if (type(w) == "Vline_rec") then
+         w.V.resize(s, w)
+      else s.V.set_abs(s, w)
+#     if type(w) == "Vpane_rec" then
+#        w.V.event(w, -10)
+      }
+end
+#
+#  Determine the absolute coordinates of a vdiget based on its parent
+#  frame's absolute coordinates, and the "virtual" coordinates passed
+#  in upon creation.
+#  Allows for the fact that a pane can have relative
+#  position and size constraints intertwined with absolute.
+#
+procedure set_abs_Vframe(s, vid)
+local ax,ay,aw,ah, a, b, w, h, vx, vy, vw, vh
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   w := s.aw; h := s.ah
+   vx := vid.P.x; vy := vid.P.y
+   vw := vid.P.w; vh := vid.P.h
+
+   ax := s.ax + ( (vx <= -1, w + vx - (\vid.aw | 0)) |
+      (type(vx) == "real",
+      (-1 <= vx < 0, w - vx*w) |
+      (0 < vx <= 1, vx*w) ) | vx )
+   ay := s.ay + ( (vy <= -1, h + vy - (\vid.ah | 0)) |
+      (type(vy) == "real",
+      (-1 <= vy < 0, h - vy*h) |
+      (0 < vy <= 1, vy*h) ) | vy )
+
+   aw := (\vw, (type(vw) == "real", 0 < vw <= 1, vw*w) |
+      vw) | \vid.aw | w
+   ah := (\vh, (type(vh) == "real", 0 < vh <= 1, vh*h) |
+      vh) | \vid.ah | h
+   aw := integer(aw)
+   ah := integer(ah)
+
+## don't let kid be bigger than the frame.
+   if (a := aw + ax) > (b := s.aw + s.ax) then aw -:= (a-b)
+   if (a := ah + ay) > (b := s.ah + s.ay) then ah -:= (a-b)
+   vid.V.resize(vid, ax, ay, aw, ah)
+end
+
+#
+# Don't erase the vidget if erase is non-&null.
+#
+procedure remove_Vframe(s, pane, erase)
+local new, k
+
+   new := []
+   every k := !s.lookup do if k ~=== pane then put(new,k)
+   s.lookup := new
+   new := []
+   every k := !s.draw do if k ~=== pane then put(new,k)
+   s.draw := new
+
+   if /erase then VErase(pane)
+end
+
+#
+#  Insert a vidget into a frame.
+#
+procedure insert_Vframe(s, pane, x, y, w, h)
+local wc
+static image
+
+   initial image := proc("image", 0)	# protet attractive name
+
+#defaults
+   /x := 0
+   /y := 0
+   /w := \pane.aw
+   /h := \pane.ah
+   pane.P.x := x
+   pane.P.y := y
+   pane.P.w := w
+   pane.P.h := h
+   put(s.draw, pane)
+   if not (image(pane.V.event) ? find("null_proc") ) then
+      put(s.lookup, pane)
+   if (\s.ax, \s.ay, \s.aw, s.ah) then { # is this frame sized yet
+      if (type(pane) == "Vline_rec") then
+         pane.V.resize(s, pane)
+      else
+         s.V.set_abs(s, pane)
+   }
+end
+
+#
+#  Get events, lookup vidget based on (x, y), call its event loop.
+#
+procedure event_Vframe(s, e, x, y)
+local dest
+
+   if dest := s.V.lookup(s, x, y) then {
+      return dest.V.event(dest, e, x, y)
+   }
+end
+
+#
+#  For every vidget on lookup list, check if (x, y) lie within its
+#  boundaries.  Doesn't address overlapping vidgets.
+#
+procedure lookup_Vframe(s, x, y)
+local w
+
+   every w := !s.lookup do
+      if w.V.inrange(w, x, y) then
+         return w
+end
+
+#
+#  Determine and set the minimum bounding rectangle which encompasses
+#  all vidgets within the frame.  Restriction is that all vidgies must have
+#  been inserted with absolute coordinates and sizes.
+#
+procedure format_Vframe(self)
+   resize_Vidget(self, , , Vmin_frame_width(self), Vmin_frame_height(self))
+end
+
+
+############################################################################
+# Vroot_frame -
+# Root of the X-Idol event window demultiplexing recordes.
+# The root_frame record serves as the root for windows that are
+# subdivided.
+############################################################################
+
+procedure Vroot_frame(params[])
+   local self
+   static procs, spec_procs
+
+   initial {
+      procs := Vstd(event_Vroot_frame, draw_Vframe, null_proc,
+                   resize_Vroot_frame, inrange_Vpane, init_Vroot_frame,
+                   couplerset_Vpane, insert_Vframe, remove_Vframe,
+                   lookup_Vframe, set_abs_Vframe)
+      spec_procs := Vstd_dialog( , , format_Vframe)
+
+      VInit()
+   }
+
+   self := Vframe_rec ! params[1:2|0]
+   Vwin_check(self.win, "Vroot_frame()")
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := spec_procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure init_Vroot_frame(s)
+   s.ax := s.ay := 0
+   init_Vframe(s)
+end
+
+#
+#  Process events (same as for a frame).  Difference, is if we get a resize,
+#  resize all vidgets within, and redraw screen (no lookup performed).
+#
+procedure event_Vroot_frame(s,e,x,y)
+local dest
+
+   if e === &resize then {
+      s.V.resize(s)
+      return &null
+   }
+   else {
+      if dest:= s.V.lookup(s,x,y) then
+         return dest.V.event(dest,e,x,y)
+      else fail
+   }
+end
+
+#
+# The window was resized!  Well... reconfigure all the absolute
+# position and sizes for all panes.  This benefits relative values
+# the most.
+#
+procedure resize_Vroot_frame(s)
+
+   s.aw := WAttrib(s.win, "width")
+   s.ah := WAttrib(s.win, "height")
+   resize_Vframe(s, s.ax, s.ay, s.aw, s.ah)
+   s.V.draw(s)
+end
+
+############################################################################
+# Utility procedures for frames.
+############################################################################
+
+#
+# Min--- returns the minimum size of the frame that will encase all
+# children.  NOTE - this can only be determined if all the children
+# were inserted with absolute co-ords and sizes. I.e. positive and
+# integral x, y, w, & h.
+#
+procedure Vmin_frame_width(s)
+   local max, vid
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   max := 2
+   every vid := (!s.draw) do
+      if (type(vid) ~== "Vline_rec") then {
+         if type(vid.P.x) == "real" | type(vid.P.w) == "real" |
+            vid.P.x < 0 | vid.P.w < 0 then
+            _Vbomb("attempt to format a frame with non-absolute sized and positioned children")
+         max <:= (vid.P.x + vid.P.w )
+      }
+   return max
+end
+
+procedure Vmin_frame_height(s)
+   local max, vid
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   max := 2
+   every vid := (!s.draw) do
+      if (type(vid) ~== "Vline_rec") then {
+         if type(vid.P.y) == "real" | type(vid.P.h) == "real" |
+            vid.P.y < 0 | vid.P.h < 0 then
+            _Vbomb("attempt to format a frame with non-absolute sized and positioned children")
+         max <:= (vid.P.y + vid.P.h )
+      }
+   return max
+end
diff --git a/ipl/gprocs/vgrid.icn b/ipl/gprocs/vgrid.icn
new file mode 100644
index 0000000..2bc2367
--- /dev/null
+++ b/ipl/gprocs/vgrid.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:     vgrid.icn
+#
+#	Subject:  Procedures for vidget grids
+#
+#	Author:   Jon Lipp
+#
+#	Date:     March 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+record Vgrid_rec(win, callback, id,  aw, ah, rows, cols, Hpos, Vpos, hpad, vpad,
+   ax, ay, uid, P, V)
+
+procedure Vgrid(params[])
+   local self, i, frame, x, y, ins
+   static procs
+
+   initial procs := Vstd(event_Vgrid, draw_Vgrid, outline_Vidget,
+      resize_Vgrid, inrange_Vpane, init_Vgrid)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vgrid_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vgrid()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vgrid()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vgrid()")
+   if (\self.rows, not numeric(self.rows) ) then
+      _Vbomb("invalid rows parameter to Vgrid()")
+   if (\self.cols, not numeric(self.cols) ) then
+      _Vbomb("invalid cols parameter to Vgrid()")
+
+   self.V := procs
+   self.P := Vstd_pos()
+   self.uid := Vget_uid()
+ 
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure init_Vgrid(self)
+   local p
+
+   self.Hpos := table()
+   self.Vpos := table()
+   /self.aw := 100
+   /self.ah := 100
+   /self.rows := 10
+   /self.cols := 10
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+   return self
+end
+
+procedure draw_Vgrid(self)
+   local i
+
+   # draw vertical lines
+   every i := 0 to self.cols do 
+      DrawLine(self.win, self.ax+self.Hpos[i], self.ay, 
+         self.ax+self.Hpos[i], self.ay+self.ah)
+
+   # draw horizontal lines.
+   every i := 0 to self.rows do 
+      DrawLine(self.win, self.ax, self.ay+self.Vpos[i], 
+         self.ax+self.aw, self.ay+self.Vpos[i])
+end
+
+procedure event_Vgrid(self, e)
+   local row, col
+
+   if \self.callback.locked then fail
+   col := VGetCol(self, &x)
+   row := VGetRow(self, &y)
+   return self.callback.V.set(self.callback, self, [row, col, e])
+end
+
+procedure resize_Vgrid(self, x, y, w, h)
+   local i
+
+   resize_Vidget(self, x, y, w, h)
+
+   self.hpad := 1 <= self.aw / real(self.cols) | 1
+   self.vpad := 1 <= self.ah / real(self.rows) | 1
+
+   every i := 0 to self.cols do
+      self.Hpos[i] := integer (i * self.hpad )
+      
+   every i := 0 to self.rows do 
+      self.Vpos[i] := integer(i * self.vpad )
+end
+
+procedure VFillGrid(self, row, col)
+
+   FillRectangle(self.win, self.ax+self.Hpos[col], self.ay+self.Vpos[row],
+      1 <= self.Hpos[col+1] - self.Hpos[col] | 1,
+      1 <= self.Vpos[row+1] - self.Vpos[row] | 1 )
+end
+
+procedure check_Vgrid(self, row, col)
+
+end
+
+procedure VEraseGrid(self, row, col)
+
+   EraseArea(self.win, self.ax+self.Hpos[col]+1, self.ay+self.Vpos[row]+1,
+      1 <= ( self.Hpos[col+1] - self.Hpos[col] - 1) | 1,
+      1 <= ( self.Vpos[row+1] - self.Vpos[row] - 1) | 1 )
+end
+
+procedure VGetRow(self, y)
+   local row
+
+   row := integer( (y - self.ay) / real(self.vpad) )
+   row := row < 0 | row > self.rows - 1
+   return row
+end
+
+procedure VGetCol(self, x)
+   local col
+
+   col := integer( (x - self.ax) / real(self.hpad) )
+   col := col < 0 | col > self.cols - 1
+   return col
+end
+
diff --git a/ipl/gprocs/vidgets.icn b/ipl/gprocs/vidgets.icn
new file mode 100644
index 0000000..59819c3
--- /dev/null
+++ b/ipl/gprocs/vidgets.icn
@@ -0,0 +1,28 @@
+############################################################################
+#
+#	File:     vidgets.icn
+#
+#	Subject:  Procedures for vidgets
+#
+#	Author:   Jon Lipp
+#
+#	Date:     September 17, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links to basic vidget files needed to use the library.
+#
+############################################################################
+
+link graphics
+link vcoupler
+link vframe
+link viface
+link vlist
+link vmenu
+link vpane
+link vstd
diff --git a/ipl/gprocs/viface.icn b/ipl/gprocs/viface.icn
new file mode 100644
index 0000000..6047cc7
--- /dev/null
+++ b/ipl/gprocs/viface.icn
@@ -0,0 +1,421 @@
+############################################################################
+#
+#	File:     viface.icn
+#
+#	Subject:  Procedures for interfacing vidgets
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file:
+#	VDraw()
+#	VErase()
+#	VOutline()
+#	VResize()
+#	VRemove()
+#	VInsert()
+#	VEvent()
+#	VRegister()
+#	VUnregister()
+#	VOpenDialog()
+#	VFormat()
+#	VAddClient()
+#	VToggle()
+#	VUnSet()
+#	VSetState()  [formerly SetVidget() and VSet()]
+#	VGetState()
+#	VSetItems()
+#	VGetItems()
+#	ProcessEvent()
+#	GetEvents()
+#	VEcho()
+#	VSetFont()
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "vdefns.icn"
+
+procedure VDraw(vid, code)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VDraw()")
+
+   vid.V.draw(vid, code)
+end
+
+procedure VErase(vid)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset) then
+      _Vbomb("invalid vidget parameter to VErase()")
+   if type(vid) == "Vline_rec" then
+      erase_Vline(vid)
+   else
+      EraseArea(vid.win, vid.ax, vid.ay, vid.aw, vid.ah)
+end
+
+procedure VOutline(vid)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VOutline()")
+
+   vid.V.outline(vid)
+end
+
+procedure VResize(vid, x, y, w, h)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VResize()")
+   if type(vid) == "Vline_rec" then {
+      vid.ax1 := \x
+      vid.ay1 := \y
+      vid.ax2 := vid.ax1 + \w
+      vid.ay2 := vid.ay1 + \h
+   }
+   else {
+      vid.ax := \x
+      vid.ay := \y
+      vid.aw := \w
+      vid.ah := \h
+   }
+   vid.V.resize(vid)
+end
+
+procedure VRemove(frame, vid, erase)
+   if not (type(frame) ? find("frame") ) then
+      _Vbomb("invalid frame parameter to VRemove()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VRemove()")
+ 
+   frame.V.remove(frame, vid, erase)
+end
+
+procedure VInsert(frame, vid, x, y, w, h)
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   if not (type(frame) ? find("frame") ) then
+      _Vbomb("invalid frame parameter to VInsert()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VInsert(): " || image(vid))
+   else if (\x, not numeric(x) ) then
+      _Vbomb("non-numeric x parameter to VInsert()")
+   else if (\y, not numeric(y) ) then
+      _Vbomb("non-numeric y parameter to VInsert()")
+   else if (\w, not numeric(w) ) then
+      _Vbomb("non-numeric w parameter to VInsert()")
+   else if (\h, not numeric(h) ) then
+      _Vbomb("non-numeric y parameter to VInsert()")
+   frame.V.insert(frame, vid, x, y, w, h)
+end
+
+procedure VEvent(vid, e, x, y)
+   if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VEvent()")
+
+   return vid.V.event(vid, e, x, y)
+end
+
+############################################################################
+#  The following two procedure are only for use with dialog box frames
+#  and menu_frames.
+#
+#  VRegister is analogous to VInsert, except, it tells the dialog box that
+#  this is an editable field.
+############################################################################
+procedure VRegister(dialog, vid, x, y, w, h)
+   if not (type(dialog) ? find("dialog_frame") ) then
+      _Vbomb("invalid dialog parameter to VRegister()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VRegister()")
+   else if (\x, not numeric(x) ) then
+      _Vbomb("Non-numeric x parameter to VRegister()")
+   else if (\y, not numeric(y) ) then
+      _Vbomb("Non-numeric y parameter to VRegister()")
+   else if (\w, not numeric(w) ) then
+      _Vbomb("Non-numeric w parameter to VRegister()")
+   else if (\h, not numeric(h) ) then
+      _Vbomb("Non-numeric y parameter to VRegister()")
+
+   dialog.F.register(dialog, vid, x, y, w, h)
+end
+
+procedure VUnregister(dialog, vid)
+   if not (type(dialog) ? find("dialog_frame") ) then
+      _Vbomb("invalid dialog parameter to VUnregister()")
+   else if not (type(vid) == !Vrecset ) then
+      _Vbomb("invalid vidget parameter to VUnregister()")
+
+   dialog.F.unregister(dialog, vid)
+end
+
+#
+# Vopen_dialog
+# Opens a dialog for input.  Returns the list of new objects, or the
+# original data if "cancel" was picked.
+#
+# open a dialog box at (x, y);  dialog contains a record of type
+# 'dialog', data is a list of initial values corresponding to the
+# objects "registered" with the dialog; default_string is the label
+# of the control button to press upon hitting a return.
+#
+# If x is null and y is not, y is an "ID" for the dialog box, which
+# opens at the default location but can be moved by the user.  The
+# location is remembered and applied to subsequent opens.
+#
+procedure VOpenDialog(dialog, x, y, data, default_string)
+   if not (type(dialog) ? find("dialog_frame") ) then
+      _Vbomb("invalid dialog parameter to VOpenDialog()")
+   if \x & not (numeric(x) & numeric(y)) then
+      _Vbomb("invalid x or y parameter passed to VOpenDialog()")
+   /data := []
+   return \(dialog.F.open_dialog(dialog, x, y, data, default_string)) | data
+end
+
+
+#
+#  VFormat resizes the frame, and figures out the width and height
+#  automatically, contingent on all vidgets being inserted or registered
+#  with absolute coordinates.
+#
+procedure VFormat(frame)
+   if not (type(frame) ? find("frame") ) then
+      _Vbomb("invalid frame parameter to VFormat()")
+
+   frame["F"].format(frame)
+end
+
+############################################################################
+#  The following procedure is only for use with couplers.
+############################################################################
+
+procedure VAddClient(coupler, client, caller)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VAddClient()")
+
+   coupler.V.add_client(coupler, client, caller)
+end
+
+procedure VToggle(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VToggle()")
+
+   coupler.V.toggle(coupler)
+end
+
+procedure VUnSet(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VUnSet()")
+
+   coupler.V.unset(coupler)
+end
+
+procedure VLock(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VLock()")
+
+   coupler.locked := 1
+end
+
+procedure VUnLock(coupler)
+   if not (type(coupler) ? find("coupler") ) then
+      _Vbomb("invalid coupler parameter to VUnLock()")
+
+   coupler.locked := &null
+end
+
+############################################################################
+# VSetState sets the vidget | coupler to the value.
+############################################################################
+procedure VSetState(vid, val, code)
+   if type(vid) ? find("coupler") then
+      return (\(\vid).V.set)(vid, , val, code)
+   else if type(vid) == !Vrecset then
+      return (\(\vid).V.set_value)(vid, val, code)
+   else 
+      _Vbomb("invalid vidget parameter to VSetState()")
+end
+
+procedure SetVidget(vid, val, code)	# old name
+   SetVidget := VSetState
+   return VSetState(vid, val, code)
+end
+
+procedure VSet(vid, val, code)		# older name
+   VSet := VSetState
+   return VSetState(vid, val, code)
+end
+
+############################################################################
+# VGetState returns the value of the vidget state.
+############################################################################
+procedure VGetState(vid)
+   if type(vid) ? find("scroll" | "slide" | "radio" | "text") then
+      return (\vid.callback).value
+   else if vid.V.set_value === set_value_Vlist then		# list vidget
+      return get_value_Vlist(vid)
+   else if type(vid) == "Vbutton_rec" &
+      (vid.V.event === event_Vtoggle) then return(\vid.callback).value
+   else
+      fail
+end
+
+############################################################################
+# VSetItems sets the items displayed by a list vidget.
+############################################################################
+procedure VSetItems(vid, val)
+   if vid.V.set_value === set_value_Vlist then	# list vidget
+      return set_items_Vlist(vid, val)
+   else if type(vid) == "Vframe_rec" & type(vid.lookup) == "list" &
+         type(vid.lookup[1]) == "Vmenu_item_rec" then
+      return Vmenu_set_items(vid, val)
+   else
+      fail
+end
+
+############################################################################
+# VGetItems returns the items displayed by a list vidget.
+############################################################################
+procedure VGetItems(vid)
+   if vid.V.set_value === set_value_Vlist then	# list vidget
+      return get_items_Vlist(vid)
+   else if type(vid) == "Vframe_rec" & type(vid.lookup) == "list" &
+         type(vid.lookup[1]) == "Vmenu_item_rec" then
+      return Vmenu_get_items(vid)
+   else 
+      fail
+end
+
+
+############################################################################
+# Event handlers. 
+############################################################################
+
+procedure GetEvents(vidget, missed, all, resize)
+   repeat ProcessEvent(vidget, missed, all, resize)
+end
+
+procedure ProcessEvent(vidget, missed, all, resize)
+   local event, lrv
+
+   type(vidget) ? {
+      if not find("frame")
+      then _Vbomb("invalid frame argument to ProcessEvent()")
+      }
+
+   event := Event(vidget.win)
+
+   if event === &resize then {
+      (\resize)(vidget, event, &x, &y)
+      VEvent(vidget, event, &x, &y)
+      }
+
+   (\(lrv := vidget.V.lookup(vidget,&x,&y)) & lrv.V.event(lrv,event,&x,&y)) |
+      (\missed)(event, &x, &y)
+
+   (\all)(event, &x, &y)
+
+   return event
+
+end
+
+
+############################################################################
+#  VEcho(v, x) -- echoing callback routine
+#
+#  VEcho can be used as the default callback routine passed to vsetup.
+#  It just prints a message on standard output giving the value of x.
+############################################################################
+
+procedure vecho(v, x)	# old name
+   vecho := VEcho
+   return VEcho(v, x)
+end
+
+procedure VEcho(v, x)
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   writes("callback: id=", v.id, ", value=")
+   if type(x) == "list" then {
+      writes("[")
+      writes(image(x[1]))
+      every writes(",", image(x[2 to *x]))
+      writes("]")
+      }
+   else
+      writes(image(x))
+   write()
+   return
+end
+
+
+############################################################################
+#  VSetFont(win) -- set vidget font in window.
+#
+#  VSetFont tries to set a 7-pixel-wide font for use by VIB and vidgets.
+############################################################################
+
+procedure vsetfont(win)		# old name
+   vsetfont := VSetFont
+   return VSetFont(win)
+end
+
+procedure VSetFont(win)
+   local spec, maybe
+
+   /win := &window
+   if WAttrib(win, "fwidth") = VFWidth then
+      return win			# existing font is acceptable
+
+   every spec := 
+
+$ifdef _X_WINDOW_SYSTEM
+         "lucidasanstypewriter-bold-12" |
+         "-*-lucidatypewriter-bold-r-*-*-12-*-*-*-*-70-iso8859-1" | 
+         "-*-lucidatypewriter-bold-r-*-*-*-*-*-*-*-70-iso8859-1" | 
+         "-*-*-r-*-sans-*-*-*-*-m-70-iso8859-1" |
+         "-*-*-r-*-*-*-*-*-*-m-70-iso8859-1" |
+         "-*-*-r-*-*-*-*-*-*-c-70-iso8859-1"
+$else
+         ("mono,bold," | "mono," | "typewriter,") || (12 | 11 | 13 | 10 | 14)
+$endif
+
+      do {
+         Font(win, spec) | next		# try a font
+         /maybe := spec			# remember first success
+         if WAttrib(win, "fwidth") = VFWidth then
+            return win			# this font is right size
+         }
+
+   # No font was the right size.  Go back to the first one that was legal.
+   # If nothing works, return with the font unchanged.
+   Font(win, \maybe)
+   return win
+end
diff --git a/ipl/gprocs/vlist.icn b/ipl/gprocs/vlist.icn
new file mode 100644
index 0000000..d0820a9
--- /dev/null
+++ b/ipl/gprocs/vlist.icn
@@ -0,0 +1,964 @@
+############################################################################
+#
+#	File:     vlist.icn
+#
+#	Subject:  Procedures for a scrollable list vidget
+#
+#	Author:   Jason Peacock and Gregg Townsend
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#   Vidgets defined in this file:
+#
+#      Vlist
+#
+#   Utility procedures in this file:
+#
+#      storage_Vlist()
+#      set_items_Vlist()
+#      get_items_Vlist()
+#      set_value_Vlist()
+#      get_value_Vlist()
+#      coupler_Vlist()
+#      drawlist_Vlist()
+#      Vframe_Vlist()
+#      outline_listframe()
+#      resize_listframe()
+#      Vpane_Vlist()
+#      event_Vlist()
+#      vlist_selection()
+#      outline_listpane()
+#
+############################################################################
+#
+#   Includes:  vdefns
+#
+############################################################################
+#
+#   Requires:  Version 9 graphics
+#
+############################################################################
+#
+#   Links:  graphics, vidgets, vscroll, vcoupler
+#
+############################################################################
+
+#  DEFICIENCIES TO REMEDY LATER:
+#
+#  don't clone two new windows every time the vidget is redrawn
+#  don't insist on string-valued ID
+#  toss out storage_Vlist()
+#
+#  dragging fast can skip items
+
+
+$include "vdefns.icn"
+
+link graphics, vidgets, vscroll, vcoupler
+
+$define V_READONLY	"r"
+$define V_SELECT	"w"
+$define V_MULTISELECT	"a"
+
+############################################################################
+#
+#   list vidget -
+#
+#   Creates a vidget that displays a list of strings within a region,
+#   can be scrolled to view the entire list a section at a time, and
+#   can call a callback procedure if an item(s) in the list is selected.
+#
+############################################################################
+
+
+
+############################################################################
+#
+# PROCEDURE
+#    Vlist(frame, x, y, win, cb, id, dl, c, w, h, m)
+#    vidget := Vlist(win, cb, id, dl, c, w, h, m)
+#
+# DESCRIPTION
+#    Create a list vidget.  A vlist is simply a square region
+#    in which lines of text are displayed.  Since the number of lines
+#    to be displayed can exceed the number of lines the region can
+#    display, a vertical scrollbar, set to the right of the region,
+#    is used to allow the user to scroll the list through the region.
+#
+#    It has been implemented by using a standard vframe vidget form
+#    with a few callbacks altered since a vlist is not a normal
+#    vframe.  Into the frame are placed two vidgets: a vpane, and
+#    a vvert_scrollbar.  The scrollbar's callback is a coupler
+#    variable that is used to link the scrollbar and the pane
+#    together.
+#
+# INPUTS
+#    frame - The frame the vlist will be inserted into
+#    x     - The x coordinate of the insertion
+#    y     - The y coordinate of the insertion
+#
+#    The above three parameters are optional.  If used, all three
+#    parameters must be given.
+#
+#    win   - the window the vidget is created in
+#    cb    - the procedure that will serve as the callback
+#    id    - the id of the vidget
+#    dl    - the initial list (of strings) that will be displayed
+#    c     - Is 1 for discontinuous scroll or &null for continuous scrolling
+#    w     - the width of the vidget
+#    h     - the height of the vidget
+#    m     - how the list will be displayed
+#
+#       These are the mode parameter values:
+#
+#       V_READONLY     - Instructs Vlist that the list will be a
+#                        display only.  No lines can be highlighted.
+#
+#       V_SELECT       - Only one line can be highlighted at a time.
+#                        The callback is not not executed until the
+#                        mouse button is released.
+#
+#       V_MULTISELECT  - Several lines may be highlighted at once.
+#                        The callback is executed every time the
+#                        mouse button is released.  A list of the
+#                        currently highlighted items is sent.
+#
+# OUTPUT
+#    vidget - A Vframe_rec record containing the list vidget
+#
+# EXAMPLE
+#    To create a vlist that will display the contents of the
+#    list (of strings) variable, datalist, in a region measuring
+#    640 pixels across and 480 pixels high, allow no selection,
+#    and have no callback procedure, make this call:
+#
+#       lv := Vlist(win, , "lv_id", datalist, 1, 640, 480, V_READONLY)
+#
+#    where win is the window variable and "lv_id" is the id value.
+#
+# BUGS
+#    The are no defaults for the win, id, dl, x, and y parameters.
+
+procedure Vlist(params[])
+
+## ins       - This flag is set if the vidget is to implicitly inserted
+##             into a frame (that was also passed as a parameter).
+## self      - The record containing the frame which is the list vidget
+## fh        - The height of the font used in the list
+## viewport  - The vpane vidget, to be inserted into 'self'
+## cv        - The coupler variable
+## sb        - The scrollbar vidget, to be inserted into 'self'
+## line      - Temporary storage for each line in 'dl'
+## window_sz - The number of lines the list can display at a time
+
+local frame, x, y, win, cb, id, dl, c, w, h, mode
+local self, ins, fh, viewport, cv, sb, line, window_sz
+local datalist
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+## CHECK FOR IMPLICIT INSERT INTO GIVEN FRAME ##############################
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+   }
+
+## CHECK THE INPUT VALUES ##################################################
+
+   if type(params[1]) == "window" then win := pop(params)
+   else _Vbomb("improper window parameter given to Vlist")
+   if type(params[1]) == ("procedure" | "null") then cb := pop(params)
+   else _Vbomb("improper callback parameter given to Vlist")
+   id := pop(params)
+   if type(params[1]) == ("list" | "null") then dl := pop(params)
+   else _Vbomb("improper list parameter given to Vlist")
+   if type(params[1]) == ("integer" | "null") then c := pop(params)
+   else _Vbomb("improper scrollmode parameter given to Vlist")
+
+   if \params[1] & \params[2] then {
+      w := pop(params); h := pop(params)
+   }
+   else _Vbomb("improper width and height values given to Vlist")
+
+   case \params[1] of {
+      V_READONLY | V_SELECT | V_MULTISELECT :
+         mode := pop(params)
+      default :
+         _Vbomb("improper mode parameter given to Vlist")
+   }
+
+   /mode := V_SELECT	## DEFAULT SELECT MODE IS SELECT ONE LINE ONLY
+   /dl := []		## DEFAULT LIST IS EMPTY LIST
+
+
+## CREATE THE VLIST ########################################################
+
+   self := Vframe_Vlist(win)
+   self.id := id
+
+   storage_Vlist(id, "write", "mode", mode)
+
+   viewport := Vpane_Vlist(win, cb, id, "sunken", w - VSlider_DefWidth - 2, h)
+   VInsert(self, viewport, 0, 0)
+
+   fh := WAttrib(viewport.win, "fheight")
+   window_sz := integer((h - 4) / fh) - 1
+
+   cv := Vcoupler()
+   VAddClient(cv, coupler_Vlist, viewport)
+
+   sb := Vvert_scrollbar(win, cv, id,
+      h, VSlider_DefWidth, *dl, 1, 1, window_sz, c)
+
+   VInsert(self, sb, w - VSlider_DefWidth, 0)
+   VFormat(self)
+
+   datalist := []
+   every line := !dl do put(datalist, "N" || line)
+
+   storage_Vlist(id, "write", "datalist", datalist)
+   storage_Vlist(id, "write", "top_line", 1)
+   storage_Vlist(id, "write", "selection", &null)
+   storage_Vlist(id, "write", "continuous", c)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    storage_Vlist(id, op, var, val)
+#    val := storage_Vlist(id, op, var)
+#
+# DESCRIPTION
+#    Used to store variables that are needed but can't be stored
+#    within a vframe_rec, vpane_rec, or vscrollbar_rec.
+#
+#    This procedure performs its magic by keeping a static table
+#    of data.  Information is indexed by using the vlist's id
+#    following by a "@" character and then the variable name as
+#    the suffix.
+#
+# INPUTS
+#    id  - The id of the vlist doing the storing
+#    op  - Which operation? "write" or "read"?  If "read", then the
+#          val parameter is ignored.
+#    var - The name to store the value under
+#    val - The value to be stored
+#
+# OUTPUT
+#    val - The value that was stored under the name var.
+#
+# EXAMPLES
+#
+#    If there is a vlist with an id of "lv_1" and the list of
+#    strings it is displaying is stored in variable "datalist", then
+#    that list can be stored with this call:
+#
+#       storage_Vlist("lv_1", "write", "datalist", datalist)
+#
+#    To retrieve that information:
+#
+#       datalist := storage_Vlist("lv_1", "read", "datalist")
+#
+# BUGS
+#    Since the table is static, it is possible for newly created
+#    vlists to "remember" the data from older vlists if
+#    the both and the new and old vlist have the same id.
+#
+#    This procedure requires that the vidget ID be a string, 
+#    an additional restriction not usually imposed.
+
+procedure storage_Vlist(id, op, var, val)
+local k
+static var_table
+
+initial var_table := table()
+
+   k := id || "@" || var
+
+   case op of {
+      "read" : return var_table[k]
+      "write" : var_table[k] := val
+   }
+
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    set_items_Vlist(self, slist)
+#
+# DESCRIPTION
+#    Set list of displayed lines.
+#    State is reset to no lines selected, scrolling at top.
+#
+# INPUTS
+#    self - the vidget record
+#    slist - list of strings
+
+procedure set_items_Vlist(self, slist)
+   local dl, tl, lv, sb, cv, c, s, window_sz
+
+   # build new datalist
+   tl := 1
+   dl := []
+   every s := !slist do
+      put(dl, "N" || string(s)) |
+         _Vbomb("list entry for VSetItems() is not a string")
+
+   # replace datalist and reset top_line
+   lv := self.lookup[1]
+   storage_Vlist(lv.id, "write", "datalist", dl)
+   storage_Vlist(lv.id, "write", "top_line", tl)
+   storage_Vlist(lv.id, "write", "selection", 0)
+
+   # replace scrollbar with a new one
+   sb := self.lookup[2]
+   VRemove(self, sb)
+   cv := Vcoupler()
+   c := storage_Vlist(lv.id, "read", "continuous")
+   VAddClient(cv, coupler_Vlist, lv)
+   window_sz := integer(lv.uh / WAttrib(lv.win, "fheight")) - 1
+   sb := Vvert_scrollbar(self.win, cv, self.id, self.ah, VSlider_DefWidth,
+                         *dl, 1, 1, window_sz, c)
+   VInsert(self, sb, self.aw - VSlider_DefWidth, 0)
+   VFormat(self)
+
+   # redraw everything
+   VDraw(self)
+   return
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    get_items_Vlist(self)
+#
+# DESCRIPTION
+#    Returns the list of displayed lines.
+#
+# INPUT
+#    self - the vidget record
+#
+# OUTPUT
+#    items - list of strings
+
+procedure get_items_Vlist(self)
+   local lv, dl, items
+
+   lv := self.lookup[1]
+   dl := storage_Vlist(lv.id, "read", "datalist")
+   items := []
+   every put(items, (!dl)[2:0])
+   return items
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    set_value_Vlist(self, state)
+#
+# DESCRIPTION
+#    This procedure sets the state of the vidget.
+#
+# INPUT
+#    self - the vidget record
+#    state - a list of integers:
+#	the first integer gives the index of the first viewable line
+#	any addition integers are indices of selected lines
+
+procedure set_value_Vlist(self, state)
+   local c, i, lv, sb, dl, tl, mode, window_sz, iset, val
+
+## lv        - the Vpane vidget of the vlist frame vidget
+## sb        - the scrollbar vidget of the vlist frame vidget
+## dl        - The list being displayed
+## tl        - The line in the list which is at the top of the display
+
+   lv := self.lookup[1]
+   sb := self.lookup[2]
+   dl := storage_Vlist(lv.id, "read", "datalist")
+   mode := storage_Vlist(lv.id, "read", "mode")
+   window_sz := integer(lv.uh / WAttrib(lv.win, "fheight")) - 1
+
+   if type(state) ~== "list" then
+      state := [state]
+   tl := state[1] | &null
+   /tl := 1
+   tl := integer(tl) | _Vbomb("non-integer value in VSetState() of a list")
+   tl >:= *dl - window_sz
+   tl <:= 1
+   storage_Vlist(lv.id, "write", "top_line", tl)
+   VSetState(sb, tl)
+
+   if *state > 1 & mode === V_READONLY then
+      _Vbomb("VSetState() cannot select lines of read-only list")
+   else if *state > 2 & mode ~=== V_MULTISELECT then
+      _Vbomb("VSetState() cannot select multiple lines of this list")
+
+   val := list()			# list of values for callback
+   iset := set()			# make set of indices
+   every i := state[2 to *state] do
+      insert(iset, integer(i)) | 
+         _Vbomb("non-integer value in VSetState() of a list")
+
+   every i := 1 to *dl do {
+      if member(iset, i) then {		# S is selected, N is not
+         c := "S"
+         put(val, dl[i][2:0])
+         }
+      else
+         c := "N"
+      dl[i][1] ~==:= c	
+      }
+
+   drawlist_Vlist(lv, dl, tl)	# redraw vidget
+
+   case mode of {			# invoke callback
+      V_SELECT: {
+         storage_Vlist(lv.id, "write", "selection", !iset | 0)
+         (\lv.callback)(self, val[1] | &null, !iset | 0)
+         }
+      V_MULTISELECT: {
+         (\lv.callback)(self, val, sort(iset))
+         }
+      }
+
+   return
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    get_value_Vlist(self)
+#
+# DESCRIPTION
+#    This procedure returns the state of the vidget.
+#
+# INPUT
+#    self - the vidget record
+#
+# OUTPUT
+#    state - a list of integers:
+#	the first integer gives the index of the first viewable line
+#	any addition integers are indices of selected lines
+
+procedure get_value_Vlist(self)
+   local i, lv, dl, tl, state
+
+## lv        - the Vpane vidget of the vlist frame vidget
+## dl        - The list being displayed
+## tl        - The line in the list which is at the top of the display
+
+   lv := self.lookup[1]
+   dl := storage_Vlist(lv.id, "read", "datalist")
+   tl := storage_Vlist(lv.id, "read", "top_line")
+   state := [tl]
+   every i := 1 to *dl do
+      if dl[i] ? ="S" then
+         put(state, i)
+   return state
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    coupler_Vlist(self, val)
+#
+# DESCRIPTION
+#    This function is the callback used by the coupler which connects the
+#    scrollbar to the pane.  Whenever the scrollbar is moved, this function
+#    gets called with the pane's record and the scrollbar's new value so
+#    that the display can be updated appropriately.
+#
+#    The scrollbar changes the current value of topline so the list must be
+#    redisplayed with the new topline position in the list as the top line.
+#
+# INPUTS
+#    self - the pane vidget which displays the list
+#    val  - the new value for topline
+
+procedure coupler_Vlist(self, val)
+local tl, dl, sl, dh, fh, fw
+
+   tl := storage_Vlist(self.id, "read", "top_line")
+   if tl === val then fail
+
+   dl := storage_Vlist(self.id, "read", "datalist")
+   fh := WAttrib(self.win, "fheight")
+   fw := WAttrib(self.win, "fwidth")
+
+   tl := val
+   storage_Vlist(self.id, "write", "top_line", tl)
+
+   drawlist_Vlist(self, dl, tl)
+
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    drawlist_Vlist(pane, dl, tl)
+#
+# DESCRIPTION
+#    Draw a list of strings within the specified region of the window
+#
+# INPUTS
+#    pane - the pane vidget the strings are drawn in
+#    dl   - the list of strings
+#    tl   - the first line in the list to be drawn
+
+procedure drawlist_Vlist(pane, dl, tl)
+local win, x, y, w, h
+local fh, fw, ds, z, col, rev, non, mode, margin
+
+##
+## z   - Serves as the counter through the list
+## col - The number of columns that can be displayed in the vpane
+## non - The normal draw mode
+## rev - Draw with "reverse=on"
+##
+
+   win := pane.win
+   x := pane.ux
+   y := pane.uy
+   w := pane.uw
+   h := pane.uh
+
+   fh := WAttrib(win, "fheight")
+   fw := WAttrib(win, "fwidth")
+   ds := WAttrib(win, "descent")
+
+   rev := Clone(win, "reverse=on", "clipx="||x, "clipy="||y,
+                                    "clipw="||w, "cliph="||h)
+   non := Clone(rev, "reverse=off")
+
+   case storage_Vlist(pane.id, "read", "mode") of {
+      V_READONLY:  {
+         margin := 4
+         EraseArea(non, x, y, margin, h)
+         }
+      V_SELECT:  {
+         margin := 8
+         EraseArea(non, x, y, margin, h)
+         DrawGroove(non, x + 4, y + 1, x + 4, y + h - 2)
+         }
+      V_MULTISELECT:  {
+         margin := 12
+         EraseArea(non, x, y, margin, h)
+         DrawGroove(non, x + 4, y + 1, x + 4, y + h - 2)
+         DrawGroove(non, x + 8, y + 1, x + 8, y + h - 2)
+         }
+      }
+
+   z := tl
+   h +:= (y - fh)
+   y -:= ds
+   col := integer((w - 2) / fw)
+
+   while ((y < h) & (z <= *dl)) do
+   {
+      GotoXY(win, x + margin, y + fh)
+      if dl[z][1] == "S" then
+         WWrites(rev, left(dl[z][2:0], col))
+      else
+         WWrites(non, left(dl[z][2:0], col))
+
+      y +:= fh
+      z +:= 1
+   }
+
+   EraseArea(non, x + margin, y + ds)
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    Vframe_Vlist([frame, x, y], win, aw, ah)
+#
+# DESCRIPTION
+#    Creates the frame for the list vidget.  The only differences
+#    between this procedure and the normal Vframe() procedure is that the
+#    outline_Vframe callback has been changed to outline_listframe() and
+#    there is now a set_value_Vlist() procedure callback that can
+#    respond to calls from VSetState().
+#
+# INPUTS
+#    frame - (optional) the frame to insert this vidget in
+#    x     - (optional) the x coordinate to insert the vidget at
+#    y     - (optional) the y coordinate to insert the vidget at
+#
+#    These three parameters listed above are optional.  However, they must
+#    all be present if you plan to use them.
+#
+#    win   - the window the vidget will appear in
+#    aw    - (optional) the width of the vidget
+#    ah    - (optional) the height of the vidget
+#
+#    The aw and ah parameters are usually not given because they are
+#    set later with a call to VFormat().
+#
+# OUTPUT
+#    A frame vidget
+
+procedure Vframe_Vlist(params[])
+local self, procs, spec_procs, frame, x, y, ins
+ 
+   procs := Vstd(event_Vframe, draw_Vframe, outline_listframe,
+      resize_listframe, inrange_Vpane, init_Vframe,
+      couplerset_Vpane, insert_Vframe, remove_Vframe,
+      lookup_Vframe, set_abs_Vframe, set_value_Vlist)
+   spec_procs := Vstd_dialog(, , format_Vframe)
+ 
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vframe_rec ! params[1:6|0]
+   Vwin_check(self.win, "Vframe()")
+   if (\self.aw, not numeric(self.aw)) then
+      _Vbomb("invalid aw parameter to Vframe()")
+   if (\self.ah, not numeric(self.ah)) then
+      _Vbomb("invalid ah parameter to Vframe()")
+ 
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := spec_procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    outline_listframe()
+#
+# DESCRIPTION
+#    This is a dummy function to prevent the list frame from drawing
+#    any kind of a border around the vidget.
+
+procedure outline_listframe()
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    resize_listframe(s, x, y, w, h) #
+# DESCRIPTION
+#    Handle resizing of a Vlist.
+
+procedure resize_listframe(s, x, y, w, h)
+   /x := s.ax
+   /y := s.ay
+   /w := s.aw
+   /h := s.ah
+   resize_Vidget(s, x, y, w, h)
+   VResize(s.draw[1], x, y, w - VSlider_DefWidth - 2, h)
+   VResize(s.draw[2], x + w - VSlider_DefWidth, y, VSlider_DefWidth, h)
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    pane := Vpane_Vlist(win, cb, id, style, aw, ah)
+#    Vpane_Vlist(frame, x, y, win, cb, id, style, aw, ah)
+#
+# DESCRIPTION
+#    Create a specialized Vpane that has been modified to display a list
+#    of strings.
+#
+# INPUTS
+#    frame - (optional) the frame to insert this vidget in
+#    x     - (optional) the x coordinate to insert the vidget at
+#    y     - (optional) the y coordinate to insert the vidget at
+#
+#    These three parameters listed above are optional.  However, they must
+#    all be present if you plan to use them.
+#
+#    win   - the window the vidget will appear in
+#    cb    - the callback procedure to handle events
+#    id    - the id of the vidget
+#    style - which outline style to use: "grooved", "sunken", or "raised"
+#    aw    - (optional) the width of the vidget
+#    ah    - (optional) the height of the vidget
+#
+# OUTPUT
+#    pane  - the Vpane vidget (record)
+
+procedure Vpane_Vlist(params[])
+local self, frame, x, y, ins
+static procs
+
+   initial procs := Vstd(event_Vlist, draw_Vpane_Vlist,
+                        outline_listpane, resize_Vpane,
+                        inrange_Vpane, init_Vpane, couplerset_Vpane)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vpane_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vpane()")
+   if (\self.aw, not numeric(self.aw)) then
+      _Vbomb("invalid aw parameter to Vpane()")
+   if (\self.ah, not numeric(self.ah)) then
+      _Vbomb("invalid ah parameter to Vpane()")
+
+   /self.style := "invisible"
+   if integer(self.style) then
+      if self.style > 0 then
+         self.style := "grooved"
+      else
+         self.style := "invisible"
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   
+   if \ins then VInsert(frame, self, x, y)
+   return self
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    draw_Vpane_Vlist(self)
+#
+# DESCRIPTION
+#    Call the drawlist_Vlist() procedure using the current list and
+#    top line values.
+#
+#    This function is called whenever the vlist is asked to
+#    draw itself.
+#
+# INPUTS
+#    self - the Vpane vidget (record)
+
+procedure draw_Vpane_Vlist(self)
+local dl, tl
+
+   self.V.outline(self)
+
+   dl := storage_Vlist(self.id, "read", "datalist")
+   tl := storage_Vlist(self.id, "read", "top_line")
+   drawlist_Vlist(self, dl, tl)
+
+   return
+
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    event_Vlist(self, e, x, y)
+#
+# DESCRIPTION
+#    Handles events in the Vpane containing the list.  This amounts to
+#    highlighting the line that was selected by the user with the mouse
+#    or by the programmer using VSetState().  Only one line at a time
+#    can be highlighted.  The list vidget callback is not called until
+#    a &lrelease event is detected (releasing the mouse button implies
+#    the user has made a selection).  It also supports dragging the mouse
+#    across the list, highlighting and unhighlighting each line in turn.
+#
+# INPUTS
+#    self - the Vpane vidget record
+#    e    - the event that triggered with callback
+#    x    - the x position of the mouse at the time of the event
+#    y    - the y position of the mouse at the time of the event
+#
+# BUGS
+#    If the vlist is showing a list that is smaller than the actual
+#    area of the list itself, the last line can still be selected
+#    by clicking anywhere in the empty space beneath the last line.
+
+procedure event_Vlist(self, e, x, y)
+   local cb, dl, tl, sl, selectmode, selected, cb_data, cb_items, i, mode
+
+   if e ~=== &lpress then
+      fail				# not our event
+
+   mode := storage_Vlist(self.id, "read", "mode")
+   if mode === V_READONLY then
+      fail				# no events on read-only vidget
+
+   cb := self.callback
+   /y := &y
+   dl := storage_Vlist(self.id, "read", "datalist")
+   tl := storage_Vlist(self.id, "read", "top_line")
+   sl := storage_Vlist(self.id, "read", "selection")
+
+##### Dragging the mouse while holding                               #######
+##### the mouse button down highlights or un-highlights lines        #######
+##### depending on whether the first line clicked on was highlighted #######
+##### or unhighlighted.                                              #######
+
+   selected := vlist_selection(self, y)
+
+##### Handle mouse events for V_SELECT mode.                         #######
+
+   if mode === V_SELECT then {
+
+      /sl := 0
+      if sl = selected then {
+         dl[selected][1] := "N"
+         sl := &null
+         }
+      else {
+         dl[selected][1] := "S"
+         dl[sl][1] := "N"
+         sl := selected
+         }
+      drawlist_Vlist(self, dl, tl)
+
+      while (e := Event(self.win)) ~=== &lrelease do {
+
+         if e ~=== &ldrag then
+            next
+
+         selected := vlist_selection(self, &y)
+
+         /sl := 0
+         if sl = selected then
+            next
+         else {
+            dl[selected][1] := "S"
+            dl[sl][1] := "N"
+            sl := selected
+            drawlist_Vlist(self, dl, tl)
+            }
+
+         }
+
+         storage_Vlist(self.id, "write", "selection", sl)
+
+         if find("coupler", type(\cb)) then {		# coupler
+            if \self.callback.locked then fail
+            return cb.V.set(cb, self) | &null
+            }
+    
+         if type(\cb) == "procedure" then {
+            if dl[selected][1] == "S" then
+               return cb(self, dl[selected][2:0], selected) | &null
+            else 
+               return cb(self, &null, 0) | &null
+            }
+
+         return
+      }
+
+##### Handle mouse events for V_MULTISELECT mode.                    #######
+
+   if dl[selected][1] == "S" then
+      selectmode := "N"
+   else
+      selectmode := "S"
+   dl[selected][1] := selectmode
+   drawlist_Vlist(self, dl, tl)
+
+   while (e := Event(self.win)) ~=== &lrelease do
+      if e === &ldrag then {
+         dl[vlist_selection(self, &y)][1] := selectmode
+         drawlist_Vlist(self, dl, tl)
+         }
+
+   if find("coupler", type(\cb)) then {		# coupler
+      if \self.callback.locked then fail
+      return cb.V.set(cb, self) | &null
+      }
+
+   if type(\cb) == "procedure" then {		# procedure
+      cb_data := []
+      cb_items := []
+      every i := 1 to *dl do
+         if dl[i][1] == "S" then {
+	    put(cb_data, dl[i][2:0])
+	    put(cb_items, i)
+	    }
+      return cb(self, cb_data, cb_items) | &null
+      }
+
+   return
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    vlist_selection(self, y)
+#
+# DESCRIPTION
+#    Determines the item selected by the mouse
+#
+# INPUTS
+#    self - the Vpane vidget record
+#    sval - the y coordinate of an event
+#
+# OUTPUT
+#    the index of the selected line
+
+procedure vlist_selection(self, y)
+   local fh, tl, dl, window_sz, selected
+
+   fh := WAttrib(self.win, "fheight")
+   tl := storage_Vlist(self.id, "read", "top_line")
+   dl := storage_Vlist(self.id, "read", "datalist")
+   window_sz := integer(self.uh / fh) - 1
+
+   selected := tl - 1 + integer((y - self.uy + fh - 2) / fh)
+   selected >:= tl + window_sz
+   selected >:= *dl
+   selected <:= 1
+   selected <:= tl
+   return selected
+end
+
+
+############################################################################
+#
+# PROCEDURE
+#    outline_listpane(self)
+#
+# DESCRIPTION
+#    Draws an outline around the Vpane being used to display the list.
+#
+# INPUTS
+#    self - the Vpane vidget record
+
+procedure outline_listpane(self)
+
+   BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah, -2)
+
+   return
+
+end
diff --git a/ipl/gprocs/vmenu.icn b/ipl/gprocs/vmenu.icn
new file mode 100644
index 0000000..ea23240
--- /dev/null
+++ b/ipl/gprocs/vmenu.icn
@@ -0,0 +1,673 @@
+############################################################################
+#
+#	File:     vmenu.icn
+#
+#	Subject:  Procedures for vidget menus
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#
+#	Vmenu_item
+#	Vmenu_bar_item
+#	Vmenu_frame
+#	Vpull_down_button
+#	Vmenu_set_items
+#	Vmenu_get_items
+#
+#  Utility procedures in this file:
+#	Vsub_menu()
+#	Vmenu_bar()
+#	Vpull_down_pick_menu()
+#	Vpull_down()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vstyle
+#
+############################################################################
+
+link vstyle
+
+############################################################################
+# Vmenu_item
+############################################################################
+record Vmenu_item_rec (win, s, callback, id, aw, ah, menu, ax, ay,
+   uid, P, D, V, style)
+
+procedure Vmenu_item(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(event_Vmenu_item, draw_Vmenu_item, outline_menu_pane,
+                        resize_Vidget, inrange_Vpane, init_Vmenu_item,
+                        couplerset_Vmenu_item)
+   self := Vmenu_item_rec ! params
+   self.uid := Vget_uid()
+   if type(\self.callback) == "Vmenu_frame_rec" then {
+      self.menu := self.callback
+      self.callback := self.menu.callback
+      self.s ||:= " >"
+   }
+
+## Init
+   self.D := Vstd_draw(draw_off_entry, draw_on_entry)
+   self.P := Vstd_pos()
+   self.D.outline := 1
+   self.V := procs
+   self.V.init(self)
+
+   return self
+end
+
+#
+#  A menu item needs to be sized a little smaller than a normal
+#  button, so we steal the 2d init procedure.
+#
+procedure init_Vmenu_item(self)
+   local TW, FH, ascent, descent, basey
+
+   /self.s := ""
+   TW := TextWidth(self.win, self.s)
+   ascent := WAttrib(self.win, "ascent")
+   descent := WAttrib(self.win, "descent")
+   FH := ascent + descent
+   /self.aw := TW + 5
+   /self.ah := FH + 2
+
+   self.aw := 0 < self.aw | 1
+   self.ah := 0 < self.ah | 1
+
+   self.D.basex := (self.aw - TW + 1) / 2
+   basey := 1 + ascent
+   if FH <= 10 then basey := 8
+   self.D.basey := basey
+
+end
+
+procedure draw_Vmenu_item(s)
+   s.D.draw_off(s)
+end
+
+procedure draw_on_entry(s)
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+   BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_off_entry(s)
+   EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+end
+
+procedure couplerset_Vmenu_item(s)
+   s.V.draw(s)
+end
+
+#
+#  This is complicated....  if we drag off to the right while within the
+#  y-range of the menu item, call its submenu *if* one exists.  Else
+#  if there is a release not on the menu item, fall out of loop.  Else
+#  if released on menu item and there is *no* submenu, make a return
+#  value consisting of the id.  Else, continue through loop.
+#
+#  This will take return value of submenu (if successful choice) and pass
+#  it back up to menu bar item.
+#
+procedure event_Vmenu_item(self, e, sub)
+local  rv
+
+   self.D.draw_on(self)
+   (\self.menu).V.resize(self.menu, self.ax+self.aw-4, self.ay)
+   show_Vmenu_frame(\self.menu)
+   rv := V_FAIL
+   repeat {
+      if (\self.menu,
+         (&x >= self.ax+self.aw) & (self.ay <= &y <= self.ay+self.ah)) then {
+         rv := self.menu.F.pick(self.menu, e, 1) | &null
+         if \rv ~=== V_DRAGGING & \rv ~=== V_FAIL then
+            rv :=  (push(\rv, self.uid))
+         }
+
+      else if (\self.menu, e === (&lrelease|&mrelease|&rrelease)) then rv := &null
+      else if e === (&lrelease|&mrelease|&rrelease) then rv :=  [self.uid]
+      else if self.V.inrange(self, &x, &y) then rv := V_DRAGGING
+      if \rv === V_DRAGGING then {
+         e := Event(self.win)
+         if e === "\^s" then
+            until Event(self.win) === (&lpress|&mpress|&rpress) ;
+         rv := V_FAIL
+         }
+      else break
+      }
+   hide_Vmenu_frame(\self.menu)
+   self.D.draw_off(self)
+   if rv === V_FAIL then fail
+   return rv
+end
+
+############################################################################
+# Vmenu_bar_item
+############################################################################
+
+procedure Vmenu_bar_item(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(event_Vmenu_bar_item, draw_Vmenu_item,
+                        outline_menu_pane, resize_Vmenu_bar_item, inrange_Vpane,
+                        null_proc, couplerset_Vmenu_item)
+   self := Vmenu_item_rec ! params
+   self.uid := Vget_uid()
+   if type(\self.menu) ~== "Vmenu_frame_rec" then
+      _Vbomb("Vmenu_bar_item must be created with a Vmenu_frame")
+
+## Init
+   Vset_style(self, V_RECT)
+   self.P := Vstd_pos()
+   self.V := procs
+   self.callback := (\self.menu).callback
+   self.D.init(self)
+
+   return self
+end
+
+#
+#  Resize ourselves, then tell our submenu to resize itself at the
+#  right location.
+#
+procedure resize_Vmenu_bar_item(self, x, y, w, h)
+
+   resize_Vidget(self, x, y, w, h)
+   (\self.menu).V.resize(self.menu, self.ax, self.ay+self.ah)
+end
+
+#
+#  Process events through a loop, grabbing focus:
+#  If release, fall out.  Else, if dragged off bottom, open up submenu.
+#  If dragged any other direction, fall out.
+#
+#  Take return value ( a list) from submenu, and reference callback tables
+#  to call correct callback for submenu choice made.
+#
+procedure event_Vmenu_bar_item(self, e)
+local rv, callback, i, t, labels
+
+   if e ~=== &lpress & e ~=== &mpress & e ~=== &rpress then
+      fail				# not our event
+   self.D.draw_on(self)
+   show_Vmenu_frame(\self.menu)
+   repeat {
+      if e === (&lrelease|&mrelease|&rrelease) then rv := &null
+      else if self.V.inrange(self, &x, &y) then rv := V_DRAGGING
+      else if (self.ax <= &x <= self.ax+self.aw) & (&y >= self.ay+self.ah) then
+         rv := (\self.menu).F.pick(self.menu, e)
+      if \rv === V_DRAGGING then {
+         e := Event(self.win)
+         rv := &null
+         }
+      else break
+   }
+   hide_Vmenu_frame(\self.menu)
+   self.D.draw_off(self)
+   if \rv === V_FAIL then
+      return &null
+   if \rv then {
+      callback := self.callback
+      labels := []
+      every i := !rv do {
+         t := callback[i]
+         callback := t[1]
+         put(labels, t[2])
+      }
+      return (\callback)(self, labels) | labels
+   }
+   return &null
+end
+
+
+############################################################################
+# Vmenu_frame
+############################################################################
+
+record Vmenu_frame_rec(win, callback, aw, ah, id, temp, drawn,
+   lookup, draw, ax, ay, uid, P, F, V)
+
+procedure Vmenu_frame(params[])
+local self
+static procs
+
+   initial {
+      procs := Vstd(event_Vframe, draw_Vframe, outline_menu_pane,
+                   resize_Vframe, inrange_Vpane, null_proc,
+                   couplerset_Vpane, insert_Vmenu_frame, null_proc,
+                   lookup_Vframe, set_abs_Vframe)
+   }
+
+   self := Vmenu_frame_rec ! params
+
+## Init
+   self.uid := Vget_uid()
+   self.V := procs
+   self.F := Vstd_draw()
+   self.F.pick := pick_Vmenu_frame
+   self.F.format := format_Vmenu_frame
+
+   self.P := Vstd_pos()
+   init_Vframe(self)
+   self.callback := table()
+   self.temp := open("vmenu", "g", "canvas=hidden")
+
+   return self
+end
+
+#
+#  Draw beveled, raised outline
+#
+procedure outline_menu_pane(self)
+   BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+end
+
+#
+#  Find minimum bounding encompassing frame.  At the same time, set
+#  children to be flush against left edge.
+#
+procedure format_Vmenu_frame(self, width)
+local maxwidth, child
+
+   maxwidth := \width | Vmin_frame_width(self) + 4
+   every child := !self.lookup do {
+      child.P.w := maxwidth - 4
+   }
+   self.V.resize(self, 0, 0, maxwidth, Vmin_frame_height(self) + 2)
+end
+
+#
+#  Open up menu frame.  Copy window on temporary binding.
+#  Usually invoked by parent menu item.
+#
+procedure show_Vmenu_frame(self)
+
+   WAttrib(self.temp, "width="||(self.aw+10), "height="||(self.ah+10))
+   CopyArea(self.win, self.temp, self.ax, self.ay, self.aw+5, self.ah+5, 0, 0)
+   draw_Vframe(self)
+   self.drawn := 1
+end
+
+#
+#  Hide menu frame.  Copy contents of temporary binding back onto window.
+#  Also invoked by parent menu item.
+#
+procedure hide_Vmenu_frame(self)
+
+   CopyArea(self.temp, self.win, 0, 0, self.aw+5, self.ah+5, self.ax, self.ay)
+   self.drawn := &null
+end
+
+#
+#  Basically the event loop for the menu frame.  Routes events to the
+#  appropriate menu item.
+#
+procedure pick_Vmenu_frame(self, e, sub)
+local  focus, rv
+
+   /e := -1
+   if /self.drawn then
+      show_Vmenu_frame(self)
+   rv :=  V_DRAGGING
+   repeat {
+      focus := self.V.lookup(self, &x, &y) | &null
+      if (e === (&lrelease|&mrelease|&rrelease) & /focus) then fail
+      else if (/sub, &y < self.ay) | (\sub, &x < self.ax) then return V_DRAGGING
+      else if rv := (\focus).V.event(focus, e, sub) then return rv
+      else if (e === "\^s" & /focus) then
+         until Event(self.win) === (&lpress|&mpress|&rpress) ;
+      e := Event(self.win)
+   }
+end
+
+#
+#  Put the entries into the callback table of the frame as such: if the
+#  entry has a submenu, put its callback table and string label in, else
+#  put the callback procedure and string label in.
+#
+procedure insert_Vmenu_frame(self, vid, x, y)
+   local s
+
+   insert_Vframe(self, vid, x, y)
+   s := (type(vid.callback) == "table", vid.s[1:-2]) | vid.s
+   self.callback[\vid.uid] := [vid.callback, s]
+end
+
+############################################################################
+# wrappers for Vsub_menu and Vmwenu_bar
+############################################################################
+
+procedure Vsub_menu(w, p[])
+   local frame, id, name, callback, ypos, item
+
+   Vwin_check(w, "Vsub_menu()")
+
+   frame := Vmenu_frame(w)
+   id := 1
+   ypos := 0
+   while \(name := pop(p)) do {
+      callback := pop(p) | &null
+      if type(\name) ~== "string" & not numeric(name) then
+         _Vbomb("invalid label passed to Vsub_menu()")
+      image(callback) ? { if ="function" then
+         _Vbomb("Icon function" || tab(0) ||
+                "() not allowed as callback from sub_menu item")
+         }
+      item := Vmenu_item(w, name, callback, id)
+      VInsert(frame, item, 2, ypos)
+      id +:= 1
+      ypos +:= item.ah
+   }
+   VFormat(frame)
+   return frame
+end
+
+procedure Vmenu_bar(p[])
+   local parent, x, y, ins, frame, id, name, submenu, xpos, item, win
+
+   if ins := Vinsert_check(p) then {
+      parent := pop(p); x := pop(p); y:= pop(p)
+      }
+   win := pop(p)
+   Vwin_check(win, "Vmenu_bar()")
+
+   frame := Vframe(win)
+   xpos := id := 0
+   while name := pop(p) do {
+      submenu := pop(p) | &null
+      if type(\name) ~== "string" & not numeric(name) then
+         _Vbomb("invalid label passed to Vmenu_bar()")
+      if type(\submenu) ~== "Vmenu_frame_rec" then
+         _Vbomb("invalid menu parameter to Vmenu_bar()")
+      item := Vmenu_bar_item(win, name, , id, , , submenu )
+      VInsert(frame, item, xpos, 0)
+      id +:= 1
+      xpos +:= item.aw
+   }
+   VFormat(frame)
+   frame.V.outline := null_proc
+
+   if \ins then VInsert(parent, frame, x, y)
+
+   return frame
+end
+
+############################################################################
+# Vpull_down_button
+############################################################################
+
+record Vpull_down_button_rec (win, callback, id, sz, pd, data, s, style,
+   aw, ah, ax, ay, abx, uid, P, D, V)
+
+procedure Vpull_down_button(params[])
+local self
+local frame, x, y, ins
+static procs
+
+   initial procs := Vstd(event_Vpull_down_button, draw_Vpull_down_button,
+      outline_menu_pane, resize_Vpull_down_button, inrange_Vpane,
+      init_Vpull_down_button, couplerset_Vpull_down_button,,,,,
+      set_value_Vpull_down_button)
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vpull_down_button_rec ! params
+   self.uid := Vget_uid()
+   if type(self.pd) ~== "Vmenu_frame_rec" then
+      _Vbomb("Vpull_down_button must be created with a Vpull_down")
+   Vset_style(self, V_RECT)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vpull_down_button(self)
+
+   self.s := self.data[1:self.sz|0]
+   self.D.draw_off(self)
+   draw_Vpull_down_button_off(self)
+end
+
+procedure draw_Vpull_down_button_arrow(self)
+local x, y, sz
+
+   x := self.ax+self.abx; y := self.ay; sz := self.ah
+
+   FillPolygon(self.win, x+0.1*sz, y+0.2*sz, x+0.9*sz, y+0.2*sz,
+                x+0.5*sz, y+0.9*sz, x+0.1*sz, y+0.2*sz)
+end
+
+procedure draw_Vpull_down_button_off(self)
+local x, y
+
+   x := self.ax; y := self.ay
+   EraseArea(self.win, x+self.abx+1, y+1, self.aw-self.abx-1, self.ah-1)
+   DrawRectangle(self.win, x+self.abx, y, self.aw-self.abx, self.ah)
+   draw_Vpull_down_button_arrow(self)
+end
+
+procedure draw_Vpull_down_button_on(self)
+
+   FillRectangle(self.win, self.ax+self.abx+1, self.ay+1, self.aw-self.abx, self.ah)
+   WAttrib(self.win, "reverse=on")
+   draw_Vpull_down_button_arrow(self)
+   WAttrib(self.win, "reverse=off")
+end
+
+procedure resize_Vpull_down_button(self, x, y, w, h)
+
+   resize_Vidget(self, x, y, w, h)
+   self.pd.F.format(self.pd, self.aw)
+   self.pd.V.resize(self.pd, self.ax, self.ay+self.ah)
+end
+
+procedure couplerset_Vpull_down_button(self, name, value)
+
+   self.D.draw_off(self)
+end
+
+
+procedure event_Vpull_down_button(self, e)
+local rv
+
+   if \self.callback.locked then fail
+   draw_Vpull_down_button_on(self)
+   show_Vmenu_frame(\self.pd)
+   rv := V_DRAGGING
+   repeat {
+      if \e === (&lrelease|&mrelease|&rrelease) then rv := &null
+      else if self.V.inrange(self, &x, &y) then rv := V_DRAGGING
+      else if (self.ax <= &x <= self.ax+self.aw) & (&y >= self.ay+self.ah) then
+         rv := (\self.pd).F.pick(self.pd, e)
+      if \rv === V_DRAGGING then {
+         e := Event(self.win)
+         rv := &null
+         }
+      else break
+   }
+   if rv === V_FAIL then rv := &null
+   draw_Vpull_down_button_off(self)
+   hide_Vmenu_frame(\self.pd)
+   if \rv then {
+      self.data := self.pd.callback[rv[1]][2]
+      self.V.draw(self)
+      self.callback.V.set(self.callback, self, self.data)
+      return self.data
+      }
+end
+
+procedure set_value_Vpull_down_button(self, value)
+
+   self.data := \value | ""
+end
+
+procedure init_Vpull_down_button(self)
+local p
+
+   /self.data := ""
+   self.s := self.data
+   /self.sz := 24
+   self.aw := WAttrib(self.win, "fwidth")*self.sz + 8
+   self.ah := WAttrib(self.win, "fheight")
+
+   self.abx := self.aw
+# make little arrow box on end.
+   self.aw +:= WAttrib(self.win, "fheight")
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+
+   self.D.init(self)
+   self.D.basex := 4
+end
+
+
+############################################################################
+# Vmenu_set_items(self,data)
+#
+# data is a list of one or more strings, and possibly lists:
+# any string can be followed in the list by a list of data for a submenu
+############################################################################
+
+procedure Vmenu_set_items(self, data)
+   local cb, item
+
+   cb := !!self.lookup[1].callback
+   item := self.lookup[1]
+   item.menu := Vmenu_set_submenu(self.win, data, cb)
+   item.callback := item.menu.callback
+   VResize(self)
+   return
+end
+
+procedure Vmenu_set_submenu(win, data, cbk)
+   local a, c, e, i, lbl
+
+   if type(data) ~== "list" | *data = 0 then
+      _Vbomb("empty or invalid menu list for VSetItems()")
+   data := copy(data)			# make copy to consume and destroy
+
+   a := [win]
+   while *data > 0 do {
+      put(a, string(get(data))) |
+         _Vbomb("invalid menu list entry for VSetItems()")
+      if type(data[1]) == "list" then
+         put(a, Vmenu_set_submenu(win, get(data), cbk))
+      else
+         put(a, cbk)
+      }
+   return Vsub_menu ! a
+end
+
+############################################################################
+# Vmenu_get_items
+############################################################################
+
+procedure Vmenu_get_items(self)
+   return Vmenu_get_submenu(self)[2]
+end
+
+procedure Vmenu_get_submenu(frame)
+   local l, r
+
+   l := list()
+   every r := !frame.lookup do {
+      if /r.menu then
+         put(l, r.s)
+      else {
+         put(l, r.s[1:-2])
+         put(l, Vmenu_get_submenu(\r.menu))
+         }
+      }
+   return l
+end
+
+
+
+############################################################################
+#  Utilities.
+############################################################################
+
+#
+#  Well this is a wrapper for combining a Vpull_down and a
+#  Vpull_down_button.
+#
+#  Vpull_down_pick_menu([frame, x, y, ] w, s, callback, id, size, centered)
+#
+#  s - a list of string labels for the entries.
+#  size - is the number of characters in the data field to be displayed.
+#  centered - non-&null if entries are centered in pull_down.
+#
+procedure Vpull_down_pick_menu(params[])
+local frame, x, y, ins, pd, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   put(params); put(params); put(params); put(params);
+   Vwin_check(params[1], "Vpull_down_pick_menu()")
+   pd := Vpull_down ! (params[1:3] ||| [\params[6] | &null])
+   self := Vpull_down_button ! ([params[1]] ||| params[3:6] ||| [pd])
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  Vpulldown(..) produces a pull-down list, invoked by
+#
+#  obj.F.pick(obj)
+#
+#  returns the string value of the object picked.
+#
+#  p[] is a list of strings to enter into the list;
+#  centered is &null for right justified entries, 1 for centered.
+#
+#  (This procedure does not support the optional VInsert parameters.)
+#
+procedure Vpull_down(win, s, centered)
+local cv, frame, id, name, style, ypos
+local max, i, TW, FH, item, string_list
+
+   Vwin_check(win, "Vpull_down()")
+   if type(s) ~== "list" then
+      _Vbomb("data parameter to Vpull_down must be a list of strings")
+   frame := Vmenu_frame(win)
+   ypos := id := 1
+   if \centered then {
+      max := 0
+      every i := !s do max <:= (TextWidth(win, i) + 6)
+      }
+   string_list := copy(s)
+   while name := pop(string_list) do {
+      name := \name | ""
+      item := Vmenu_item(win, name, , name, max)
+      VInsert(frame, item, 1, ypos)
+      id +:= 1
+      ypos +:= item.ah
+   }
+   VFormat(frame)
+   return frame
+end
diff --git a/ipl/gprocs/vpane.icn b/ipl/gprocs/vpane.icn
new file mode 100644
index 0000000..6257a83
--- /dev/null
+++ b/ipl/gprocs/vpane.icn
@@ -0,0 +1,167 @@
+############################################################################
+#
+#	File:     vpane.icn
+#
+#	Subject:  Procedures for vidget panes
+#
+#	Author:   Jon Lipp
+#
+#	Date:     March 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vpane
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+############################################################################
+#  pane - a simple region on the window
+############################################################################
+
+record Vpane_rec(win, callback, id, style, aw, ah, ax, ay,
+	uw, uh, ux, uy, uid, P, V)
+
+procedure Vpane(params[])
+   local self, frame, x, y, ins
+   static procs
+
+   initial procs := Vstd(event_Vpane, draw_Vpane, outline_Vpane,
+                        resize_Vpane, inrange_Vpane, init_Vpane,
+                        couplerset_Vpane)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vpane_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vpane()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vpane()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vpane()")
+
+   /self.style := "invisible"
+   if integer(self.style) then
+      if self.style > 0 then
+	 self.style := "grooved"
+      else
+	 self.style := "invisible"
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  check if (x, y) lie within the bounds of a vidget.
+#
+procedure inrange_Vpane(self, x, y)
+   if (/self.ax | /self.ay | /self.aw | /self.ah) then
+      _Vbomb("VResize() not invoked on this vidget")
+   return self.ax <= \x < self.ax + self.aw & self.ay <= \y < self.ay + self.ah
+end
+
+#
+#  Set the absolute position and size fields of a vidget.
+#
+procedure resize_Vidget(self, x, y, w, h)
+   self.ax := \x 
+   self.ay := \y
+   self.aw := \w
+   self.ah := \h
+end
+
+#
+#  Set the absolute position and size fields of a Pane vidget.
+#
+procedure resize_Vpane(self, x, y, w, h)
+   local border
+
+   resize_Vidget(self, x, y, w, h)
+   if self.style == "invisible" then
+      border := 0
+   else
+      border := 2
+   self.ux := self.ax + border
+   self.uy := self.ay + border
+   self.uw := self.aw - 2 * border
+   self.uh := self.ah - 2 * border
+end
+
+#
+#  Draw the outline of an arbitrary vidget
+#
+procedure outline_Vidget(self)
+   GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+end
+
+#
+#  Draw the outline of a Vpane vidget
+#
+procedure outline_Vpane(self)
+   case self.style of {
+      "sunken":  BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah,-2)
+      "grooved": GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+      "raised":  BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+   }
+end
+
+#  At the very least, tell a Vpane to outline itself.
+#
+procedure draw_Vpane(self)
+   self.V.outline(self)
+end
+
+#  
+#  If the Vpane has a callback, call (or set) it; otherwise, reject the event.
+#
+procedure event_Vpane(self, e, x, y)
+   local cb
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   cb := self.callback
+   /x := &x
+   /y := &y
+   if type(\cb) == "procedure" then		# procedure
+      return cb(self, e, x, y) | &null
+   if find("coupler",type(\cb)) then {		# coupler
+      if \self.callback.locked then fail
+      return cb.V.set(cb, self) | &null
+      }
+   fail						# reject
+end
+
+#
+#  If the vidget with this procedure as its couplerset is notified by
+#  a coupler, nothing will happen.
+#
+procedure couplerset_Vpane(self)
+end
+
+#
+#  Release the resources associated with the binding on a window.
+#
+procedure destruct_Vpane(self)
+   Uncouple(self.win)
+end
+
+#
+#  No init for Vpane.
+#
+procedure init_Vpane(self)
+end
diff --git a/ipl/gprocs/vquery.icn b/ipl/gprocs/vquery.icn
new file mode 100644
index 0000000..8696153
--- /dev/null
+++ b/ipl/gprocs/vquery.icn
@@ -0,0 +1,194 @@
+############################################################################
+#
+#	File:     vquery.icn
+#
+#	Subject:  Procedures for window queries
+#
+#	Author:   Jon Lipp
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file: Vchoice(), Vinput()
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  vidgets, vbuttons, vtext
+#
+############################################################################
+
+link vidgets
+link vbuttons
+link vtext
+
+procedure Vchoice(str, buttons[])
+local win, root, t, u, w, b, i, x, y, rv
+local button_pos, def_button, old, event
+static wpad, hwpad
+static temp, PAD, WINX, WINY
+initial {
+    temp := open("vchoice", "g", "canvas=hidden")
+    PAD := integer(WAttrib(temp, "fheight") + 10)
+    WINX := integer(WAttrib(temp, "displaywidth") / 2)
+    WINY := integer(WAttrib(temp, "displayheight") / 2)
+
+    wpad := 30
+    hwpad := wpad/2
+}
+
+    if *buttons = 0 then buttons := [" Yes ", " No  "]
+    t := TextWidth(temp, str)
+    u := 0
+    every b := !buttons do
+  	u +:= TextWidth(temp, \b) + 13
+    w := ((u > t, u) | t) + wpad
+
+    win := vquery_open_window("choose", WINX-w/2, WINY-PAD, w, 2*PAD+wpad)
+    root := Vroot_frame(win)
+    VResize(root)
+
+    Vmessage(root, hwpad + (w-wpad-t)/2, hwpad, win, str)
+    x := hwpad + (w-wpad-u)/2; y := -hwpad
+    button_pos := table()
+    every i := 1 to *buttons do {
+	t := Vbutton(root, x, y, win, buttons[i], , i)
+	x +:= t.aw+5
+	button_pos[i] := xywh_rec(t.ax-2, t.ay-2, t.aw+4, t.ah+4)
+    }
+    VDraw(root)
+
+    def_button := 1
+    old := button_pos[def_button]
+    DrawRectangle(win, old.x, old.y, old.w, old.h)
+
+    repeat {
+	rv := &null
+	case event := Event(win) of {
+	-10: next
+	"\r": {
+	    rv := def_button
+	    break
+	}
+	"\t" : {
+            WAttrib(win, "drawop=reverse")
+            DrawRectangle(win, old.x, old.y, old.w, old.h)
+            def_button +:= 1
+	    def_button := (def_button > *buttons, 1)
+            old := button_pos[def_button]
+            WAttrib(win, "drawop=copy")
+            DrawRectangle(win, old.x, old.y, old.w, old.h)
+        }
+	default : {
+	    rv := VEvent(root, event, &x, &y)
+	    (\rv, break)
+	}
+	} # end case
+    }
+    close(win)
+    return rv
+
+end
+record xywh_rec(x, y, w, h)
+
+procedure Vinput(str, def_value)
+local win, root, t, u, w, b, i, x, y, rv
+local buttons, v, input_vidget, ok, cancel
+local button_pos, def_button, old, lrv, event
+static temp, PAD, WINX, WINY, FW, VTEXT_W
+static wpad, hwpad, ID_OK, ID_CANCEL
+initial {
+    temp := WOpen("canvas=hidden")
+    PAD := integer(WAttrib(temp, "fheight") + 10)
+    WINX := integer(WAttrib(temp, "displaywidth") / 2)
+    WINY := integer(WAttrib(temp, "displayheight") / 2)
+    FW := integer(WAttrib(temp, "fwidth"))
+
+    wpad := 30
+    hwpad := wpad/2
+    ID_OK := -11
+    ID_CANCEL := -12
+    VTEXT_W := 20
+}
+
+    /str := ""
+    /def_value := ""
+    buttons := ["  Ok  ", "Cancel"]
+    v := FW * VTEXT_W + 8
+    t := TextWidth(temp, str)
+    u := 0
+    every b := !buttons do
+  	u +:= TextWidth(temp, b) + 13
+    w := vquery_maximum(t, u, v) + wpad
+
+    win := vquery_open_window("choose", WINX-w/2, WINY-PAD, w, 3*PAD+wpad)
+    root := Vroot_frame(win)
+    VResize(root)
+
+    t := Vmessage(root, hwpad + (w-wpad-t)/2, hwpad, win, str)
+    input_vidget := Vtext(root, hwpad+(w-wpad-v)/2, hwpad+t.ah+5, win, "\\="||def_value , , , VTEXT_W)
+    x := hwpad + (w-wpad-u)/2; y := -hwpad
+    ok := Vbutton(root, x, y, win, buttons[1], , ID_OK)
+    x +:= ok.aw+5
+    cancel := Vbutton(root, x, y, win, buttons[2], , ID_CANCEL)
+
+    button_pos := table()
+    button_pos[ID_OK] := xywh_rec(ok.ax-2, ok.ay-2, ok.aw+4, ok.ah+4)
+    button_pos[ID_CANCEL] := xywh_rec(cancel.ax-2, cancel.ay-2, cancel.aw+4, cancel.ah+4)
+
+    VDraw(root)
+    def_button := ID_OK
+    old := button_pos[def_button]
+    DrawRectangle(win, old.x, old.y, old.w, old.h)
+
+    repeat {
+	lrv := rv := &null
+	case event := Event(win) of {
+	-10 : next
+	"\r" : {
+	    rv := def_button
+	    break
+	}
+	"\t": {
+	    WAttrib(win, "drawop=reverse")
+	    DrawRectangle(win, old.x, old.y, old.w, old.h)
+	    def_button := (def_button = ID_OK, ID_CANCEL) | ID_OK
+	    old := button_pos[def_button]
+	    WAttrib(win, "drawop=copy")
+	    DrawRectangle(win, old.x, old.y, old.w, old.h)
+	}
+
+	default: {
+	    lrv := root.V.lookup(root, &x, &y)
+	    /lrv  := input_vidget
+	    rv := (lrv).V.event(lrv, event, &x, &y)
+	    if rv === (ID_OK | ID_CANCEL) then break
+	}
+	} # end case
+    }
+    close(win)
+    return (rv = ID_OK, input_vidget.data) | &null
+
+end
+
+procedure vquery_maximum(l[])
+    return sort(l)[-1]
+end
+procedure vquery_open_window(title, x, y, w, h)
+local win
+
+    /x := 50; /y := 50; /w := 400; /h := 400
+    win := open(title, "g", "pos="||x||","||y, "width="||w, "height="||h) |
+	 _Vbomb("couldn't open window")
+
+    return win
+end
+
diff --git a/ipl/gprocs/vradio.icn b/ipl/gprocs/vradio.icn
new file mode 100644
index 0000000..b49e436
--- /dev/null
+++ b/ipl/gprocs/vradio.icn
@@ -0,0 +1,322 @@
+############################################################################
+#
+#	File:     vradio.icn
+#
+#	Subject:  Procedures for radio buttons
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vradio_entry
+#	Vradio_frame
+#
+#  Utility procedures in this file:
+#	Vradio_buttons()
+#	Vvert_radio_buttons()
+#	Vhoriz_radio_buttons()
+#	init_format_Vrb()
+#	format_Vradio_frame()	
+#
+############################################################################
+
+link vstyle
+
+############################################################################
+# Vradio - the radio button.
+############################################################################
+
+record Vradio_entry_rec (win, s, callback, id, style, aw, ah, don, ax, ay, uid, P, D, V)
+
+#
+# Creation procedure.
+#
+procedure Vradio_entry(params[])
+   local self
+   static procs
+
+   initial procs := Vstd(event_Vradio_entry, draw_Vradio_entry,
+      outline_radio_pane, resize_Vidget, inrange_Vpane, init_Vradio_entry,
+                        couplerset_Vradio_entry)
+   self := Vradio_entry_rec ! params
+   self.uid := Vget_uid()
+   Vset_style(self, self.style)
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure init_Vradio_entry (self)
+   local p
+
+   if /self.callback then 
+      _Vbomb("must pass a coupler variable to a Vradio_entry button")
+   self.D.init(self)
+end
+
+
+#
+#  Draw the frame around the radio buttons.
+#
+procedure outline_radio_pane(self)
+   GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah)
+end
+
+
+#
+#  Draw the radio button.  If coupler's value is this id, draw "on".
+#
+procedure draw_Vradio_entry(self)
+   if self.callback.value === self.id then {
+      self.D.draw_on(self)
+      self.don := 1
+      }
+   else {
+      self.D.draw_off(self)
+      self.don := &null
+      }
+end
+
+#
+#  The coupler notified us, turn "off".
+#
+procedure couplerset_Vradio_entry(self)
+   self.D.draw_off(self)
+   self.don := &null
+end
+
+#
+#  If first time in this button, set coupler, draw "on".
+#  If mouse releases on me, return my own record structure.
+#
+procedure event_Vradio_entry(self, e)
+
+   if self.callback.value ~=== self.id | /self.don then {
+      self.callback.V.set(self.callback, self, self.id)
+      self.D.draw_on(self)
+      self.don := 1
+      }
+   if \e === (&lrelease|&mrelease|&rrelease) then 
+      return self
+end
+
+
+############################################################################
+# Vradio_frame
+############################################################################
+
+record Vradio_frame_rec(win, cv, callback, id, aw, ah, data,
+   lookup, draw, ax, ay, uid, P, V)
+
+#
+# Creation procedure.
+#
+procedure Vradio_frame(params[])
+   local self, p
+   static procs
+
+   initial {
+      procs := Vstd(event_Vradio_frame, draw_Vframe, outline_radio_pane,
+                   resize_Vframe, inrange_Vpane, init_Vframe,
+                   couplerset_Vpane, insert_Vframe, null_proc,
+                   lookup_Vframe, set_abs_Vframe, set_value_Vradio_frame)
+   }
+
+   self := Vradio_frame_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+   
+   return self
+end
+
+#
+#  Distribute mouse event to proper radio button.  If returns
+#  a value, (mouse released) notify callbacks, return text label
+#  of radio button selected.
+#
+procedure event_Vradio_frame(self, e, x, y)
+   local focus, rv
+
+   if \self.callback.locked then fail
+   if e ~=== &lpress & e ~=== &mpress & e ~=== &rpress then fail
+   focus := self.V.lookup(self, x, y)
+   (\focus).V.event(focus, e)
+   repeat {
+      e := Event(self.win)
+      if e === "\^s" then
+         until Event(self.win) === (&lpress|&mpress|&rpress) ;
+      if self.V.inrange(self, &x, &y) then 
+         focus := self.V.lookup(self, &x, &y)
+      if rv := (\focus).V.event(focus, e) then {
+         self.data := rv.s
+         self.callback.V.set(self.callback, rv, rv.s)
+         return rv.s
+      }
+   }
+end
+
+#
+#  Set the radio frame according to string label passed in.  Match with
+#  string label of a button.  Null sets to no button.
+#
+procedure set_value_Vradio_frame(self, value)
+   local old, kid, id, s, k
+
+   if (/value | *value = 0 | value === V_DUMMY_ID) then {
+      kid := &null
+      id := V_DUMMY_ID
+      s := ""
+      }
+   else {
+      kid := self.cv.curr_id
+      id := self.cv.value
+      s := self.data
+      every (k := !self.lookup | fail) do 
+         if value === k.s then {
+            id := k.id
+            kid := k
+            s := value
+            break
+            }
+      }
+
+   old := self.cv.curr_id
+   self.cv.curr_id := kid
+   self.cv.value := id
+   self.data := s
+
+   self.callback.V.set(self.callback, self, self.data)
+
+   (\old).D.draw_off(old)	# clear current button
+   (\kid).D.draw_on(kid)	# set new button
+
+   return
+end
+
+############################################################################
+# Vradio_buttons -
+# Construct radio buttons. Parameters:
+# 	w - window, proc - the callback procedure,
+#	s[] - a list of button labels. 
+############################################################################
+procedure Vradio_buttons(params[])
+   return Vvert_radio_buttons ! params
+end
+
+
+#
+# params: (w, s, callback, id, style)
+#
+procedure Vvert_radio_buttons(params[])
+   local frame, x, y, ins, win, s, callback, id, style
+   local rb_frame, max, cv, i, rb, first, uncentered
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   win := params[1]
+   s := params[2]
+   callback := params[3]
+   id := params[4]
+   style := params[5]
+   uncentered := params[6]
+
+   Vwin_check(win, "Vradio_buttons()")
+   if type(s) ~== "list" then 
+      _Vbomb("data parameter to Vradio_buttons must be a list of strings") 
+   cv := Vmenu_coupler()
+   rb_frame := Vradio_frame(win, cv, callback, id)
+   if /uncentered then {
+      max := 0
+      every i := !s do max <:= TextWidth(win, i)
+      max +:= 8
+      }
+   if \style == (V_CIRCLE | V_CHECK | V_DIAMOND | 
+	 V_CHECK_NO | V_CIRCLE_NO | V_DIAMOND_NO) then
+      max +:= 4 + WAttrib(win, "fheight")
+   every i := 1 to *s do {
+      rb := Vradio_entry(win, s[i], cv, i, style, max)
+      VInsert(rb_frame, rb, 0, (i-1)*rb.ah)
+   }
+
+   init_format_Vrb(rb_frame)
+   format_Vradio_frame(rb_frame)
+
+   if \ins then VInsert(frame, rb_frame, x, y)
+   return rb_frame
+end
+
+procedure Vhoriz_radio_buttons(params[])
+   local frame, x, y, ins, win, s, callback, id, style, hpos
+   local rb_frame, max, cv, i, rb, first
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   win := params[1]
+   s := params[2]
+   callback := params[3]
+   id := params[4]
+   style := params[5]
+
+   Vwin_check(win, "Vradio_buttons()")
+   if type(s) ~== "list" then
+      _Vbomb("data parameter to Vradio_buttons must be a list of strings")
+   cv := Vmenu_coupler()
+   rb_frame := Vradio_frame(win, cv, callback, id)
+   hpos := 0
+   every i := 1 to *s do {
+      rb := Vradio_entry(win, s[i], cv, i, style)
+      VInsert(rb_frame, rb, hpos, 0)
+      hpos +:= rb.aw
+   }
+
+   init_format_Vrb(rb_frame)
+   rb_frame.V.resize(rb_frame, 0, 0, Vmin_frame_width(rb_frame), 
+      Vmin_frame_height(rb_frame))
+
+   if \ins then VInsert(frame, rb_frame, x, y)
+   return rb_frame
+end
+
+#
+#  Set to no radio button selected, format size of frame.
+#	
+procedure init_format_Vrb(rb_frame)
+
+   rb_frame.cv.value :=  V_DUMMY_ID
+   rb_frame.cv.curr_id := &null
+   rb_frame.data := ""
+end
+
+#
+#  Get size of frame based on entries.
+#
+procedure format_Vradio_frame(self, width)
+local maxwidth, child
+
+   maxwidth := \width | Vmin_frame_width(self) + 4
+   every child := !self.lookup do {
+      child.P.w := maxwidth
+   }
+   self.V.resize(self, 0, 0, maxwidth, Vmin_frame_height(self))
+end
diff --git a/ipl/gprocs/vscroll.icn b/ipl/gprocs/vscroll.icn
new file mode 100644
index 0000000..5909bc3
--- /dev/null
+++ b/ipl/gprocs/vscroll.icn
@@ -0,0 +1,671 @@
+############################################################################
+#
+#	File:     vscroll.icn
+#
+#	Subject:  Procedures for scrollbars
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Varrow
+#	Vvthumb
+#	Vhthumb
+#	Vscrollbar_frame
+#
+#  Utility procedures in this file:
+#	Vvert_scrollbar()
+#	Vhoriz_scrollbar()
+#	reformat_Vhthumb()
+#	reformat_Vvthumb()
+#	Vreformat_vscrollbar()
+#	Vreformat_hscrollbar()
+#	VReformat()
+#
+############################################################################
+#
+#  Includes: vdefns.icn
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "vdefns.icn"
+
+############################################################################
+# Varrow
+############################################################################
+
+record Varrow_rec(win, callback, aw, ah, rev, dir, incop, id, ax, ay, r,
+   uid, P, V)
+
+procedure Varrow(params[])
+local frame, x, y, ins, self, init_proc
+
+   init_proc := init_Varrow
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Varrow_rec ! params[1:7|0]
+   self.r := self.aw / 2
+   self.uid := Vget_uid()
+   self.V := Vstd(event_Varrow, draw_Varrow, 1,
+                  resize_Vidget, inrange_Vpane, init_proc,
+                  couplerset_Vpane)
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure event_Varrow(s,e)
+local c, prev, new
+static delay
+
+   initial delay := proc("delay", 0)	# protect attractive name
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      FillTriangle(s.win, s.ax + s.r, s.ay + s.r, s.r - 2, s.dir)
+      BevelTriangle(s.win, s.ax + s.r, s.ay + s.r, s.r, s.dir, -2)
+      s.callback.V.set(s.callback, s, prev := press_Varrow(s))
+      delay(200)
+      while (*Pending(s.win) = 0) |
+	    (Event(s.win) === (&ldrag|&mdrag|&rdrag)) do {
+         new := press_Varrow(s)
+	 if new ~= prev then
+            s.callback.V.set(s.callback, s, prev := new)
+         delay(40)
+         }
+      draw_Varrow(s)
+      return \(s.callback.value)
+      }
+end
+
+procedure draw_Varrow(s)
+   EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   BevelTriangle(s.win, s.ax + s.r, s.ay + s.r, s.r, s.dir)
+end
+
+procedure press_Varrow(s)
+   local v
+   v := s.incop(s.callback.value, s.callback.inc)
+   if abs(v) < abs(s.callback.inc) / 1000000.0 then	# if close to zero
+      v -:= v					# set to zero, preserving type
+   return v
+end
+
+procedure init_Varrow(s)
+   if /s.aw then _Vbomb("must specify a size for a Varrow")
+   if (/s.rev & s.dir == !"se") | (\s.rev & s.dir == !"nw") then
+      s.incop := proc("+", 2)
+   else
+      s.incop := proc("-", 2)
+   s.ah := s.aw
+   s.id := V_ARROW
+end
+
+############################################################################
+# Vvthumb
+############################################################################
+record Vthumb_rec (win, callback, id, aw, ah, win_sz, tot_sz, discont,
+   sp, sw, tw, th, ws, cv_range, pos, rev, frame, drawn, type,
+   ax, ay, uid, P, V)
+
+procedure procs_Vvthumb()
+   static procs
+   initial procs := Vstd(event_Vvthumb, draw_Vvthumb, 1,
+                        resize_Vidget, inrange_Vpane, init_Vvthumb,
+                        couplerset_Vvthumb,,,,,set_value_Vvthumb)
+   return procs
+end
+
+procedure Vvthumb(params[])
+local frame, x, y, ins, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vthumb_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs_Vvthumb()
+   self.P := Vstd_pos()
+   self.type := 1
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  debugging statement--
+#
+# write("draw: val ", val, " cv value ", s.callback.value, " cv min ",
+# s.callback.min, "  ws ", s.ws, "  cv range ", s.cv_range)
+#
+procedure draw_Vvthumb(s)
+   local val
+
+   s.drawn := 1
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+   s.pos := val
+   BevelRectangle(s.win, s.ax, s.ay + val, s.tw, s.th)
+end
+
+procedure event_Vvthumb(s, e)
+local value, offset
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      offset := (s.th + 1) / 2
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&y - offset - s.ay) / (0 ~= s.ws)) * s.cv_range | 0
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.frame.data := s.callback.value
+         update_Vvthumb(s, 1)
+         e := Event(s.win)
+         }
+      update_Vvthumb(s)
+      if \s.discont then
+         s.callback.V.set(s.callback, s, s.callback.value)
+      return \(s.callback.value)
+      }
+end
+
+procedure update_Vvthumb(s, active)
+local val, op, tw, th, sw, sp
+
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+
+   op := s.pos; tw := s.tw; th := s.th
+   sp := s.sp; sw := s.sw
+   EraseArea(s.win, s.ax, s.ay + op, tw, th)
+   if \active then {
+      BevelRectangle(s.win, s.ax, s.ay + val, tw, th, -2)
+      FillRectangle(s.win, s.ax + 2, s.ay + val + 2, tw - 4, th - 4)
+      }
+   else
+      BevelRectangle(s.win, s.ax, s.ay + val, tw, th)
+   s.pos := val
+end
+
+procedure set_value_Vvthumb(s, value)
+   couplerset_Vvthumb(s, , value)
+end
+
+procedure couplerset_Vvthumb(s, caller, value)
+   value := numeric(value) | s.callback.min
+   if (\caller).id === V_ARROW then caller := s
+   else if value === s.callback.value then fail
+   s.frame.data := s.callback.value := value
+   if \s.drawn then
+      update_Vvthumb(s)
+end
+
+procedure init_Vvthumb(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /s.aw | /s.ah then
+      _Vbomb("must specify width and height for Vvthumb")
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vvthumb requires a coupler variable callback")
+   s.sw := 3
+   s.sp:= (s.aw - s.sw) / 2
+   s.tw := s.aw
+   \s.win_sz <:= 0
+   if /s.win_sz then s.th := s.tw
+   else s.th := ( s.tw < 
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.ah) ) |
+                s.tw
+   s.ws := 0 < real(s.ah - s.th) | 0
+   s.cv_range := (0 < s.callback.max - s.callback.min | 1.0)
+
+end
+
+############################################################################
+# Vhthumb
+############################################################################
+
+procedure procs_Vhthumb()
+   static procs
+   initial procs := Vstd(event_Vhthumb, draw_Vhthumb, 1,
+                        resize_Vidget, inrange_Vpane, init_Vhthumb,
+                        couplerset_Vhthumb,,,,,set_value_Vhthumb)
+   return procs
+end
+
+procedure Vhthumb(params[])
+local frame, x, y, ins, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vthumb_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs_Vhthumb()
+   self.P := Vstd_pos()
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure draw_Vhthumb(s)
+   local val
+
+   s.drawn := 1
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+   s.pos := val
+   BevelRectangle(s.win, s.ax + val, s.ay, s.tw, s.th)
+end
+
+procedure event_Vhthumb(s, e)
+local value, offset
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then {
+      offset := (s.tw + 1) / 2
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&x - offset - s.ax)/(0 ~= s.ws)) * s.cv_range | 0
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.frame.data := s.callback.value
+         update_Vhthumb(s, 1)
+         e := Event(s.win)
+         }
+      update_Vhthumb(s)
+      if \s.discont then
+         s.callback.V.set(s.callback, s, s.callback.value)
+      return \(s.callback.value)
+      }
+end
+
+procedure update_Vhthumb(s, active)
+   local val, op, tw, th, sw, sp
+
+   val := integer((s.callback.value - s.callback.min) * s.ws / s.cv_range + 0.5)
+   if \s.rev then
+      val := s.ws - val
+
+   op := s.pos; tw := s.tw; th := s.th
+   sp := s.sp; sw := s.sw
+   EraseArea(s.win, s.ax + op, s.ay, tw, th)
+   if \active then {
+      BevelRectangle(s.win, s.ax + val, s.ay, tw, th, -2)
+      FillRectangle(s.win, s.ax + val + 2, s.ay + 2, tw - 4, th - 4)
+      }
+   else
+      BevelRectangle(s.win, s.ax + val, s.ay, tw, th)
+   s.pos := val
+end
+
+procedure set_value_Vhthumb(s, value)
+   couplerset_Vhthumb(s, s, value)
+end
+
+procedure couplerset_Vhthumb(s, caller, value)
+
+   value := numeric(value) | s.callback.min
+   if (\caller).id === V_ARROW then caller := s
+   else if value === s.callback.value then fail
+   s.frame.data := s.callback.value := value
+   if \s.drawn then
+      update_Vhthumb(s)
+end
+
+procedure init_Vhthumb(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /s.aw | /s.ah then
+      _Vbomb("must specify width and height for Vhthumb")
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vhthumb requires a coupler variable callback")
+   s.sw := 3
+   s.sp := (s.ah - s.sw) / 2
+   s.th := s.ah
+   \s.win_sz <:= 0
+   if /s.win_sz then s.tw := s.th
+   else s.tw := ( s.th < 
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.aw) ) | 
+                s.th
+   s.ws := 0 < real(s.aw - s.tw) | 0
+   s.cv_range := (0 < s.callback.max - s.callback.min | 1.0)
+end
+
+############################################################################
+# Vscrollbar_frame 
+############################################################################
+
+record Vscrollbar_frame_rec(win, callback, id, aw, ah, lookup, draw, uid,
+   data, thumb, ax, ay, P, V)
+
+procedure Vscrollbar_frame(params[])
+local self, procs
+
+   procs := Vstd(event_Vframe, draw_Vframe, outline_Vscrollbar,
+                resize_Vscrollbar, inrange_Vpane, init_Vframe,
+                couplerset_Vpane, insert_Vframe, remove_Vframe,
+                lookup_Vframe, set_abs_Vframe)
+   self := Vscrollbar_frame_rec ! params
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.V.init(self)
+   return self
+end
+
+procedure outline_Vscrollbar(self)
+   BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah, -2)
+end
+
+procedure resize_Vscrollbar(self, x, y, w, h)
+
+   resize_Vframe(self, x, y, w, h)
+
+   if self.aw > self.ah then {
+      if \self.thumb.type then {		# was formerly vertical
+         self.thumb.V := procs_Vhthumb()
+	 self.thumb.type := &null
+	 }
+      VReformat(self, self.aw, self.ah)
+      }
+
+   else {
+      if /self.thumb.type then {		# was formerly horizontal
+         self.thumb.V := procs_Vvthumb()
+	 self.thumb.type := 1
+	 }
+      VReformat(self, self.ah, self.aw)
+      }
+end
+
+#  These are the middle-man procedures between the scrollbar frame 
+#  and the thumb.
+
+procedure couplerset_Vhscrollbar(s, caller, value)
+   couplerset_Vhthumb(s.thumb, caller, value)
+end
+
+procedure set_value_Vhscrollbar(s, value)
+   set_value_Vhthumb(s.thumb, value)
+   return
+end
+
+procedure couplerset_Vvscrollbar(s, caller, value)
+   couplerset_Vvthumb(s.thumb, caller, value)
+end
+
+procedure set_value_Vvscrollbar(s, value)
+   set_value_Vvthumb(s.thumb, value)
+   return
+end
+
+############################################################################
+# Vertical scrollbar 
+############################################################################
+procedure Vvert_scrollbar(params[])
+local frame, x, y, ins, t, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   self :=  Vmake_vscrollbar ! params
+   self.uid := Vget_uid()
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure Vmake_vscrollbar(win, callback, id, length, width, 
+                           min, max, inc, win_sz, discont)
+   local cv, cb, frame, up, down, thumb, tot_sz
+   local r, rev, in_max, odd
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   Vwin_check(win, "Vvert_scrollbar()")
+   if (\win_sz, not numeric(win_sz) | win_sz < 0 ) then
+      _Vbomb("negative or non-numeric window_size parameter to Vvert_scrollbar()")
+   if (\inc, not numeric(inc) | inc  < 0 ) then
+      _Vbomb("negative or non-numeric increment parameter to Vvert_scrollbar()")
+   if (\length, not numeric(length) ) then
+      _Vbomb("invalid length parameter to Vvert_scrollbar()")
+   if (\width, not numeric(width) ) then
+      _Vbomb("invalid width parameter to Vvert_scrollbar()")
+
+   /width := VSlider_DefWidth
+   /length := VSlider_DefLength
+   width <:= VSlider_MinWidth
+   length <:= VSlider_MinAspect * width
+   /min := 0
+   /max := 1.0
+   rev := 1
+   if max < min then { max :=: min; rev := &null }
+   in_max := max
+   max -:= (\win_sz | 0) 
+   max <:= min
+   tot_sz := 0 < abs(in_max-min) | 1
+   r := (type(min|max) == "real", 1)
+   if (not numeric(\inc) ) | /inc then
+      inc := 0.1*abs(max-min)
+   (/r, inc := integer(inc), inc <:= 1)
+
+   cv := Vrange_coupler(min, max, , inc)
+   frame := Vscrollbar_frame(win, cv, id, width, length)
+   Varrow(frame, 2, 2, win, cv, width - 4, width - 4, rev, "n")
+   odd := width % 2
+   thumb := Vvthumb(frame, 2, width - odd, 
+      win, cv, id, width - 4, length - 2 * width + 1 + odd,
+      win_sz, tot_sz, discont)
+   Varrow(frame, 2, length - width + 2, win, cv, width - 4, width - 4, rev, "s")
+
+   thumb.rev := rev
+   cv.V.add_client(cv, thumb)
+   add_clients_Vinit(cv, callback, thumb)
+
+   thumb.frame := frame
+   frame.thumb := thumb
+   frame.V.couplerset := couplerset_Vvscrollbar
+   frame.V.set_value := set_value_Vvscrollbar
+
+   return frame
+end
+
+############################################################################
+# Horizontal scrollbar 
+############################################################################
+procedure Vhoriz_scrollbar(params[])
+local frame, x, y, ins, t, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   self :=  Vmake_hscrollbar ! params
+   self.uid := Vget_uid()
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure Vmake_hscrollbar(win, callback, id, length, width,
+                           min, max, inc, win_sz, discont)
+   local cv, cb, frame, up, down, thumb, tot_sz
+   local r, rev, in_max, odd
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   Vwin_check(win, "Vhoriz_scrollbar().")
+   if (\win_sz, not numeric(win_sz) | win_sz < 0 ) then
+      _Vbomb("negative or non-numeric window_size parameter to Vhoriz_scrollbar()")
+   if (\inc, not numeric(inc) | inc  < 0 ) then
+      _Vbomb("negative or non-numeric increment parameter to Vhoriz_scrollbar()")
+   if (\length, not numeric(length) ) then
+      _Vbomb("invalid length parameter to Vhoriz_scrollbar()")
+   if (\width, not numeric(width) ) then
+      _Vbomb("invalid width parameter to Vhoriz_scrollbar()")
+
+   /width := VSlider_DefWidth
+   /length := VSlider_DefLength
+   width <:= VSlider_MinWidth
+   length <:= VSlider_MinAspect * width
+   /min := 0
+   /max := 1.0
+   if max < min then {max :=: min; rev := 1 }
+   in_max := max
+   max -:= (\win_sz | 0)
+   max <:= min
+   tot_sz := 0 < abs(in_max-min) | 1
+   r := (type(min|max) == "real", 1)
+   if (not numeric(\inc) ) | /inc then
+      inc := 0.1*abs(max-min)
+   (/r, inc := integer(inc), inc <:= 1)
+
+   cv := Vrange_coupler(min, max, , inc)
+   frame := Vscrollbar_frame(win, cv, id, length, width)
+   Varrow(frame, 2, 2, win, cv, width - 4, width - 4, rev, "w")
+   odd := width % 2
+   thumb := Vhthumb(frame, width - odd, 2, 
+      win, cv, id, length - 2 * width + 1 + odd, width - 4,
+      win_sz, tot_sz, discont)
+   Varrow(frame, length - width + 2, 2, win, cv, width-4, width-4, rev, "e")
+
+   thumb.rev := rev
+   cv.V.add_client(cv, thumb)
+   add_clients_Vinit(cv, callback, thumb)
+
+   thumb.frame := frame
+   frame.thumb := thumb
+   frame.V.couplerset := couplerset_Vhscrollbar
+   frame.V.set_value := set_value_Vhscrollbar
+
+   return frame
+end
+
+############################################################################
+# reformatting procedures.  Will just reformat width and length.
+############################################################################
+procedure reformat_Vvthumb(s, length, width)
+
+   s.P.w := s.aw := \width
+   s.P.h := s.ah := \length
+   s.sp := (s.aw - s.sw) / 2
+   s.tw := s.aw
+   if /s.win_sz then s.th := s.tw
+   else s.th := ( s.tw <
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.ah) ) |
+                s.tw-1
+   s.ws := 0 < real(s.ah - s.th - 2) | 0
+end
+
+procedure reformat_Vhthumb(s, length, width)
+
+   s.P.w := s.aw := length
+   s.P.h := s.ah := width
+   s.sp := (s.ah - s.sw) / 2
+   s.th := s.ah
+   if /s.win_sz then s.tw := s.th
+   else s.tw := ( s.th <
+                integer( ((1.0 >= real(s.win_sz)/s.tot_sz) | 1.0)\1 * s.aw) ) |
+                s.th-1
+   s.ws := 0 < real(s.aw - s.tw - 2) | 0
+end
+
+procedure Vreformat_vscrollbar(self, length, width)
+   local up, down, thumb
+
+   /width := self.aw
+   /length := self.ah
+   self.aw := self.P.w := width
+   self.ah := self.P.h := length
+
+   up := self.lookup[1]
+   thumb := self.lookup[2]
+   down := self.lookup[3]
+
+   VRemove(self, up, 1)
+   VRemove(self, thumb, 1)
+   VRemove(self, down, 1)
+
+   up.dir := "n"
+   down.aw := down.ah := up.aw := up.ah :=
+      down.P.w := down.P.h := up.P.w := up.P.h := width
+   down.r := up.r := (width - 4) / 2
+   down.dir := "s"
+
+   reformat_Vvthumb(thumb, length - 2 * width + 2, width - 4)
+   VInsert(self, up, 2, 2)
+   VInsert(self, thumb, 2, width)
+   VInsert(self, down, 2, width + thumb.ah)
+
+end
+
+procedure Vreformat_hscrollbar(self, length, width)
+   local left, right, thumb
+
+   /width := self.ah
+   /length := self.aw
+   self.aw := self.P.w := length
+   self.ah := self.P.h := width
+
+   left := self.lookup[1]
+   thumb := self.lookup[2]
+   right := self.lookup[3]
+
+   VRemove(self, left, 1)
+   VRemove(self, thumb, 1)
+   VRemove(self, right, 1)
+
+   left.dir := "w"
+   left.aw := left.ah := right.aw := right.ah :=
+      left.P.w := left.P.h := right.P.w := right.P.h := width
+   left.r := right.r := (width - 4) / 2
+   right.dir := "e"
+
+   reformat_Vhthumb(thumb, length - 2 * width + 2, width - 4)
+   VInsert(self, left, 2, 2)
+   VInsert(self, thumb, width, 2)
+   VInsert(self, right, width + thumb.aw, 2)
+end
+
+############################################################################
+#  interface procedure for Vreformat
+############################################################################
+procedure VReformat(scrollbar, length, width)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /scrollbar | type(scrollbar) ~== "Vscrollbar_frame_rec" then
+      _Vbomb("invalid scrollbar parameter to VReformat()")
+
+   if \(scrollbar.thumb.type) then
+      Vreformat_vscrollbar(scrollbar, length, width)
+   else 
+      Vreformat_hscrollbar(scrollbar, length, width)
+end
diff --git a/ipl/gprocs/vsetup.icn b/ipl/gprocs/vsetup.icn
new file mode 100644
index 0000000..73d4b3a
--- /dev/null
+++ b/ipl/gprocs/vsetup.icn
@@ -0,0 +1,250 @@
+############################################################################
+#
+#	File:     vsetup.icn
+#
+#	Subject:  Procedures for vidget application setup
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 9, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  vsetup(win, cbk, wlist[]) initializes a set of widgets according to
+#  a list of specifications created by the interface editor VIB.
+#
+#  win can be an existing window, a list of command arguments to be
+#  passed to Window(), null, or omitted.  In the latter three cases
+#  a new window is opened if &window is null.
+#
+#  cbk is a default callback routine to be used when no callback is
+#  specified for a particular vidget.
+#
+#  wlist is a list of specifications; the first must be the Sizer and
+#  the last may be null.  Each specification is itself a list consisting
+#  of a specification string, a callback routine, and an optional list
+#  of additional specifications.  Specification strings vary by vidget
+#  type, but the general form is "ID:type:style:n:x,y,w,h:label".
+#
+#  vsetup returns a table of vidgets indexed by vidget ID.
+#  The root vidget is included with the ID of "root".
+#
+############################################################################
+#
+#  Links:  graphics,
+#          vidgets, vslider, vmenu, vscroll, vtext, vbuttons, vradio, vlist
+#
+############################################################################
+
+link graphics
+link vidgets
+link vslider
+link vmenu
+link vscroll
+link vtext
+link vbuttons
+link vradio
+link vlist
+
+record VS_rec(var, typ, sty, num, x, y, w, h, lbl, cbk, etc)
+
+
+## vsetup(win, cbk, wlist[]) -- set up vidgets and return table of handles
+#
+#  win is an existing window, or a list of command args for Window(), or &null.
+#  cbk is a callback routine to use when a vidget's callback is null.
+#  wlist is a list of vidget specs as constructed by vib (or uix).
+
+procedure vsetup(args[])
+   local r, wlbl, root, vtable, wspec, alist, win, winargs, cbk
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   case type(args[1]) of {		# check for window or arglist argument
+      "window":	win := get(args)
+      "list":	winargs := get(args)
+      "null":	get(args)
+      }
+   /win := &window
+
+   if type(args[1]) ~== "list" then	# check for callback argument
+      cbk := get(args)
+
+   wspec := get(args)			# first spec gives window size
+
+   if /win then {			# if we don't have a window
+      r := VS_crack(wspec) | _Vbomb("bad specification in vsetup")
+      wlbl := ("" ~== r.lbl) |
+         (&progname ? {while tab(upto('/')+1); tab(upto('.')|0)})
+      alist := []
+      put(alist, "width=" || (r.x + r.w))
+      put(alist, "height=" || (r.y + r.h))
+      put(alist, "label=" || wlbl)
+      put(alist, \winargs)
+      win := Window ! alist
+      }
+
+   VSetFont(win)			# set correct text font
+
+   vtable := table()			# make table of handles
+   vtable["root"] := root := Vroot_frame(win)	# insert root frame
+   every r := VS_crack(\!args, cbk) do
+      vtable[r.var] := VS_obj(win, root, r)	# insert other vidgets
+   VResize(root)			# configure and realize vidgets
+   root.id := "root"
+   return vtable			# return table
+end
+
+
+
+## VS_crack(wspec, cbk) -- extract elements of spec and put into record
+#
+#  cbk is a default callback to use if the spec doesn't supply one.
+
+procedure VS_crack(wspec, cbk)
+   local r, f
+
+   r := VS_rec()
+   (get(wspec) | fail) ? { 
+      r.var := tab(upto(':')) | fail;  move(1)
+      r.typ := tab(upto(':')) | fail;  move(1)
+      r.sty := tab(upto(':')) | fail;  move(1)
+      r.num := tab(upto(':')) | fail;  move(1)
+      r.x := tab(upto(',')) | fail;  move(1)
+      r.y := tab(upto(',')) | fail;  move(1)
+      r.w := tab(upto(',')) | fail;  move(1)
+      r.h := tab(upto(':')) | fail;  move(1)
+      r.lbl := tab(0)
+      }
+   r.cbk := \get(wspec) | cbk
+   r.etc := get(wspec)
+   return r
+end
+
+
+
+## VS_obj(win, root, r) -- create vidget depending on type
+
+procedure VS_obj(win, root, r)
+   local obj, gc, p, lo, hi, iv, args
+   static image
+
+   initial image := proc("image", 0)
+
+   case r.typ of {
+      "Label" | "Message": {
+         obj := Vmessage(win, r.lbl)
+         VInsert(root, obj, r.x, r.y, r.w, r.h)
+         obj.id := r.var
+         }
+      "Line": {
+         obj := Vline(win, r.x, r.y, r.w, r.h)
+         obj.id := r.var
+         VInsert(root, obj)
+         }
+      "Rect": {
+         if r.sty == "" then
+            if integer(r.num) > 0 then
+               r.sty := "grooved"
+            else
+               r.sty := "invisible"
+         obj := Vpane(win, r.cbk, r.var, r.sty)
+         VInsert(root, obj, r.x, r.y, r.w, r.h)
+         }
+      "Check": {
+         obj := Vcheckbox(win, r.cbk, r.var, r.w)
+         VInsert(root, obj, r.x, r.y, r.w, r.h)
+         }
+      "Button": {
+         if r.num == "1" then
+            p := Vtoggle
+         else
+            p := Vbutton
+         obj := p(win, r.lbl, r.cbk, r.var, r.sty, r.w, r.h)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Choice": {
+         obj := Vradio_buttons(win, r.etc, r.cbk, r.var, V_DIAMOND_NO)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Slider" | "Scrollbar" : {
+         r.lbl ? {
+            lo := numeric(tab(upto(',')))
+            move(1)
+            hi := numeric(tab(upto(',')))
+            move(1)
+            iv := numeric(tab(0))
+            }
+         if r.num == "" then
+            r.num := &null
+         obj := case (r.sty || r.typ) of {
+            "hSlider":
+               Vhoriz_slider(win, r.cbk, r.var, r.w, r.h, lo, hi, iv, r.num)
+            "vSlider":
+               Vvert_slider(win, r.cbk, r.var, r.h, r.w, hi, lo, iv, r.num)
+            "hScrollbar":
+               Vhoriz_scrollbar(win, r.cbk, r.var, r.w, r.h, lo, hi, , , r.num) 
+            "vScrollbar":
+               Vvert_scrollbar(win, r.cbk, r.var, r.h, r.w, hi, lo, , , r.num)
+            }
+         VSetState(obj, iv)			# needed for scrollbars
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Text": {
+         obj := Vtext(win, r.lbl, r.cbk, r.var, r.num)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "Menu": {
+         obj := Vmenu_bar(win, r.lbl, VS_submenu(win, r.etc, r.cbk))
+         obj.id := obj.lookup[1].id := r.var
+         VInsert(root, obj, r.x, r.y)
+         }
+      "List": {
+         if integer(r.num) > 0 then
+            r.num := 1
+         else
+            r.num := &null
+         obj := Vlist(win, r.cbk, r.var, [], r.num, r.w, r.h, r.sty)
+         VInsert(root, obj, r.x, r.y)
+         }
+      "List": {
+         if integer(r.num) > 0 then
+            r.num := 1
+         else
+            r.num := &null
+         obj := Vlist(win, r.cbk, r.var, [], r.num, r.w, r.h, r.sty)
+         VInsert(root, obj, r.x, r.y)
+         }
+      default: {
+         _Vbomb("unrecognized object in vsetup: " || image(r.typ))
+         fail
+         }
+   }
+   return obj
+end
+
+
+
+## VS_submenu(win, lst, cbk) -- create submenu vidget
+
+procedure VS_submenu(win, lst, cbk)
+   local a, c, lbl
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   a := [win]
+   while *lst > 0 do {
+      put(a, get(lst))
+      if type(lst[1]) == "list" then
+         put(a, VS_submenu(win, get(lst), cbk))
+      else
+         put(a, cbk)
+      }
+   return Vsub_menu ! a
+end
diff --git a/ipl/gprocs/vslider.icn b/ipl/gprocs/vslider.icn
new file mode 100644
index 0000000..5ca6e59
--- /dev/null
+++ b/ipl/gprocs/vslider.icn
@@ -0,0 +1,387 @@
+############################################################################
+#
+#	File:     vslider.icn
+#
+#	Subject:  Procedures for sliders
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     April 1, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vvslider
+#	Vhslider
+#
+#  Utility procedures in this file:
+#	Vvert_slider()
+#	Vhoriz_slider()
+#
+############################################################################
+#
+#  Includes: vdefns.icn
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "vdefns.icn"
+
+record Vslider_rec (win, callback, id, aw, ah, discont,
+   ax, ay, data, pad, ws, cv_range, rev, pos, uid, drawn, P, V)
+
+############################################################################
+# Vvslider
+############################################################################
+
+procedure procs_Vvslider()
+   static procs
+   initial procs := Vstd(event_Vvslider, draw_Vvslider, outline_Vslider,
+                        resize_Vvslider, inrange_Vpane, init_Vvslider,
+                        couplerset_Vvslider,,,,,set_value_Vvslider)
+   return procs
+end
+
+procedure Vvslider(params[])
+   local self
+
+   self := Vslider_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vvert_slider()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid width parameter to Vvert_slider()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid length parameter to Vvert_slider()")
+   
+   self.uid := Vget_uid()
+   self.V := procs_Vvslider()
+   self.P := Vstd_pos()
+
+   self.V.init(self)
+   return self
+end
+
+procedure draw_Vvslider(s)
+local val
+
+   s.drawn := 1
+   s.V.outline(s)
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vvslider_bar(s)
+end
+
+procedure event_Vvslider(s, e)
+local value
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&y - s.ay - s.pad) / s.ws) * s.cv_range
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.data := s.callback.value
+         update_Vvslider(s, 1)
+         e := Event(s.win)
+         }
+   else
+      fail				# not our event
+   if \s.discont then
+      s.callback.V.set(s.callback, s, s.callback.value)
+   update_Vvslider(s)
+   return s.callback.value
+end
+
+procedure update_Vvslider(s, active)
+local val
+
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vvslider_bar(s, active)
+   return s.callback.value
+end
+
+procedure draw_Vvslider_bar(s, active)
+local ww, d
+
+   ww := s.aw - 4
+   EraseArea(s.win, s.ax + 2, s.ay + 2, ww, s.ah - 4)
+   if \active then {
+      d := -1
+      FillRectangle(s.win, s.ax + 4, s.ay + s.pos - ww + 2, ww - 4, 2 * ww - 4)
+      }
+   else
+      d := 1
+   BevelRectangle(s.win, s.ax + 2, s.ay + s.pos - ww, ww, 2 * ww, d)
+   BevelRectangle(s.win, s.ax + 3, s.ay + s.pos, ww - 2, 1 - ww, d)
+   BevelRectangle(s.win, s.ax + 3, s.ay + s.pos, ww - 2, ww - 1, d)
+end
+
+procedure set_value_Vvslider(s, value)
+   couplerset_Vvslider(s, , value)
+   return
+end
+
+procedure couplerset_Vvslider(s, caller, value)
+
+   value := numeric(value) | s.callback.min
+   if s.callback.value === value then fail
+   s.callback.V.set(s.callback, caller, value)
+   s.data := s.callback.value
+   if \s.drawn then
+      update_Vvslider(s)
+end
+
+procedure init_Vvslider(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /s.aw := VSlider_DefWidth
+   /s.ah := VSlider_DefLength
+   s.aw <:= VSlider_MinWidth
+   s.ah <:= VSlider_MinAspect * s.aw
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vvslider requires a coupler variable callback")
+   s.pad := s.aw - 2
+   s.ws := real(s.ah - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+   init_Vpane(s)
+end
+
+procedure resize_Vvslider(s, x, y, w, h)
+
+   resize_Vidget(s, x, y, w, h)
+   if s.aw > s.ah then {
+      s.V := procs_Vhslider()
+      return s.V.resize(s, x, y, w, h)
+      }
+   s.pad := s.aw - 2
+   s.ws := real(s.ah - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+end
+
+
+############################################################################
+# Vhslider 
+############################################################################
+
+procedure procs_Vhslider()
+   static procs
+
+   initial procs := Vstd(event_Vhslider, draw_Vhslider, outline_Vslider,
+                        resize_Vhslider, inrange_Vpane, init_Vhslider,
+                        couplerset_Vhslider,,,,,set_value_Vhslider)
+   return procs
+end
+
+procedure Vhslider(params[])
+   local self
+
+   self := Vslider_rec ! params[1:7|0]
+   self.aw :=: self.ah
+   Vwin_check(self.win, "Vhoriz_slider()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid width parameter to Vhoriz_slider()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid length parameter to Vhoriz_slider()")
+
+   self.uid := Vget_uid()
+   self.V := procs_Vhslider()
+   self.P := Vstd_pos()
+
+   self.V.init(self)
+   return self
+end
+
+procedure draw_Vhslider(s)
+local val
+
+   s.drawn := 1
+   s.V.outline(s)
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vhslider_bar(s)
+end
+
+procedure event_Vhslider(s, e)
+local value
+
+   if \s.callback.locked then fail
+   if e === (&lpress|&mpress|&rpress) then
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         value := ((&x - s.ax - s.pad) / s.ws) * s.cv_range
+         if \s.rev then
+            s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
+         else
+            s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
+         s.data := s.callback.value
+         update_Vhslider(s, 1)
+         e := Event(s.win)
+         }
+   else
+      fail				# not our event
+   if \s.discont then
+      s.callback.V.set(s.callback, s, s.callback.value)
+   update_Vhslider(s)
+   return s.callback.value
+end
+
+procedure update_Vhslider(s, active)
+local val
+
+   val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
+   if \s.rev then
+      val := s.ws - val + s.pad
+   else
+      val +:= s.pad
+   s.pos := val
+   draw_Vhslider_bar(s, active)
+   return s.callback.value
+end
+
+procedure draw_Vhslider_bar(s, active)
+local hh, d
+
+   hh := s.ah - 4
+   EraseArea(s.win, s.ax + 2, s.ay + 2, s.aw - 4, hh)
+   if \active then {
+      d := -1
+      FillRectangle(s.win, s.ax + s.pos - hh + 2, s.ay + 4, 2 * hh - 4, hh - 4)
+      }
+   else
+      d := 1
+   BevelRectangle(s.win, s.ax + s.pos - hh, s.ay + 2, 2 * hh, hh, d)
+   BevelRectangle(s.win, s.ax + s.pos, s.ay + 3, 1 - hh, hh - 2, d)
+   BevelRectangle(s.win, s.ax + s.pos, s.ay + 3, hh - 1, hh - 2, d)
+end
+
+procedure set_value_Vhslider(s, value)
+   couplerset_Vhslider(s, , value)
+   return
+end
+
+procedure couplerset_Vhslider(s, caller, value)
+
+## break a cycle in callbacks by checking value.
+   value := numeric(value) | s.callback.min
+   if s.callback.value === value then fail
+   s.callback.V.set(s.callback, caller, value)
+   s.data := s.callback.value
+   if \s.drawn then
+      update_Vhslider(s)
+end
+
+procedure init_Vhslider(s)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /s.ah := VSlider_DefWidth
+   /s.aw := VSlider_DefLength
+   s.ah <:= VSlider_MinWidth
+   s.aw <:= VSlider_MinAspect * s.ah
+   if /s.callback | type(s.callback) == "procedure" then
+      _Vbomb("Vhslider requires a coupler variable callback")
+   s.pad := s.ah - 2
+   s.ws := real(s.aw - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+   init_Vpane(s)
+end
+
+procedure resize_Vhslider(s, x, y, w, h)
+
+   resize_Vidget(s, x, y, w, h)
+   if s.aw < s.ah then {
+      s.V := procs_Vvslider()
+      return s.V.resize(s, x, y, w, h)
+      }
+   s.pad := s.ah - 2
+   s.ws := real(s.aw - 2 * s.pad)
+   s.cv_range := s.callback.max - s.callback.min
+end
+
+############################################################################
+# Utilities - slider wrapper procedures.
+############################################################################
+
+procedure outline_Vslider(s)
+   BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)	# draw trough
+end
+
+procedure Vmake_slider(slider_type, w, callback, id, length, width,
+                       min, max, init, discontinuous)
+local cv, sl, cb, t
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   /min := 0
+   /max := 1.0
+   if not numeric(min) | not numeric(max) | (\init, not numeric(init)) then
+      _Vbomb("non-numeric min, max, or init parameter passed to Vxxxxx_slider()")
+   if max < min then { min :=: max; t := 1 }
+   cv := Vrange_coupler(min, max, init)
+   sl := slider_type(w, cv, id, width, length, discontinuous)
+   sl.rev := t
+   
+   add_clients_Vinit(cv, callback, sl)
+   return sl
+end
+
+############################################################################
+# Vvert_slider(w, callback, id, width, length, lower_bound, upper_bound,
+#              initial_value) 
+############################################################################
+procedure Vvert_slider(params[])
+local frame, x, y, ins, t, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   params[6] :=: params[7]
+   push(params, Vvslider)
+   self :=  Vmake_slider ! params
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+############################################################################
+# Vhoriz_slider(w, callback, id, width, length, left_bound, right_bound,
+#              initial_value) 
+############################################################################
+procedure Vhoriz_slider(params[])
+local frame, x, y, ins, self
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+
+   push(params, Vhslider)
+   self :=  Vmake_slider ! params
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
diff --git a/ipl/gprocs/vstd.icn b/ipl/gprocs/vstd.icn
new file mode 100644
index 0000000..4365abb
--- /dev/null
+++ b/ipl/gprocs/vstd.icn
@@ -0,0 +1,146 @@
+############################################################################
+#
+#	File:     vstd.icn
+#
+#	Subject:  Procedures for standard lookups
+#
+#	Author:   Jon Lipp
+#
+#	Date:     June 23, 2000
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file:
+#	VInit()
+#	null_proc()
+#	Vget_uid()
+#	_Vbomb()
+#	Vinsert_check()
+#	Vwin_check()
+#
+############################################################################
+
+record Vstd(event, draw, outline, resize, inrange, init, couplerset,
+           insert, remove, lookup, set_abs, set_value )
+
+record Vstd_coupler(set, add_client, init, unset, toggle, eval)
+
+record Vstd_dialog(open_dialog, register, format, unregister, entries, focus,
+   text_entries, text_lu)
+
+#
+#  Used by menus, buttons
+#
+record Vstd_draw(draw_off, draw_on, init, space, CS, CP, outline,
+   basex, basey, pick, format)
+
+#
+#  type is non-null for vertical; &null for horizontal.
+#
+record Vstd_scrollbar(sp, sw, tw, th, ws, cv_range, oldpos, rev, 
+   frame, drawn, type)
+record Vstd_pos(x, y, w, h)
+
+global Vrecset, Vcoupler_recset
+global V_TEXT_PAD, V_NO_RB_FOCUS, V_DRAGGING, V_FAIL
+global V_IMAGE, V_IMAGE_NO, V_RECT, V_2D, V_CHECK, V_CIRCLE, V_DIAMOND, V_XBOX
+global V_RECT_NO, V_2D_NO, V_CHECK_NO, V_CIRCLE_NO, V_DIAMOND_NO, V_XBOX_NO
+global V_CANCEL, V_OK, V_NEXT, V_PREVIOUS
+global V_ARROW, V_COUPLER, V_DUMMY_ID
+
+procedure null_proc()
+end
+
+procedure VInit()
+initial {
+
+#  Define the cset of all allowable vidget record types.
+   Vrecset := set(["Vbutton_rec", "Vcheckbox_rec", 
+      "Vline_rec", "Vdialog_frame_rec", 
+      "Vframe_rec",  "Vmenu_item_rec", 
+      "Vmenu_frame_rec", "Vradio_entry_rec", "Vradio_frame_rec", 
+      "Vpull_down_button_rec", "Vpane_rec", "Varrow_rec",
+      "Vthumb_rec", "Vscrollbar_frame_rec",
+      "Vslider_rec", "Vtext_rec", "Vgrid_rec"])
+
+   Vcoupler_recset := set(["Vcoupler_rec", "Vrange_coupler_rec"])
+
+#  The padding in a Vtext_in between the data outline and the data text.
+   V_TEXT_PAD 		:= 4
+
+#  Used for button styles.
+   V_RECT := V_2D 	:= -690402
+   V_CHECK 		:= -690403
+   V_CIRCLE 		:= -690404
+   V_RECT_NO := V_2D_NO	:= -690406
+   V_CHECK_NO 		:= -690407
+   V_CIRCLE_NO 		:= -690408
+   V_XBOX		:= -690409
+   V_XBOX_NO		:= -690410
+   V_DIAMOND		:= -690411
+   V_DIAMOND_NO		:= -690412
+   V_IMAGE              := -690413
+   V_IMAGE_NO           := -690414
+
+#  Used for communication between a dialog box and its contents.
+   V_CANCEL 		:= -690417
+   V_OK		  	:= -690418
+   V_NEXT		:= -690419
+   V_PREVIOUS		:= -690420
+
+#  Used for telling a radio button frame *not* to turn on a default
+#  selection.
+   V_NO_RB_FOCUS	:= -690421
+
+#  Used in menus.
+   V_DRAGGING		:= -690422
+   V_FAIL		:= -690423
+
+#  Lets a thumb know an arrow called its couplerset.
+   V_ARROW		:= -690424
+   V_COUPLER 		:= -690425
+   V_DUMMY_ID		:= -690426
+}
+
+end
+   
+procedure Vget_uid()
+   static uid
+   initial uid := 0
+
+   uid +:= 1
+   return uid
+end
+
+procedure _Vbomb(str)
+
+   write(&errout, "Vidget error: ", str)
+   runerr(600)
+
+end   
+
+procedure Vinsert_check(p)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(p[1]) ? find("frame") then {
+      if not (numeric(p[2]), numeric(p[3])) then
+         _Vbomb("invalid x or y coordinate to VInsert()")
+      return 1
+   }
+   else fail
+end
+
+procedure Vwin_check(win, caller)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if not (type(win) ? ="window") then
+      _Vbomb("invalid window parameter to "|| caller)
+end
diff --git a/ipl/gprocs/vstyle.icn b/ipl/gprocs/vstyle.icn
new file mode 100644
index 0000000..cf9ad90
--- /dev/null
+++ b/ipl/gprocs/vstyle.icn
@@ -0,0 +1,363 @@
+############################################################################
+#
+#	File:     vstyle.icn
+#
+#	Subject:  Procedures for drawing buttons
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     August 14, 1996
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Utility procedures in this file:
+#	Vset_style()
+#
+############################################################################
+
+link imscolor
+
+procedure Vset_style (vid, style)
+
+   style := integer(style) | case style of {
+      &null:		V_RECT
+      "regular":	V_RECT
+      "regularno":	V_RECT_NO
+      "check":		V_CHECK
+      "checkno":	V_CHECK_NO
+      "circle":		V_CIRCLE
+      "circleno":	V_CIRCLE_NO
+      "diamond":	V_DIAMOND
+      "diamondno":	V_DIAMOND_NO
+      "xbox":		V_XBOX
+      "xboxno":		V_XBOX_NO
+      "image":		V_IMAGE
+      "imageno":	V_IMAGE_NO
+      default:		_Vbomb("invalid style parameter")
+      }
+
+   vid.style := style
+   case style of {
+      V_RECT :
+	 vid.D := Vstd_draw(draw_off_rect, draw_on_rect, init_rect)
+      V_CHECK :
+	 vid.D := Vstd_draw(draw_off_check, draw_on_check, init_check)
+      V_CIRCLE :
+	 vid.D := Vstd_draw(draw_off_circle, draw_on_circle, init_circle)
+      V_DIAMOND:
+	 vid.D := Vstd_draw(draw_off_diamond, draw_on_diamond, init_diamond)
+      V_XBOX :
+	 vid.D := Vstd_draw(draw_off_xbox, draw_on_xbox, init_xbox)
+      V_IMAGE :
+         vid.D := Vstd_draw(draw_off_image, draw_on_image, init_image)
+      V_RECT_NO : {
+         vid.D := Vstd_draw(draw_off_rect, draw_on_rect, init_rect)
+         vid.D.outline := 1
+         }
+      V_CHECK_NO : {
+         vid.D := Vstd_draw(draw_off_check, draw_on_check, init_check)
+         vid.D.outline := 1
+         }
+      V_CIRCLE_NO : {
+         vid.D := Vstd_draw(draw_off_circle, draw_on_circle, init_circle)
+         vid.D.outline := 1
+         }
+      V_DIAMOND_NO: {
+         vid.D := Vstd_draw(draw_off_diamond, draw_on_diamond, init_diamond)
+         vid.D.outline := 1
+         }
+      V_XBOX_NO : {
+	 vid.D := Vstd_draw(draw_off_xbox, draw_on_xbox, init_xbox)
+	 vid.D.outline := 1
+	 }
+      V_IMAGE_NO : {
+         vid.D := Vstd_draw(draw_off_image, draw_on_image, init_image)
+         vid.D.outline := 1  
+         }
+      default: _Vbomb("invalid style parameter")
+      }
+end
+
+
+procedure init_xbox(s)
+   # nothing to do
+end
+
+procedure draw_off_xbox(s)
+   if /s.D.outline then {
+      EraseArea(s.win, s.ax + 2, s.ay + 2, s.aw - 4, s.ah - 4)
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, 2)
+      }
+   else
+      EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_xbox(s)
+   WAttrib(s.win, "linewidth=2")
+   DrawSegment(s.win, s.ax + 4, s.ay + 4, s.ax + s.aw - 4, s.ay + s.ah - 4, 
+      s.ax + s.aw - 4, s.ay + 4, s.ax + 4, s.ay + s.ah - 4)
+   WAttrib(s.win, "linewidth=1")
+   if /s.D.outline then
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)
+end
+
+
+procedure init_rect(s)
+   local TW, FH, ascent, descent
+
+   /s.s := ""
+   TW := TextWidth(s.win, s.s)
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.aw := TW + 8
+   /s.ah := FH + 8
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := (s.aw - TW - 1) / 2
+   s.D.basey := (s.ah - FH) / 2 + ascent
+end
+
+procedure draw_off_rect(s)
+   EraseArea(s.win, s.ax, s.ay, s.aw, s.ah)
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, 2)
+end
+
+procedure draw_on_rect(s)
+   FillRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+   WAttrib(s.win, "reverse=on")
+   GotoXY(s.win, s.ax+s.D.basex, s.ay+s.D.basey)
+   writes(s.win, s.s)
+   WAttrib(s.win, "reverse=off")
+   if /s.D.outline then
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)
+end
+
+
+procedure init_check(s)
+   local FH, ascent, descent
+
+   /s.s := ""
+   s.D.space := 4
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.ah := FH + 8
+   /s.aw := TextWidth(s.win, s.s) + FH + 3*s.D.space
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := FH + 2*s.D.space
+   s.D.basey := (s.ah - FH)/2 + ascent
+
+   s.D.CS := FH
+   s.D.CP := (s.ah-s.D.CS)/2
+end
+
+procedure draw_off_check(s)
+   local sp, cp, cs, ax, ay
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+
+   BevelRectangle(s.win, ax+sp, ay+cp, cs, cs, 2)
+   EraseArea(s.win, ax+sp+2, ay+cp+2, cs-4, cs-4)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_check(s)
+   local sp, cs, cp, ax, ay
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+
+   BevelRectangle(s.win, ax+sp, ay+cp, cs, cs, -2)
+   FillRectangle(s.win, ax+sp+2, ay+cp+2, cs-4, cs-4)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+
+procedure init_circle(s)
+   local FH, ascent, descent
+
+   /s.s := ""
+   s.D.space := 4
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.ah := FH + 8
+   /s.aw := TextWidth(s.win, s.s) + FH + 3*s.D.space
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := FH + 2*s.D.space
+   s.D.basey := (s.ah -FH)/2 + ascent
+
+   s.D.CS := FH + 1
+   s.D.CP := (s.ah-s.D.CS)/2
+end
+
+procedure draw_off_circle(s)
+   local da, ax, ay, r
+
+   da := s.D
+   r := da.CS / 2 - 1
+   ax := s.ax
+   ay := s.ay
+
+   EraseArea(s.win, ax+da.space, ay+da.CP, da.CS, da.CS)
+   BevelCircle(s.win, ax+da.space+r, ay+da.CP+r, r, 2)
+
+   GotoXY(s.win, ax+da.basex, ay+da.basey)
+   writes(s.win, s.s)
+   if /da.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_circle(s)
+   local da, ax, ay, r
+
+   da := s.D
+   da := s.D
+   r := da.CS / 2 - 1
+   ax := s.ax
+   ay := s.ay
+
+   FillCircle(s.win, ax+da.space+r, ay+da.CP+r, r - 1)
+   BevelCircle(s.win, ax+da.space+r, ay+da.CP+r, r, -2)
+
+   GotoXY(s.win, ax+da.basex, ay+da.basey)
+   writes(s.win, s.s)
+   if /da.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+
+procedure init_diamond(s)
+   local FH, ascent, descent
+
+   /s.s := ""
+   s.D.space := 4
+   ascent := WAttrib(s.win, "ascent")
+   descent := WAttrib(s.win, "descent")
+   FH := ascent + descent
+   /s.ah := FH + 8
+   /s.aw := TextWidth(s.win, s.s) + FH + 3*s.D.space
+
+   s.aw := 0 < s.aw | 1
+   s.ah := 0 < s.ah | 1
+
+   s.D.basex := FH + 2*s.D.space
+   s.D.basey := (s.ah - FH)/2 + ascent
+
+   s.D.CS := FH + 1
+   s.D.CP := (s.ah-s.D.CS)/2
+end
+
+procedure draw_off_diamond(s)
+   local sp, cp, cs, ax, ay, r
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+   r := cs / 2
+
+   EraseArea(s.win, ax+sp, ay+cp, cs, cs)
+   BevelDiamond(s.win, ax+sp+r, ay+cp+r, r, 2)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+procedure draw_on_diamond(s)
+   local sp, cs, cp, ax, ay, r
+
+   sp := s.D.space; cp := s.D.CP; cs := s.D.CS
+   ax := s.ax; ay := s.ay
+   r := cs / 2
+
+   BevelDiamond(s.win, ax+sp+r, ay+cp+r, r, -2)
+   FillDiamond(s.win, ax+sp+r, ay+cp+r, r - 2)
+   GotoXY(s.win, ax+s.D.basex, ay+s.D.basey)
+   writes(s.win, s.s)
+   if /s.D.outline then
+      GrooveRectangle(s.win, s.ax, s.ay, s.aw, s.ah)
+end
+
+
+#  undocumented image button code from Lorne Foss & Clint Jeffery, UTSA
+#
+#  If type = V_IMAGE | V_IMAGE_NO, button string is used as image source.
+#  If it contains a comma, it's a DrawImage string.
+#  If not, it's the name of a GIF file in the current directory.
+#  Size is determined by the GIF or DrawImage image.
+
+procedure init_image(s)
+   local imagefile
+ 
+   imagefile := s.s 
+   if string(s.s) then {
+      if not find(",", s.s) then {
+         s.s := WOpen("canvas=hidden","image="||imagefile) |
+            _Vbomb("can't initialize button image from file " || s.s)
+         s.aw := WAttrib(s.s,"width")
+         s.ah := WAttrib(s.s,"height")
+         }
+      else {
+         s.aw := imswidth(s.s)
+         s.ah := imsheight(s.s)
+	 if /s.aw | /s.ah then
+            _Vbomb("illegal DrawImage string for button")
+         }
+      if /s.D.outline then {
+         s.aw +:= 4
+         s.ah +:= 4
+         }
+      }
+end
+
+procedure draw_on_image(s)  
+   draw_image_helper(s, -2, FillRectangle)
+end
+
+procedure draw_off_image(s)
+   draw_image_helper(s, 2, EraseArea)
+end
+
+procedure draw_image_helper(s, bevel, bgproc)
+   local b
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   if /s.D.outline then {
+      BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, bevel)
+      b := abs(bevel)
+      }
+   else
+      b := 0
+
+   if type(s.s) == "window" then
+      CopyArea(s.s, s.win, 0, 0, s.aw, s.ah, s.ax + b, s.ay + b)
+   else {
+      bgproc(s.win, s.ax + b, s.ay + b, s.aw - 2 * b, s.ah - 2 * b)
+      DrawImage(s.win, s.ax + b, s.ay + b, s.s)
+      }
+end
diff --git a/ipl/gprocs/vtext.icn b/ipl/gprocs/vtext.icn
new file mode 100644
index 0000000..abcd173
--- /dev/null
+++ b/ipl/gprocs/vtext.icn
@@ -0,0 +1,479 @@
+############################################################################
+#
+#	File:     vtext.icn
+#
+#	Subject:  Procedures for textual vidgets
+#
+#	Authors:  Jon Lipp and Gregg M. Townsend
+#
+#	Date:     November 4, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Vidgets defined in this file:
+#	Vtext
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Includes:  keysyms
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+$include "keysyms.icn"
+
+$ifndef _X_WINDOW_SYSTEM
+   $define Key_KP_Up Key_Up
+   $define Key_KP_Down Key_Down
+   $define Key_KP_Left Key_Left
+   $define Key_KP_Right Key_Right
+$endif
+
+
+############################################################################
+#  Vtext
+############################################################################
+
+record Vstd_text(draw_cursor, erase_cursor, draw_data, unblock, block,
+   DataPixelSize, MaxPixelSize, NumericData, CursorPos, DataLength,
+   OldCursorPos, CursorOn, ta, tb, dx, dy)
+
+record Vtext_rec (win, s, callback, id, MaxChars, mask, data, uid,
+   ax, ay, aw, ah, T, P, V)
+
+procedure Vtext(params[])
+   local frame, x, y, ins, self
+   static procs, type
+
+   initial {
+       procs := Vstd(event_Vtext, draw_Vtext,
+          outline_Vtext, resize_Vtext, inrange_Vpane, init_Vtext,
+          couplerset_Vtext,,,,, set_value_Vtext)
+      type := proc("type", 0)		# protect attractive name
+      }
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vtext_rec ! params[1:7|0]
+   Vwin_check(self.win, "Vtext()")
+   if (\self.MaxChars, not numeric(self.MaxChars) ) then
+      _Vbomb("invalid size parameter to Vtext()")
+   if type(\self.mask) ~== "cset" then
+      _Vbomb("invalid mask parameter to Vtext()")
+   if type(\self.s) ~== "string" & not numeric(self.s) then
+      _Vbomb("invalid prompt passed to Vtext()")
+
+   self.uid := Vget_uid()
+   self.V := procs
+   self.P := Vstd_pos()
+   self.T := Vstd_text(draw_cursor_Vtext, erase_cursor_Vtext,
+      draw_data_Vtext, unblock_Vtext, block_Vtext)
+   init_Vtext(self)
+
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+#
+#  Initialization
+#
+procedure init_Vtext(self)
+   local p
+
+   /self.s := ""
+   /self.MaxChars := 18
+   self.s ? if self.s := tab(find("\\=")) then ="\\=" & self.data := tab(0)
+   /self.data := ""
+   if *self.data > self.MaxChars then self.data := self.data[1:self.MaxChars]
+   self.T.DataLength := *self.data
+   self.T.MaxPixelSize := WAttrib(self.win, "fwidth")*self.MaxChars
+#   /self.T.MaxPixelSize := 250
+
+## check max length by pixel size.
+#   if TextWidth(self.win, self.data) > self.T.MaxPixelSize then {
+#      t := get_pos_Vtext(self, self.T.MaxPixelSize)
+#      self.data := self.data[1:t]
+#      }
+#   self.T.DataLength := *self.data
+   self.T.DataPixelSize := TextWidth(self.win, self.data)
+
+## size by characters - taken out.
+   /self.mask := &cset
+
+## initialize with cursor at end
+   self.T.ta := self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+## initialize with all data blocked out (selected)
+#  self.T.ta := 1
+#  self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+   self.T.dx := TextWidth (self.win, self.s) + 6
+   self.aw := self.T.dx + self.T.MaxPixelSize + 4
+   self.ah := WAttrib(self.win, "fheight") + 6	# 4 for bevel, 2 for I-bar
+   self.T.dy := self.ah - 3 - WAttrib(self.win, "descent")
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+end
+
+#
+#  Reconfigure the text vidget.
+#
+procedure resize_Vtext(s, x, y, w, h)
+   s.T.dx := TextWidth (s.win, s.s) + 6
+   s.T.DataLength := *s.data
+   s.T.MaxPixelSize := WAttrib(s.win, "fwidth") * s.MaxChars
+   w := s.aw := s.T.dx + s.T.MaxPixelSize + 4
+   h := s.ah := WAttrib(s.win, "fheight") + 6
+   resize_Vidget(s, x, y, w, h)
+end
+
+#
+#  Draw the prompt, the data, outline the data area, then draw
+#  the cursor if it was already on previous to calling this
+#  procedure (happens with dialog boxes and resize events).
+#
+procedure draw_Vtext(self)
+   local t
+
+   t := self.T.CursorOn
+   self.T.CursorOn := &null
+   draw_prompt_Vtext(self)
+   draw_data_Vtext(self)
+   outline_Vtext(self)
+   if \t then draw_cursor_Vtext(self)
+end
+
+#
+#  Outline the data field.
+#
+procedure outline_Vtext(self)
+
+   BevelRectangle(self.win, self.ax+self.T.dx-4, self.ay,
+                  self.aw-(self.T.dx-4), self.ah, -2)
+end
+
+#
+#  Draw the prompt.
+#
+procedure draw_prompt_Vtext(self)
+   GotoXY(self.win, self.ax, self.ay+self.T.dy)
+   writes(self.win, self.s)
+   return
+end
+
+#
+#  Since the cursor is drawn in "reverse" mode, erase it only if it
+#  is "on" upon entering this procedure.
+#
+procedure erase_cursor_Vtext(self)
+   local ocx, cy
+
+   if /self.T.CursorOn then fail
+   ocx :=  self.T.OldCursorPos
+
+## bracket cursor
+   WAttrib(self.win, "drawop=reverse", "linewidth=1")
+   DrawSegment(self.win, \ocx-2, self.ay+2, ocx+2, self.ay+2,
+             ocx, self.ay+3, ocx, self.ay+self.ah-4,
+             ocx-2, self.ay+self.ah-3, ocx+2, self.ay+self.ah-3)
+   WAttrib(self.win, "drawop=copy")
+   self.T.CursorOn := &null
+end
+
+#
+#  Draw the cursor only if it was previously "off" at this location.
+#
+procedure draw_cursor_Vtext(self)
+   local ocx, cx, cy
+
+   if \self.T.CursorOn then fail
+   cx := self.ax+self.T.dx + get_pixel_pos_Vtext(self, self.T.CursorPos) - 1
+## bracket cursor
+   WAttrib(self.win, "drawop=reverse", "linewidth=1")
+   DrawSegment(self.win, cx-2, self.ay+2, cx+2, self.ay+2,
+             cx, self.ay+3, cx, self.ay+self.ah-4,
+             cx-2, self.ay+self.ah-3, cx+2, self.ay+self.ah-3)
+   WAttrib(self.win, "drawop=copy")
+   self.T.OldCursorPos := cx
+   self.T.CursorOn := 1
+end
+
+#
+#  De-block the data (reset ta and tb to CursorPos).
+#
+procedure unblock_Vtext(self)
+   self.T.ta := self.T.CursorPos := self.T.tb
+   draw_data_Vtext(self)
+end
+
+#
+#  Block (select) all the data
+#
+procedure block_Vtext(self)
+   self.T.ta := 1
+   self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+   draw_data_Vtext(self)
+   if self.T.DataLength = 0 then
+      draw_cursor_Vtext(self)
+end
+
+#
+#  Draw the data, reversing that text that lies between ta and tb
+#  fields.
+#
+procedure draw_data_Vtext(self)
+
+#   if self.T.ta = self.T.tb then return
+   erase_cursor_Vtext(self)
+   GotoXY(self.win, self.ax+self.T.dx, self.ay+self.T.dy)
+   if self.T.ta <= self.T.tb then {
+      writes(self.win, self.data[1:self.T.ta])
+      WAttrib(self.win, "reverse=on")
+      writes(self.win, self.data[self.T.ta:self.T.tb])
+      WAttrib(self.win, "reverse=off")
+      writes(self.win, self.data[self.T.tb:0])
+   }
+   else {
+      writes(self.win, self.data[1:self.T.tb])
+      WAttrib(self.win, "reverse=on")
+      writes(self.win, self.data[self.T.tb:self.T.ta])
+      WAttrib(self.win, "reverse=off")
+      writes(self.win, self.data[self.T.ta:0])
+   }
+   EraseArea(self.win, self.ax+self.T.dx+self.T.DataPixelSize, self.ay+2,
+              self.aw-(self.T.dx +self.T.DataPixelSize+1), self.ah-4)
+   return
+end
+
+#
+#  Wow.  Mouse events, block out text, key presses, enter, delete
+#  etcetera stuff.  Call callback if linefeed key or return key
+#  is pressed.
+#
+procedure event_Vtext(self, e, x, y)
+   static ota
+   local otb, rv
+
+   if \self.callback.locked then fail
+   /x := &x; /y := &y
+   self.T.DataLength := *self.data
+   if e === (&lpress|&mpress|&rpress) then {
+      WAttrib(self.win, "pointer=xterm")
+      otb := self.T.ta := self.T.tb := self.T.CursorPos :=
+         get_pos_Vtext(self, &x-(self.ax+self.T.dx))
+      if otb = self.T.DataLength+1 & otb = \ota then
+         self.T.ta := 1
+      draw_data_Vtext(self)
+      draw_cursor_Vtext(self)
+      until e === (&lrelease|&mrelease|&rrelease) do {
+         self.T.tb := get_pos_Vtext(self, &x-(self.ax+self.T.dx))
+         if otb ~= self.T.tb then {
+            draw_data_Vtext(self)
+            self.T.CursorPos := self.T.tb
+            draw_cursor_Vtext(self)
+            otb := self.T.tb
+            }
+         e := Event(self.win)
+         }
+      rv := &null
+      WAttrib(self.win, "pointer=top left arrow")
+      } ## end mouse event loop
+   else if (not &meta) & (not (integer(e) < 0)) then  {
+      ## it's a keypress
+      if rv := case e of {
+         "\^b" | Key_Left | Key_KP_Left:	move_cursor_Vtext(self, -1)
+         "\^f" | Key_Right | Key_KP_Right:	move_cursor_Vtext(self, 1)
+         "\b" | "\d":				delete_left_Vtext(self)
+         "\^k" | "\^u" | "\^x":			delete_line_Vtext(self)
+	 (&shift & "\t") | Key_Up | Key_KP_Up:  return V_PREVIOUS
+         "\t" | Key_Down | Key_KP_Down:		return V_NEXT
+         "\r" | "\l": {
+	    self.callback.V.set(self.callback, self, self.data)
+	    V_NEXT
+	    }
+         default:				insert_char_Vtext(self, e)
+         }
+      then {
+         draw_data_Vtext(self)
+         draw_cursor_Vtext(self)
+         self.T.ta := self.T.tb := self.T.CursorPos
+         }
+      }
+   else
+      fail				# not our event
+
+   ota := self.T.ta
+   return rv
+end
+
+#  Move the cursor one way or another, determine if at bounds.
+#
+procedure move_cursor_Vtext(self, increment)
+   local t
+
+   t := self.T.CursorPos + increment
+   if t < 1 | t > self.T.DataLength+1 then fail
+   self.T.ta := self.T.tb := self.T.CursorPos := t
+   return
+end
+
+#
+#  Blank out the whole data field.
+#
+procedure delete_line_Vtext(self)
+
+   self.data := ""
+   self.T.DataLength := *self.data
+   self.T.DataPixelSize := 0
+   self.T.ta := self.T.tb := self.T.CursorPos := 1
+   return
+end
+
+#
+#  Get the character position based on mouse x coordinate.
+#
+procedure get_pos_Vtext(self, x)
+   local tp, c, i, j
+
+   c := 1
+   i := j := 0
+   while i < x do {
+      j := i
+      i +:= TextWidth(self.win, self.data[c])
+      if (c +:= 1) > self.T.DataLength then break
+   }
+   if x <= ((i + j) / 2) then
+      c -:= 1				# less than halfway into the char
+   if i < x then tp := self.T.DataLength+1
+   else tp := (1 <= c) | 1
+   return tp
+end
+
+#
+#  Get pixel position in data field based on character position.
+#
+procedure get_pixel_pos_Vtext(self, CursorPos)
+   local sum, i
+
+   sum := 1
+   every i := 1 to CursorPos-1 do sum +:= TextWidth(self.win, self.data[i])
+   return sum
+end
+
+#
+#  Insert a character; could replace blocked out text.  Check if
+#  insertion will go over bounds.
+#
+procedure insert_char_Vtext(self, c)
+
+   if *c > 1 then
+      fail				# this isn't a character
+
+   if TextWidth(self.win, c) == 0 then
+      fail				# not displayable
+
+   if (self.T.DataLength - abs(self.T.ta-self.T.tb) + 1) > self.MaxChars |
+      not (c ? any(self.mask)) then fail
+
+   if self.T.ta ~= self.T.tb then
+      change_data_Vtext(self, c)
+   else
+      self.data := self.data[1:self.T.CursorPos] || c ||
+                   self.data[self.T.CursorPos:0]
+   self.T.DataLength := *self.data
+   self.T.DataPixelSize := TextWidth(self.win, self.data)
+   self.T.CursorPos +:= 1
+   return
+end
+
+#
+#  Replace a character at current position.
+#
+procedure change_data_Vtext(self, c)
+   if self.T.tb < self.T.ta then {
+      self.data := self.data[1:self.T.tb] || (\c | "") ||
+                   self.data[self.T.ta:0]
+      self.T.ta := self.T.CursorPos := self.T.tb
+      }
+   else {
+      self.data := self.data[1:self.T.ta] || (\c | "") ||
+                   self.data[self.T.tb:0]
+      self.T.tb := self.T.CursorPos := self.T.ta
+      }
+end
+
+#
+#  Delete the character to the left of the cursor.
+#
+procedure delete_left_Vtext(self)
+   if self.T.ta ~= self.T.tb then {
+      change_data_Vtext(self)
+      self.T.DataPixelSize := TextWidth(self.win, self.data)
+      return
+      }
+   else
+      if self.T.CursorPos > 1 then {
+         self.data := self.data[1:self.T.CursorPos-1] ||
+                      self.data[self.T.CursorPos:0]
+         self.T.DataPixelSize := TextWidth(self.win, self.data)
+         self.T.CursorPos -:= 1
+         return
+         }
+end
+
+#
+#  Set the data field to value passed in.
+#  NOTE: doesn't pass it through mask right now.
+#  Call callback if value if different from internal coupler's
+#  value.
+#
+procedure couplerset_Vtext(self, caller, value)
+   local data
+
+   data := string(\value) | ""
+   self.data := data
+   if *self.data > self.MaxChars then self.data := self.data[1:self.MaxChars]
+   self.T.DataLength := *self.data
+   self.T.DataPixelSize := TextWidth(self.win, self.data)
+
+## initialize with cursor at end
+   self.T.ta := self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+## initialize with all data blocked out (selected)
+#  self.T.ta := 1
+#  self.T.tb := self.T.CursorPos := self.T.DataLength + 1
+
+   draw_data_Vtext(self)
+
+   if numeric(value) then {
+      if value = \self.T.NumericData then fail
+      self.T.NumericData := value
+      }
+   else if data === self.data then fail
+   self.callback.V.set(self.callback, caller, value)
+#   draw_cursor_Vtext(self)
+end
+
+#
+#  Call couplerset to set value.
+#
+procedure set_value_Vtext(self, value)
+   couplerset_Vtext(self, , value)
+   return
+end
diff --git a/ipl/gprocs/wattrib.icn b/ipl/gprocs/wattrib.icn
new file mode 100644
index 0000000..76324e7
--- /dev/null
+++ b/ipl/gprocs/wattrib.icn
@@ -0,0 +1,51 @@
+############################################################################
+#
+#	File:     wattrib.icn
+#
+#	Subject:  Procedures for attributes
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     March 6, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These are "helper" procedures to use in place of WAttrib().
+#
+#  This is a work in progress; at present it only handles fetching
+#  of a few attribute values.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+procedure Width(win)
+
+   /win := &window
+
+   return WAttrib(win, "width")
+
+end
+
+procedure Height(win)
+
+   /win := &window
+
+   return WAttrib(win, "height")
+
+end
+
+procedure LineWidth(win)
+
+   /win := &window
+
+   return WAttrib(win, "linewidth")
+
+end
diff --git a/ipl/gprocs/weavegif.icn b/ipl/gprocs/weavegif.icn
new file mode 100644
index 0000000..97c948f
--- /dev/null
+++ b/ipl/gprocs/weavegif.icn
@@ -0,0 +1,132 @@
+############################################################################
+#
+#	File:     weavegif.icn
+#
+#	Subject:  Procedure to produce a woven image from a draft
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     June 10, 2001
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure produces a woven image from a pattern-form draft, which
+#  is passed to it as it's first argument.  Window attributes may be
+#  passed as a list in the second argument
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics  
+#
+############################################################################
+#
+#  Links: tables, wopen
+#
+############################################################################
+#
+#  Links: wopen
+#
+############################################################################
+
+link wopen
+
+link tables, wopen
+
+procedure weavegif(draft, attribs)	#: create GIF from ISD
+   local x, y, color, treadle, i, j, treadle_list, k
+   local win, treadle_colors, lst, s
+
+   /attribs := []
+
+   /draft.width := *draft.threading
+   /draft.height := *draft.treadling
+
+   put(attribs, "label=" || draft.name, "size=" || draft.width || "," ||
+      draft.height)
+
+   win := (WOpen ! attribs) | {
+      write(&errout, "Cannot open window for woven image.")
+      fail
+      }
+
+   #  Draw warp threads as "background".
+
+   if \draft.color_list then {
+      if *set(draft.warp_colors) = 1 then {		# solid warp ground
+         Fg(draft.color_list[draft.warp_colors[1]])
+         FillRectangle()
+         }
+      every i := 1 to draft.width do {
+         Fg(win, draft.color_list[draft.warp_colors[i]])
+         DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
+         }
+      }
+   else {
+      every i := 1 to draft.width do {
+         Fg(win, draft.warp_colors[i])
+         DrawLine(win, i - 1, 0, i - 1, *draft.treadling - 1)
+         }
+      }
+
+   #  Precompute points at which weft threads are on top.
+
+   treadle_list := list(draft.treadles)
+   
+   every !treadle_list := [win]
+
+   every i := 1 to draft.treadles do {
+      every j := 1 to draft.shafts do
+         if draft.tieup[j, i] == "0" then
+            every k := 1 to *draft.threading do
+               if draft.threading[k] = j then
+                  put(treadle_list[i], k - 1, 0)
+      }
+
+   if \draft.color_list then {
+      treadle_colors := list(*draft.color_list)
+      every !treadle_colors := []
+      every i := 1 to draft.height do {
+         j := draft.weft_colors[i]
+         put(treadle_colors[j], i)
+         }
+      }
+   else {
+      treadle_colors := table()
+      every i := 1 to draft.width do {
+         j := draft.weft_colors[i]
+         /treadle_colors[j] := []
+         put(treadle_colors[j], i)
+         }
+      }
+   
+      #  "Overlay" weft threads.
+   
+   if \draft.color_list then {
+      every i := 1 to *treadle_colors do {
+         Fg(win, draft.color_list[i]) | stop("bogon")
+         every y := !treadle_colors[i] do {
+            WAttrib(win, "dy=" || (y - 1))
+            if *treadle_list[draft.treadling[y]] = 1 then next	# blank pick
+            DrawPoint ! treadle_list[draft.treadling[y]]
+            }
+         }
+      }
+   else {
+      every s := !keylist(treadle_colors) do {
+         Fg(win, s) | stop("bogon")
+         lst := treadle_colors[s]
+         every y := !lst do {
+            WAttrib(win, "dy=" || (y - 1))
+            if *treadle_list[draft.treadling[y]] = 1 then next	# blank pick
+            DrawPoint ! treadle_list[draft.treadling[y]]
+            }
+         }
+      }
+
+   return win
+
+end
diff --git a/ipl/gprocs/wifisd.icn b/ipl/gprocs/wifisd.icn
new file mode 100644
index 0000000..46cb556
--- /dev/null
+++ b/ipl/gprocs/wifisd.icn
@@ -0,0 +1,324 @@
+############################################################################
+#
+#	File:     wifisd.icn
+#
+#	Subject:  Procedure to convert WIF to xencoded ISD
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     April 6, 2002
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure analyzes a Weaving Information File and returns xencoded
+#  ISD.
+#
+#  Information in a WIF that is not necessary for an ISD is ignored.
+#
+#  If there is a liftplan, the symbols in the treadling sequence
+#  correspond to shaft patterns given in the liftplan.  The symbols
+#  for these pattern shafts are implicit and occur in orde to the number
+#  of shaft patterns.
+#
+#  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 WIF.
+#
+#  If there is a liftplan and a treadling with multiple treadles,
+#  the treadling is ignored.
+#
+#  This procedure does not attempt to detect or correct errors in WIFs,
+#  but it does try to work around some common problems.
+#
+############################################################################
+#
+#  Links:  numbers, tieutils, tables, weavutil, xcode
+#
+############################################################################
+
+link numbers
+link tieutils
+link tables
+link weavutil
+link xcode
+
+global data_default
+global data_entries
+global sections
+global wif
+
+procedure wif2isd(file, title)
+   local section, line, i, colors, information_sections, data_sections
+   local color_range, information, data, tieup
+   local lst, x, k, r, g, b, color, opts, j, tie, lift
+   local range, format
+   local color_set, color_tbl, symbols, maxi, colors_in, liftplan
+   local lift_set, lift_list, lifting, lift_table, draft, threads
+
+   /title := "untitled"
+
+   maxi := 0
+   
+   information_sections := [
+      "wif",
+      "contents",
+      "translations",
+      "color palette",
+      "warp symbol palette",
+      "weft symbol palette",
+      "text",
+      "weaving",
+      "warp",
+      "weft",
+      "bitmap image",
+      "bitmap file"
+      ]
+
+   data_sections := [
+      "notes",
+      "liftplan",
+      "color table",
+      "warp symbol table",
+      "weft symbol table",
+      "threading",
+      "warp thickness",
+      "warp thickness zoom",
+      "warp spacing",
+      "warp spacing zoom",
+      "warp colors",
+      "warp symbols",
+      "treadling",
+      "weft thickness",
+      "weft thickness zoom",
+      "weft spacing",
+      "weft spacing zoom",
+      "weft colors",
+      "weft symbols",
+      "bitmap image data",
+      "tieup",
+      "private"
+      ]
+
+   data_default := table()
+   data_entries := table()
+      
+   sections := table()
+   information := table()
+   data := table()
+
+   wif := []
+
+   #  Read WIF into list.
+
+   while line := trim(read(file)) do
+      if *line > 0 then put(wif, line)
+
+   #  Locate sections.
+
+   every i := 1 to *wif do {
+      wif[i] ? {
+         if ="[" then {
+            section := map(tab(upto(']')))
+            sections[section] := i
+            }
+         }
+      }
+
+   #  Process information sections.
+
+   every name := !information_sections do
+      information[name] := info(name)
+
+   #  Set up data information.
+
+   data_entries["tieup"] := (\information["weaving"])["treadles"] # may be bogus
+   data_entries["liftplan"] := (\information["weft"])["threads"] 
+   data_entries["color table"] := (\information["color palette"])["entries"] 
+   data_entries["warp symbol table"] :=
+      (\information["warp symbol palette"])["entries"]
+   data_entries["weft symbol table"] :=
+      (\information["weft symbol palette"])["entries"]
+   data_entries["threading"] := (\information["warp"])["threads"]
+   data_entries["warp colors"] := (\information["warp"])["threads"]
+   data_entries["treadling"] := (\information["weft"])["threads"]
+   data_entries["weft colors"] := (\information["weft"])["threads"]
+
+   data_default["tieup"] := ""
+   data_default["liftplan"] := ""
+   data_default["notes"] := ""
+   data_default["warp colors"] := (\information["warp"])["color"]
+   data_default["weft colors"] := (\information["weft"])["color"]
+   \data_default["warp colors"] ?:= {		# We require index for now.
+       tab(upto(','))
+       }
+   \data_default["weft colors"] ?:= {		# We require index for now.
+       tab(upto(','))
+       }
+      
+
+   #  Process data sections.
+
+   draft := isd()
+
+   every name := !data_sections do
+      data[name] := decode_data(name)
+
+   #  First get colors and encode them.
+
+   draft.color_list := \data["color table"] | ["white", "black"]
+
+   #  Compose draft
+
+   draft.name := title
+
+   draft.shafts := (\information["weaving"])["shafts"] | abort(3)
+   draft.treadles := (\information["weaving"])["treadles"] | abort(3)
+
+   draft.warp_colors := \data["warp colors"]
+
+   draft.weft_colors := \data["weft colors"] | draft.warp_colors
+
+   #  Need to get liftplan, if there is one, before processing treadling.
+   #  Output is later.
+   #
+   #  Note: If the treadling has multiple treadles, we need to handle it
+   #  some other way than we now are.  What we need to do is to create
+   #  a treadling here.
+
+   if draft.liftplan := \data["liftplan"] then {
+      lifting := ""
+      lift_set := set()
+      lift_list := []
+      lift_table := table()
+      k := 0
+      threads := (\information["weft"])["threads"] | abort(3)
+      every i := 1 to threads do {
+         line := repl("0", draft.treadles)
+         if \draft.liftplan[i] then {
+            draft.liftplan[i] ? {
+               while j := tab(upto(',') | 0) do {
+                  if *j > 0 then line[j] := "1"
+                  move(1) | break
+                  }
+               }
+            }
+         if not member(lift_set, line) then {
+            insert(lift_set, line)
+            k +:= 1
+            lift_table[line] := possym(k) | stop("*** masking error")
+            }
+         put(lift_list, line)
+         lifting ||:= lift_table[line]
+         }
+      }
+
+   draft.threading := \data["threading"]
+   draft.shafts := max ! draft.threading	# don't trust information
+
+#  if \lifting then draft.treadling := lifting else
+   draft.treadling := \data["treadling"] | draft.threading
+   draft.treadles := max ! draft.treadling	# don't trust information
+
+   data_entries["tieup"] := draft.treadles	# try to fix bogosity
+
+   data["tieup"] := decode_data("tieup")	# re-do
+
+   if tieup := \data["tieup"] then {
+      tie := ""
+      every i := 1 to draft.treadles do {
+         line := repl("0", draft.shafts)
+         if \tieup[i] then {
+            tieup[i] ? {
+               while j := tab(upto(',') | 0) do {
+                  if *j > 0 then line[j] := "1"
+                  move(1) | break
+                  }
+               }
+            }
+         tie ||:= line			# MAY BE MIS-ORIENTED
+         }
+      }
+
+   draft.tieup := pat2tier(tie2pat(draft.shafts, draft.treadles, tie)).matrix
+
+   #  Now, finally, the liftplan, if any.
+   #
+   #  The lift lines are given in order of occurrence.  The symbols
+   #  used for them in the treadling can be reconstructed and are
+   #  note included here.
+
+   draft.liftplan := \lift_list
+
+   xencode(draft, &output)
+
+end
+
+procedure abort(i)
+
+   stop("*** insufficient information to produce specifications: ", i)
+
+end
+
+procedure info(name)
+   local i, tbl, keyname, keyvalue, line
+   
+   tbl := table()
+   
+   i := \sections[name] | fail
+   
+   repeat {
+     i +:= 1
+     line := wif[i] | return tbl
+     line ? {
+        {
+           keyname := map(tab(upto('='))) &
+           move(1) &
+           keyvalue := trim(tab(upto(';') | 0))
+           } | return tbl
+        tbl[keyname] := keyvalue
+        } | return tbl
+     }
+
+end
+
+procedure decode_data(name)
+   local i, lst, keyname, keyvalue, line, size, value
+   
+   i := \sections[name] | fail
+   
+   value := \data_default[name]
+   
+   if size := \data_entries[name] then lst := list(size, value)
+   else lst := []
+   
+   repeat {
+     i +:= 1
+     line := wif[i] | return lst
+     line ? {
+        {
+           keyname := integer(tab(upto('='))) | return lst
+           move(1)
+           keyvalue := trim(tab(upto(';') | 0))
+           keyvalue := integer(keyvalue)	# in case
+           if *keyvalue = 0 then {
+              keyvalue := value
+              if /keyvalue then {
+                  write(&errout, "name=", name)
+                  stop("*** no default where needed")
+                  }
+              }
+           }
+        if /size then put(lst, keyvalue) else lst[keyname] := keyvalue
+        }
+     }
+   
+end
diff --git a/ipl/gprocs/win.icn b/ipl/gprocs/win.icn
new file mode 100644
index 0000000..66b24f5
--- /dev/null
+++ b/ipl/gprocs/win.icn
@@ -0,0 +1,54 @@
+############################################################################
+#
+#	File:     win.icn
+#
+#	Subject:  Procedures to open bare-bones window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures are provided as quick-and-dirty ways to get a
+#  nominal window as, for example, when testing.
+#
+#  win() causes error termination if a window can't be opened.
+#  winf(), on the other hand, just fails.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  wopen
+#
+############################################################################
+
+link wopen
+
+procedure win(width, height)
+
+   /width := 500
+   /height := 500
+
+   return WOpen("size=" || width || "," || height) |
+      stop("*** can't open window")
+
+   return
+
+end
+
+procedure winf(width, height)
+
+   /width := 500
+   /height := 500
+
+   return WOpen("size=" || width || "," || height) | fail
+
+end
diff --git a/ipl/gprocs/window.icn b/ipl/gprocs/window.icn
new file mode 100644
index 0000000..9526060
--- /dev/null
+++ b/ipl/gprocs/window.icn
@@ -0,0 +1,380 @@
+############################################################################
+#
+#	File:     window.icn
+#
+#	Subject:  Procedure for opening window
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     October 10, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Window() opens a window with provisions for option processing and
+#  error handling.  The returned window is assigned to &window if
+#  &window is null.  If the window cannot be opened, the program is
+#  aborted.
+#
+#  The characteristics of the window are set from several sources:
+#  Window's arguments, optionally including the program argument list;
+#  user defaults; and built-in defaults.  These built-in defaults are
+#  the same as for optwindow(): bg=pale gray, fg=black, size=500,300.
+#
+############################################################################
+#
+#  With one exception, arguments to Window() are attribute specifications
+#  such as those used with open() and WAttrib().  Order is significant,
+#  with later attributes overriding earlier ones.
+#
+#  Additionally, the program argument list -- the single argument passed
+#  to the main procedure -- can be passed as an argument to Window().
+#  Options specified with a capital letter are removed from the list and
+#  interpreted as attribute specifications, again in a manner consistent
+#  with optwindow().
+#
+#  Because the Window() arguments are processed in order, attributes that
+#  appear before the program arglist can be overridden by command-line
+#  options when the program is executed.  If attributes appear after the
+#  program arglist, they cannot be overridden.  For example, with
+#
+#	procedure main(args)
+#	Window("size=600,400", "fg=yellow", args, "bg=black")
+#
+#  the program user can change the size and foreground color
+#  but not the background color.
+#
+#  User defaults are applied at the point where the program arglist appears
+#  (and before processing the arglist).  If no arglist is supplied, no
+#  defaults are applied.  Defaults are obtained by calling WDefault().
+#  Icon attribute names are used as option names;  &progname is used
+#  as the program name after trimming directories and extensions.
+#
+#  The following table lists the options recognized in the program arglist,
+#  the corresponding attribute (and WDefault()) names, the default values
+#  if any, and the meanings.  All legal attributes are allowed in the
+#  Window() call, but only these are set from the command line or
+#  environment:
+#
+#	arg	attribute	default		meaning
+#	---	---------	-------		--------------------------
+#	-B	bg		pale gray	background color
+#	-F	fg		black		foreground color
+#	-T	font		 -		text font
+#	-L	label		&progname	window title
+#				(trimmed)
+#
+#	-D	display		 -		window device
+#	-X	posx		 -		horizontal position
+#	-Y	posy		 -		vertical position
+#	-W	width		500		window width
+#	-H	height		300		window height
+#
+#	-S	size		500,300		size
+#	-P	pos		 -		position
+#	-G	geometry	 -		window size and/or position
+#
+#	-A	<any>		 -		use "-A name=value"
+#						to set arbitrary attribute
+#
+#	-!	 -		 -		write open() params to &error
+#						(for debugging)
+#
+############################################################################
+#
+#  Includes:  vdefns
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+$include "vdefns.icn"
+
+global wdw_debug			# non-null if to trace open call
+
+
+#  Window(att, ..., arglist, ..., att) -- open window and set &window
+
+procedure Window(args[])
+   local cs, pname, att, omit1, omit2, name, val, a, win
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+
+   wdw_debug := &null
+   att := table()
+
+   # Trim &progname for use as option index and window label.
+   cs := &cset -- &letters -- &digits -- '.$_'
+   &progname ? {
+      while tab(upto(cs)) do
+         move(1)
+      pname := tab(upto('.') | 0)
+   }
+   if pname == "" then
+      pname := &progname
+
+   # Process arguments.
+   every a := !args do
+      case type(a) of {
+         "string": a ? {
+            name := tab(upto("=")) | runerr(205, a)
+            move(1)
+            val := tab(0)
+            wdw_register(att, name, val)
+            }
+         "list": {
+            wdw_defaults(att, a, pname)
+            wdw_options(att, a)
+            }
+         default:
+            runerr(110, a)
+         }
+
+   # Set defaults for certain attributes if not set earlier.
+   /att["fg"] := "black"
+   /att["bg"] := VBackground
+   /att["label"] := pname
+
+   if /att["image"] & not (att["canvas"] === "maximal") then {	# don't override
+      /att["width"] := 500
+      /att["height"] := 300
+      }
+
+   # Open the window.  Defer "font" and "fg" until later because they can
+   # cause failure.  Don't defer "bg", because it affects the initial
+   # window appearance, but try again without it if the open fails.
+   omit1 := set(["fg", "font"])
+   omit2 := set(["fg", "font", "bg"])
+   win := wdw_open(att, omit1 | omit2) | stop(&progname, ": can't open window")
+
+   # Set foreground, background, and font, giving a nonfatal message if
+   # the value is unacceptable.  Then return the window.
+   wdw_attrib(win, att, "fg")
+   wdw_attrib(win, att, "bg")
+   wdw_attrib(win, att, "font")
+   GotoRC(win, 1, 1)			# now that font has been set
+   /&window := win
+   return win
+end
+
+
+#  wdw_defaults(att, arglist, pname) -- find defaults and store in att table
+#
+#  arglist is checked for "-D displayname", which is honored if present.
+#  pname is the program name for calling xdefault.
+#  A list of several attribute names (see code) is checked.
+
+procedure wdw_defaults(att, arglist, pname)
+   local w, oname, dpy
+
+   # We need to have a window in order to read defaults, and unless we honor
+   # the -D option from the command line here it becomes pretty useless.
+   dpy := ("display=" || wdw_peekopt(arglist, "D")) | "fg=black"
+
+   # Open an offscreen window.
+   w := open("Window()", "g", "canvas=hidden", "size=32,32", dpy) |
+      stop(&progname, ": can't open display")
+
+   # Set attributes from environment.  Order is significant here:
+   # pos & size override geometry, and posx/posy/width/height override both.
+   every oname := "display" | "bg" | "fg" | "font" | "windowlabel" | "label" |
+         "geometry" | "size" | "pos" | "posx" | "posy" | "width" | "height" do
+      wdw_register(att, oname, WDefault(w, pname, oname))
+
+   # Delete the offscreen window, and return.
+   Uncouple(w)
+   return
+end
+
+
+#  wdw_peekopt(arglist, ch) -- return value of option 'ch' from arglist
+#
+#  Option cracking rules are identical with wdw_options().
+#  Fails if the option does not appear.
+
+procedure wdw_peekopt(arglist, ch)
+   local a, opt, val
+
+   arglist := copy(arglist)
+   while a := get(arglist) do a ? {
+      if ="-" & (opt := tab(any(&ucase))) then {
+         if pos(0) then
+            val := get(arglist) | fail
+         else
+            val := tab(0)
+         if opt == ch then
+            return val
+         }
+      }
+   fail
+end
+
+
+#  wdw_options(att, arglist) - move options from arglist into att table
+#
+#  Upper-case options in the argument list are stored in the table "att"
+#  under their attribute names (see code for list).  An "option" is a list
+#  entry beginning with "-" and an option letter; its value follows in the
+#  same string (if more characters remain) or in the next entry.
+#
+#  This procedure can be "fooled" if a non-upper-case option is followed
+#  in the next entry by a value that looks like the start of an option.
+#
+#  Options and values are removed from arglist, leaving only the unprocessed
+#  entries.
+#
+#  The special option "-!" takes no value and causes wdw_debug to be set.
+
+procedure wdw_options(att, arglist)
+   local a, opt, name, val, rejects
+
+   rejects := []
+   while a := get(arglist) do a ? {
+      if ="-" & (opt := tab(any(&ucase))) then {
+         if pos(0) then
+            val := get(arglist) | stop(&progname, ": missing value for ", a)
+         else
+            val := tab(0)
+         case opt of {
+            "B":  wdw_register(att, "bg", val)
+            "F":  wdw_register(att, "fg", val)
+            "T":  wdw_register(att, "font", val)
+            "L":  wdw_register(att, "label", val)
+            "D":  wdw_register(att, "display", val)
+            "X":  wdw_register(att, "posx", val)
+            "Y":  wdw_register(att, "posy", val)
+            "W":  wdw_register(att, "width", val)
+            "H":  wdw_register(att, "height", val)
+            "P":  wdw_register(att, "pos", val)
+            "S":  wdw_register(att, "size", val)
+            "G":  wdw_register(att, "geometry", val)
+            "A":  val ? {
+               name := tab(upto("=")) |
+                  stop(&progname, ": malformed -A option: ", val)
+               move(1)
+               wdw_register(att, name, tab(0))
+               }
+            default:  stop(&progname, ": unrecognized option -", opt)
+            }
+         }
+      else if ="-!" & pos(0) then
+         wdw_debug := 1
+      else
+         put(rejects, a)
+      }
+
+   # Arglist is now empty; put back args that we didn't use.
+   while put(arglist, get(rejects))
+   return
+end
+
+
+
+#  wdw_register(att, name, val) -- store attribute val in att[name]
+#
+#  The compound attributes "pos", "size",  and "geometry" are broken down
+#  into their component parts and stored as multiple values.  A runtime
+#  error occurs if any of these is malformed.  Interactions with
+#  "canvas=maximal" are also handled.
+
+procedure wdw_register(att, name, val)
+   wdw_reg(att, name, val) | runerr(205, name || "=" || val)
+   return
+end
+
+procedure wdw_reg(att, name, val)
+   case name of {
+      "size": val ? {		# size=www,hhh
+         att["width"] := tab(many(&digits)) | fail
+         ="," | fail
+         att["height"] := tab(many(&digits)) | fail
+         pos(0) | fail
+         if \att["canvas"] == "maximal" then
+            delete(att, "canvas")
+         }
+      "pos": val ? {		# pos=xxx,yyy
+         att["posx"] := tab(many(&digits)) | fail
+         ="," | fail
+         att["posy"] := tab(many(&digits)) | fail
+         pos(0) | fail
+         }
+      "geometry": val ? {	# geometry=[wwwxhhh][+xxx+yyy]
+         if att["width"] := tab(many(&digits))
+         then {
+            ="x" | fail
+            att["height"] := tab(many(&digits)) | fail
+            if \att["canvas"] == "maximal" then
+               delete(att, "canvas")
+            }
+         if ="+" then {
+            att["posx"] := tab(many(&digits)) | fail
+            ="+" | fail
+            att["posy"] := tab(many(&digits)) | fail
+            }
+         pos(0) | fail
+         }
+      "canvas": {
+         att[name] := val
+         if val == "maximal" then
+            every delete(att, "width" | "height")
+         }
+      default: {
+         att[name] := val
+         }
+      }
+   return
+end
+
+
+#  wdw_open(att, omit) -- open window with attributes from att table
+#
+#  Ignore null or empty attributes and those in the "omit" set.
+#  Trace open call if wdw_debug is set.  Set &window.
+
+procedure wdw_open(att, omit)
+   local args, name
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   args := [&progname, "g"]
+   every name := key(att) do
+      if not member(omit, name) then
+         put(args, name || "=" || ("" ~== \att[name]))
+
+   if \wdw_debug then {
+      writes(&errout, "Window: open(", image(args[1]))
+      every writes(&errout, ",", image(args[2 to *args]))
+      write(&errout, ")")
+      }
+
+   return open ! args
+end
+
+
+#  wdw_attrib(win, att, name) -- call WAttrib(win, name=att[name])
+#
+#  Null and empty values are ignored.
+#  Failure is diagnosed on stderr.
+#  The call is traced if wdw_debug is set.
+
+procedure wdw_attrib(win, att, name)
+   local val, s
+   static image
+
+   initial image := proc("image", 0)	# protect attractive name
+
+   val := ("" ~== \att[name]) | return
+   s := name || "=" || val
+   if \wdw_debug then
+      write(&errout, "Window: WAttrib(", image(s), ")")
+   WAttrib(win, s) | write(&errout, &progname, ": can't set ", s)
+   return
+end
diff --git a/ipl/gprocs/winsnap.icn b/ipl/gprocs/winsnap.icn
new file mode 100644
index 0000000..b7ef5fe
--- /dev/null
+++ b/ipl/gprocs/winsnap.icn
@@ -0,0 +1,62 @@
+############################################################################
+#
+#	File:     winsnap.icn
+#
+#	Subject:  Procedure to take snapshot of a portion of a window
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This procedure writes an image file for a specified portion of a
+#  window.  The name for the file is requested from the user via a
+#  dialog box.  If there already is a file by the specified name, the
+#  user is given the option of overwriting it or selecting another
+#  name.  The procedure fails if the user cancels.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  graphics
+#
+############################################################################
+
+link graphics
+
+procedure winsnap(win, x, y, w, h)
+   local name, f
+
+   if type(win) ~== "window" then {
+      win :=: x :=: y :=: w :=: h
+      win := \&window | runerr(140, &window)
+      }
+
+   repeat {
+      if OpenDialog("Image file name") == "Okay" then {
+         name := dialog_value
+         if f := open(name) then {
+            close(f)
+            if Dialog("Overwrite existing file?", , , ,
+               ["Okay", "Cancel"]) == "Cancel" then next
+            }
+         WriteImage(win, name, x, y, w, h) | {
+            Notice("Cannot write image")
+            fail
+            }
+         return
+         }
+      else fail
+      }
+      
+   return
+
+end
diff --git a/ipl/gprocs/wipe.icn b/ipl/gprocs/wipe.icn
new file mode 100644
index 0000000..8f2d866
--- /dev/null
+++ b/ipl/gprocs/wipe.icn
@@ -0,0 +1,112 @@
+############################################################################
+#
+#	File:     wipe.icn
+#
+#	Subject:  Procedure to wipe window area
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  wipe(window, color, direction, x, y, w, h)  "wipes" a rectangular area of
+#  window to the specified color.  The direction of wiping can be any one of:
+#
+#	"right"		from left to right
+#	"left"		from right to left
+#	"down"		from top to bottom
+#	"up		from bottom to top
+#	"left-right"	from left and right toward center
+#	"up-down"	from top and bottom toward center
+#	"in"		from outside to inside
+#
+#  The default direction is "right".
+#
+#  The default color is the background color of the window.
+#
+#  x, y is the top left corner of the area and w and h are the width and
+#  height. An omitted value defaults to the one for the entire window.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+procedure wipe(window, color, direction, x1, y1, w, h)
+   local x, y, x2, y2, fg
+
+   /color := Bg(window)			# establish defaults
+   /direction := "right"
+   /x1 := 0
+   /y1 := 0
+   /w := WAttrib(window, "width")
+   /h := WAttrib(window, "height")
+   x2 := x1 + w
+   y2 := y1 + h
+
+   fg := Fg(window)				# save present foreground color
+   Fg(window, color)				# set foreground for wiping
+
+   if not(integer(x1) & integer(x2) & integer(y1) & integer(y2)) |
+      (x1 > x2) | (y1 > y2) then stop("*** illegal coordinates in wipe()")
+
+   case direction of {
+      "right": {
+         every x := x1 to x2 do {
+            DrawLine(window, x, y1, x, y2)
+            }
+         }
+      "left": {
+         every x := x2 to x1 by -1 do {
+            DrawLine(window, x, y1, x, y2)
+            }
+         }
+      "left-right": {
+         until (x2 < x1) do {
+           DrawLine(window, x1, y1, x1, y2)
+           DrawLine(window, x2, y1, x2, y2)
+           x1 +:= 1
+           x2 -:= 1
+           }
+         }
+      "up-down": {
+          until y2 < y1 do {
+            DrawLine(window, x1, y1, x2, y1)
+            DrawLine(window, x1, y2, x2, y2)
+            y1 +:= 1
+            y2 -:= 1
+            }
+         }
+      "down": {
+         every y := y1 to y2 do {
+            DrawLine(window, x1, y, x2, y)
+            }
+         }
+      "up": {
+         every y := y2 to y1 by -1 do {
+            DrawLine(window, x1, y, x2, y)
+            }
+         }
+      "in": {
+         until (x2 < x1) | (y2 < y1) do {
+            DrawLine(window, x1, y1, x1, y2, x2, y2, x2, y1, x1, y1)
+            x1 +:= 1
+            x2 -:= 1
+            y1 +:= 1
+            y2 -:= 1
+            }
+         }
+      default: stop("*** illegal direction specificaion in wipe()")
+      }
+
+   Fg(window, fg)			# restore foreground color
+
+   return
+
+end
diff --git a/ipl/gprocs/wopen.icn b/ipl/gprocs/wopen.icn
new file mode 100644
index 0000000..820f761
--- /dev/null
+++ b/ipl/gprocs/wopen.icn
@@ -0,0 +1,230 @@
+############################################################################
+#
+#	File:     wopen.icn
+#
+#	Subject:  Procedures for graphics input/output
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     April 15, 2002
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	These procedures provide window input and output using "W" names as
+#	substitutes for standard input and output functions.  WOpen() opens
+#	and returns a window; the result is also assigned to &window if
+#	&window is null. 
+#
+#	WOpen(attrib, ...)	opens and returns a window.
+#
+#	WRead(W)		reads a line from a window.
+#
+#	WReads(W, i)		reads i characters from a window.
+#
+#	WWrite(W, s, ...)	writes a line to window.
+#
+#	WWrites(W, s, ...)	writes a partial line to window.
+#
+#	WDelay(W, n)		flushes a window, then delays n milliseconds.
+#				default:  n = 1
+#
+#	WClose(W)		closes a window;
+#				if W === &window, sets &window to &null.
+#
+#	WDone(), WQuit(), QuitCheck(), and QuitEvents() incorporate knowledge
+#	of the Icon standard set of "quit" events, currently the letters
+#	"q" or "Q".  The procedures themselves are trivial.
+#
+#	WQuit() consumes unread window events and succeeds if a quit event
+#	is seen.  It does not wait.  WDone() waits until a quit event is read,
+#	then exits the program.  QuitCheck(ev) calls exit() if its parameter
+#	is a quit event; QuitCheck can be used with the vidget package as a
+#	default event handler.  QuitEvents() generates the standard set of
+#	quit events.
+#
+#	ZDone() is a zooming version of WDone().  If the window is resized
+#	while waiting for a quit event, its contents are zoomed to fill the
+#	new size.  Zooming to a multiple of the original size can also be
+#	accomplished by typing a nonzero digit into the window.
+#
+#	SubWindow(W, x, y, w, h) produces a subwindow by creating and
+#	reconfiguring a clone of the given window.  The original window
+#	is not modified.  In the clone, which is returned, clipping
+#	bounds are set by the given rectangle and the origin is
+#	set at the rectangle's upper left corner.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+link gpxop
+
+procedure WOpen(args[])
+   push(args, "g")
+   push(args, "")
+   if /&window then
+      return &window := open ! args
+   else
+      return open ! args
+end
+
+
+procedure WRead(window)
+   if /window then
+      window := \&window | runerr(140, &window)
+   return read(window)
+end
+
+
+procedure WReads(window, i)
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if /window then
+      window := \&window | runerr(140, &window)
+   else if type(window) ~== "window" then {
+      i := window
+      window := \&window | runerr(140, &window)
+      }
+   return reads(window, i)
+end
+
+
+procedure WWrite(args[])
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(args[1]) == "window") then
+      push(args, \&window) | runerr(140, &window)
+   return write ! args
+end
+
+
+procedure WWrites(args[])
+   static type
+
+   initial type := proc("type", 0)	# protect attractive name
+   if not (type(args[1]) == "window") then
+      push(args, \&window) | runerr(140, &window)
+   return writes ! args
+end
+
+
+procedure WDelay(window, n)
+   static delay, type
+
+   initial {
+      delay := proc("delay", 0)		# protect attractive names
+      type := proc("type", 0)
+      }
+
+   if /window then
+      window := \&window | runerr(140, &window)
+   else if type(window) ~== "window" then {
+      n := window
+      window := \&window | runerr(140, &window)
+      }
+   /n := 1
+   integer(n) | runerr(101, n)
+   WFlush(window)
+   delay(n)
+
+   return window
+
+end
+
+
+procedure WClose(window)
+   if /window then
+      window := \&window | runerr(140, &window)
+   if window === &window then
+      &window := &null
+   return close(window)
+end
+
+
+procedure QuitEvents()
+   suspend !"qQ"
+end
+
+
+procedure QuitCheck(ev)
+   if ev === QuitEvents() then
+      exit()
+   return
+end
+
+
+procedure WQuit(win)
+   /win := &window
+   while *Pending(win) > 0 do
+      if Event(win) === QuitEvents() then
+         return win
+   fail
+end
+
+
+procedure WDone(win)
+   /win := &window
+   until Event(win) === QuitEvents()
+   exit()
+end
+
+
+#  ZDone(win) -- like WDone(), but zoom window if resized while waiting
+
+procedure ZDone(win)
+   local org, e, w, h, ww, hh, x0, y0
+
+   /win := &window
+   x0 := -WAttrib(win, "dx")
+   y0 := -WAttrib(win, "dy")
+   w := WAttrib(win, "width")
+   h := WAttrib(win, "height")
+   org := WOpen("width=" || w, "height=" || h, "canvas=hidden") | WDone()
+   CopyArea(win, org, x0, y0)
+   WAttrib(win, "resize=on")
+   while e := Event(win) do case e of {
+      QuitEvents():
+         exit()
+      &resize:
+         Zoom(org, win, , , , , x0, y0)
+      !"123456789": {
+         ww := e * w
+         hh := e * h
+         WAttrib(win, "width=" || ww, "height=" || hh)
+         Zoom(org, win, , , , , x0, y0, ww, hh)
+         }
+      }
+end
+
+procedure SubWindow(win, x, y, w, h)
+   static type
+   initial type := proc("type", 0)	# protect attractive name
+
+   if type(win) ~== "window" then
+      return SubWindow((\&window | runerr(140)), win, x, y, w)
+
+   /x := -WAttrib(win, "dx")
+   /y := -WAttrib(win, "dy")
+   /w := WAttrib(win, "width") - (x + WAttrib(win, "dx"))
+   /h := WAttrib(win, "height") - (y + WAttrib(win, "dy"))
+
+   if w < 0 then
+      x -:= (w := -w)
+   if h < 0 then
+      y -:= (h := -h)
+
+   win := Clone(win,
+      "dx=" || WAttrib(win, "dx") + x,
+      "dy=" || WAttrib(win, "dy") + y)
+   Clip(win, 0, 0, w, h)
+   GotoRC(win, 1, 1)
+   return win
+end
diff --git a/ipl/gprocs/xbfont.icn b/ipl/gprocs/xbfont.icn
new file mode 100644
index 0000000..6ba7a7d
--- /dev/null
+++ b/ipl/gprocs/xbfont.icn
@@ -0,0 +1,322 @@
+############################################################################
+#
+#	File:     xbfont.icn
+#
+#	Subject:  Procedures for X font selection
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     May 2, 2001
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	BestFont(W, s, ...) generates X-windows font names matching a
+#	given specification, beginning with the closest match.  The
+#	ranking algorithm is similar to that used in Font() but it is
+#	not identical.
+#
+############################################################################
+#
+#      BestFont(window, spec, ...) returns the name of whichever available
+#   X-Windows font most closely matches the given specification.  Note that
+#   matching is done using a slightly different algorithm from that of the
+#   Icon runtime system; this procedure preceded Icon's font selection
+#   implementation and served as a prototype.
+#
+#      The font specification is one or more strings containing whitespace-
+#   or comma-separated tokens.  Tokens are case-insensitive.  There are
+#   three kinds of tokens.
+#      A token having the form of an integer specifies the desired "pixel
+#   size" (height).  If no size is included, a target size of 14 is used.
+#      An unrecognized token is taken as a substring of the desired X font
+#   name.  Family names, weights, and other such factors are specified this
+#   way.
+#      Certain tokens are recognized and handled specially:
+#         m  mono  monospaced
+#         p  prop  proportional
+#         r  roman
+#         i  italic
+#         o  oblique
+#         s  sans  sans-serif  sansserif
+#   These are turned into search strings of a particular form.  For example,
+#   "roman" and "r" specify the search string "-r-".
+#
+#      The "best match" to a given specification is calculated by reviewing
+#   all the available fonts, assigning a score to each, then choosing the
+#   one with the highest value.  There are several aspects of scoring.
+#      Size is the most important factor.  A tuned font of the correct size
+#   gets the maximum score.  Nearby sizes receive partial credit, with
+#   an undersized font preferred over an oversized font.  Scalable fonts
+#   are also recognized, but a tuned font of the correct or nearly-correct
+#   size gets a higher score.
+#      Each successful substring match increases the score, whether the
+#   test string comes from an unrecognized token or a special keyword.
+#   Earlier tokens receive slightly more weight than later ones.
+#      All tokens need not match.  The string "lucida gill sans 18"
+#   is perfectly reasonable; it specifies a preference for Lucida Sans
+#   over Gill Sans by the position of the tokens, but will match either.
+#      Ties are broken by giving slight preferences for normal weight,
+#   no slant, normal width, and ASCII ("iso8859") encoding.  A slight
+#   penalty is assessed for "typewriter" fonts.  Oblique fonts receive
+#   partial credit for matching "italic" requests, and vice versa.
+#      The scoring function can be altered by assigning values to certain
+#   global variables.  See XBF_defaults() for a commented list of these.
+#
+#      For a scalable font, the returned value is a string specifying an
+#   instance of the font scaled to the target size.  For large sizes, the
+#   scaling time may be noticeable when the font is used.
+#
+#      BestFont() is actually a generator that produces the entire list
+#   of available fonts in order of preference.  RankFonts(w, spec, ...)
+#   is similar to BestFont but produces a sequence of two-element records,
+#   where result.str is the font name and result.val is its score.  For
+#   either of these, a list of X font names can be passed instead of a
+#   window.
+#
+#      There is some startup cost the first time BestFont is called; it
+#   opens a pipe to the "xlsfonts" program and reads the output.  Results
+#   are cached, so this overhead is only incurred once.
+#
+#      Examples:
+#         Font(w, BestFont(w, "times bold italic 20"))
+#         s := BestFont(w, size, family, "italic")
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics under Unix
+#
+############################################################################
+
+
+record XBF_rec(str, val)
+
+global XBF_wantsize		# requested font size
+global XBF_sizval		# array of scores indexed by actual font size
+
+
+# globals used for tuning the scoring function; see XBF_defaults()
+
+global XFW_defsize, XFW_size, XFW_maxover, XFW_maxunder, XFW_scaled
+global XFW_spacing, XFW_slant, XFW_aslant, XFW_sans
+global XFW_default, XFW_exact, XFW_posn, XFW_tiebreakers
+
+
+#  BestFont(window, spec...) - generate ranked sequence of font names
+
+procedure BestFont(args[])		#: generate best X fonts
+   suspend (RankFonts ! args) . str
+end
+
+
+#  XRankFont(window, spec...) - generate sequence of (name,score) tuples
+
+procedure RankFonts(w, args[])		#: generate scores for X fonts
+   local tokens, cklist, sclist, fspec, ranks, r
+
+   if type(w) ~== "window" & type(w) ~== "list" then {
+      push(args, w)
+      w := &window
+      }
+   XBF_defaults()			# set default values
+   XBF_wantsize := XFW_defsize		# set target size to default
+   tokens := XBF_tokenlist(args)	# break args into list of tokens
+   cklist := XBF_weights(tokens)	# get list of (substring,weight)s
+   XBF_sizval := XBF_sizes(XBF_wantsize) # build array for scoring sizes
+
+   # make a list of (fontname,score) tuples, and sort it
+   sclist := []
+   every fspec := XBF_fontlist(w) do
+      put(sclist, XBF_rec(fspec, XBF_eval(fspec, cklist)))
+   ranks := sortf(sclist, 2)
+
+   # generate results from hightest to lowest rank
+   while r := pull(ranks) do
+      suspend XBF_rec(XBF_spec(r.str, XBF_wantsize), r.val)
+end
+
+
+#  XBF_defaults() - assign default values to any unset tuning parameters
+
+procedure XBF_defaults()
+   /XFW_defsize := 14		# default size if unspecified
+   /XFW_size := 1000		# points for matching size exactly
+   /XFW_maxover := 30		# max allowable overage on size (per cent)
+   /XFW_maxunder := 60		# max allowable shortfall on size (per cent)
+   /XFW_scaled := 800		# points for matching size with scaled font
+
+   /XFW_spacing := 500		# points for matching prop/mono spacing
+   /XFW_slant := 500		# points for matching slant
+   /XFW_aslant := 300		# points for approx slant (oblique : italic)
+   /XFW_sans := 500		# points for matching "sans" spec
+
+   /XFW_exact := 1100		# points for matching entire font name
+   /XFW_default := 500		# points for matching unrecognized token
+   /XFW_posn := 10		# points for position in request list
+
+   /XFW_tiebreakers := [	# "tiebreaker" strings always scored
+      XBF_rec("-normal-", 1),		# prefer normal width
+      XBF_rec("-medium-", 1),		# prefer medium weight
+      XBF_rec("-r-", 2),		# upright slant is even more important
+      XBF_rec("-iso8859-", 1),		# prefer ASCII, not symbol/kana/etc
+      XBF_rec("typewriter", -4)]	# penalize typewriter fonts
+
+   return
+end
+
+
+#  XBF_tokenlist(args) -- turn list of args into list of tokens
+
+procedure XBF_tokenlist(args)
+   local tokens
+
+   tokens := []
+   every map(trim(!args)) ? repeat {
+      tab(many(' \t,'))
+      if pos(0) then
+         break
+      put(tokens, tab(upto(' \t,') | 0))
+      }
+   return tokens
+end
+
+
+#  XBF_weights(tokens) -- turn tokens into list of substrings and weights
+#
+#  Also saves the size value in the global XBF_wantsize.
+
+procedure XBF_weights(tokens)
+   local cklist, tk, pf
+
+   cklist := []
+   pf := *tokens * XFW_posn
+   every tk := !tokens do {
+      if not (XBF_wantsize := integer(tk)) then {
+         pf -:= XFW_posn
+         case tk of {
+            "m" | "mono" | "monospaced":
+               every put(cklist, XBF_rec("-m-" | "-c-", XFW_spacing + pf))
+            "p" | "prop" | "proportional":
+               put(cklist, XBF_rec("-p-", XFW_spacing + pf))
+            "r" | "roman":
+               put(cklist, XBF_rec("-r-", XFW_slant + pf))
+            "i" | "italic": {
+               put(cklist, XBF_rec("-i-", XFW_slant + pf))
+               put(cklist, XBF_rec("-o-", XFW_aslant + pf))
+               }
+            "o" | "oblique": {
+               put(cklist, XBF_rec("-o-", XFW_slant + pf))
+               put(cklist, XBF_rec("-i-", XFW_aslant + pf))
+               }
+            "s" | "sans" | "sans-serif" | "sansserif":
+               put(cklist, XBF_rec("sans", XFW_sans + pf))
+            default:
+               put(cklist, XBF_rec(tk, XFW_default + pf))
+            }
+         }
+      }
+   every put(cklist, !XFW_tiebreakers)
+   return cklist
+end
+
+
+#  XBF_sizes(wantsize) -- build array of scores for evaluating font sizes
+
+procedure XBF_sizes(wantsize)
+   local l, sz, diff, score, maxunder, maxover
+
+   l := [XFW_scaled]			# initial entry scores scaled fonts
+
+   # set scores for undersized fonts
+   maxunder := (XFW_maxunder / 100.0) * wantsize
+   every sz := 1 to wantsize-1 do {
+      diff := wantsize - sz
+      score := integer(XFW_size * (1 - diff / maxunder))
+      score <:= 0
+      put(l, score)
+      }
+
+   # set scores for correct and oversized fonts
+   maxover := (XFW_maxover / 100.0) * wantsize
+   repeat {
+      sz +:= 1
+      diff := sz - wantsize
+      score := integer(XFW_size * (1 - diff / maxover))
+      if score <= 0 then
+         break			# quit when too big to be useful
+      put(l, score)
+      }
+
+   return l
+end
+
+
+# XBF_fontlist(w) - generate list of font names for window (or list) w
+
+procedure XBF_fontlist(w)
+   static fontlist
+   local pipe
+
+   if type(w) == "list" then
+      suspend !w
+   else {
+      if /fontlist then {
+         fontlist := []
+         pipe := open("xlsfonts", "rp") | stop("can't open xlsfonts pipe")
+         while put(fontlist, trim(read(pipe)))
+         close(pipe)
+         }
+      suspend !fontlist
+      }
+end
+
+
+#  XBF_eval(fontname, cklist) -- evaluate the score of an X font name
+
+procedure XBF_eval(fontname, cklist)
+   local t, r
+
+   # find the size and look up its score in the XBF_sizval array
+   fontname ? {
+      every 1 to 7 do
+         tab(upto('-')) & move(1)
+      t := XBF_sizval [1 + integer(tab(upto('-')))] | 0
+   }
+
+   # add the corresponding value for every substring that matches
+   every r := !cklist do
+      if find(r.str, fontname) then
+         if r.str == fontname then
+            t +:= XFW_exact		# high score for matching entire name
+         else
+            t +:= r.val			# else give specified value
+   return t
+end
+
+
+#  XBF_spec(fontname, size) -- return the correct form of an X font name
+#
+#  This is just the name itself except in the case of scalable fonts.
+
+procedure XBF_spec(fontname, size)
+   local s
+
+   fontname ? {
+      s := tab(find("-0-0-")) | return fontname	# return if not scalable
+      move(5)					# skip pixel size, point size
+      tab(upto('-')) & move(1)			# skip x-resolution
+      tab(upto('-')) & move(1)			# skip y-resolution
+      s ||:= "-"
+      s ||:= size				# spec pixel size
+      s ||:= "-*-*-*-"				# wildcard ptsize & resolutions
+      s ||:= tab(upto('-'))			# copy spacing field
+      s ||:= move(1)
+      tab(upto('-'))				# skip average width
+      s ||:= "*"
+      s ||:= tab(0)				# copy the rest
+      }
+   return s
+end
diff --git a/ipl/gprocs/xcolor.icn b/ipl/gprocs/xcolor.icn
new file mode 100644
index 0000000..cc243dc
--- /dev/null
+++ b/ipl/gprocs/xcolor.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xcolor.icn
+#
+#	Subject:  Declaration to link color
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link color
diff --git a/ipl/gprocs/xcompat.icn b/ipl/gprocs/xcompat.icn
new file mode 100644
index 0000000..f9aef40
--- /dev/null
+++ b/ipl/gprocs/xcompat.icn
@@ -0,0 +1,110 @@
+############################################################################
+#
+#	File:     xcompat.icn
+#
+#	Subject:  Procedures for compatibility with 8.10 graphics
+#
+#	Authors:  Gregg M. Townsend and Ralph E. Griswold
+#
+#	Date:     May 26, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  This file provides compatible implementation of Icon 8.10 functions
+#  that cannot be replaced with 9.0 functions via the simple renaming
+#  done in xnames.icn.  The following procedures are provided:
+#
+#	XBind(w1, w2, ...)
+#	XUnbind()
+#	XWindowLabel(s)
+#	XDrawArc(w,x,y,width,height,a1,a2,...),
+#	XFillArc(w,x,y,width,height,a1,a2,...),
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+
+
+procedure XBind(args[])
+   local window
+
+   if type(args[2]) == type(args[1]) == "window" then
+      return Couple ! args		# two windows: couple them
+
+   if type(args[1]) == "window" then { 	# one window: clone it
+      window := pop(args)
+      if /args[1] then
+         pop(args)
+      push(args, window)
+      return Clone ! args
+      }
+
+   # no windows: create hidden canvas
+   while /args[1] do			# remove leading null args
+      pop(args)
+   if type(args[1]) == "window" then	# remove possible arg2 window
+      pop(args)
+   while /args[-1] do			# remove trailing null args
+      pull(args)
+   put(args, "canvas=hidden")		# turn into open() call
+   push(args, "x")
+   push(args, "window")
+   return open ! args
+end
+
+
+procedure XUnbind(args[])
+   XUnbind := proc("XUnbind" | "XUncouple" | "Uncouple", 0)
+   return XUnbind ! args
+end
+
+
+procedure XWindowLabel(win, s)
+   if type(win) == "window" then
+      WAttrib(win, "label=" || s)
+   else
+      WAttrib("label=" || win)
+   return
+end
+
+
+procedure XDrawArc(args[])
+   local a1, i
+   static m
+
+   initial m := -(2 * &pi) / (360 * 64)
+
+   if type(args[1]) == "window" then
+      a1 := 6
+   else
+      a1 := 5
+   every i := a1 to *args by 6 do {
+      args[i] *:= m
+      args[i + 1] *:= m
+      }
+   return DrawArc ! args
+end
+
+
+procedure XFillArc(args[])
+   local a1, i
+   static m
+
+   initial m := -(2 * &pi) / (360 * 64)
+
+   if type(args[1]) == "window" then
+      a1 := 6
+   else
+      a1 := 5
+   every i := a1 to *args by 6 do {
+      args[i] *:= m
+      args[i + 1] *:= m
+      }
+   return FillArc ! args
+end
diff --git a/ipl/gprocs/xform.icn b/ipl/gprocs/xform.icn
new file mode 100644
index 0000000..6377c3a
--- /dev/null
+++ b/ipl/gprocs/xform.icn
@@ -0,0 +1,60 @@
+############################################################################
+#
+#	File:     xform.icn
+#
+#	Subject:  Procedures to transform points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     October 1, 1997
+#
+############################################################################
+#
+#  This file is in the public domain.
+#
+############################################################################
+#
+#  This file contains procedures that manipulate points representing
+#  vertices. 
+#
+############################################################################
+#
+#  Links:  calls, gobject
+#
+############################################################################
+
+link calls, gobject
+
+procedure p_xlate(call, x, y)
+   local point
+
+   every point := invoke(call) do {
+      point.x +:= x
+      point.y +:= y
+      suspend point
+      }
+
+end
+
+procedure p_scale(call, factor)
+   local point
+
+   every point := invoke(call) do {
+      point.x *:= factor
+      point.y *:= factor
+      suspend point
+      }
+
+end
+
+procedure p_rotate(call, angle)
+   local point, radius
+
+   every point := invoke(call) do {
+      radius := sqrt(point.x ^ 2, point.y ^ 2)
+      point.x *:= radius * cos(angle)
+      point.y *:= radius * sin(angle)
+      suspend point
+      }
+
+end
diff --git a/ipl/gprocs/xformimg.icn b/ipl/gprocs/xformimg.icn
new file mode 100644
index 0000000..ce2b2f2
--- /dev/null
+++ b/ipl/gprocs/xformimg.icn
@@ -0,0 +1,168 @@
+############################################################################
+#
+#	File:     xformimg.icn
+#
+#	Subject:  Procedures to transform image
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     February 4, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  These procedures perform reflections, rotations, and concatenations
+#  of images.
+#
+#  Warning:  Some of these operations are slow.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  numbers, wattrib, wopen
+#
+############################################################################
+
+link numbers
+link wattrib
+link wopen
+
+procedure wreflect(win1, dir)
+   local win2, x1, x2, y1, y2, width, height
+
+   /dir := "v"				# vertical reflection is the default
+
+   height := Height(win1)
+   width := Width(win1)
+
+   win2 := WOpen("canvas=hidden", "width=" || width, "height=" || height) |
+      stop("*** cannot window for reflection")
+
+   case dir of {
+      "h":  {
+         x2 := 0
+         y2 := height - 1
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if x2 = width - 1 then {
+               x2 := 0
+               y2 -:= 1
+               }
+            else x2 +:= 1
+            }
+         }
+      "v":  {
+         x2 := width - 1
+         y2 := 0
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if x2 = 0 then {
+               x2 := width - 1
+               y2 +:= 1
+               }
+            else x2 -:= 1
+            }
+         }
+      default:  stop("*** invalid specification for reflect()")
+      }
+
+   return win2
+
+end
+
+procedure wrotate(win1, dir)
+   local win2, x1, x2, y1, y2, width, height
+
+   /dir := "90"				# 90-degree rotation is the default
+
+   height := Height(win1)
+   width := Width(win1)
+
+
+   case integer(dir) of {
+      90:  {
+         x2 := height - 1
+         y2 := 0
+         win2 := WOpen("canvas=hidden", "width=" || height,
+            "height=" || width) | stop("*** cannot open target window")
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if y2 = width - 1 then {
+               y2 := 0
+               x2 -:= 1
+               }
+            else y2 +:= 1
+            }
+         }
+      -90:  {
+         win2 := WOpen("canvas=hidden", "width=" || height,
+            "height=" || width) | stop("*** cannot open target window")
+         x2 := 0
+         y2 := width - 1
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if y2 = 0 then {
+               y2 := width - 1
+               x2 +:= 1
+               }
+            else y2 -:= 1
+            }
+         }
+      180:  {
+         win2 := WOpen("canvas=hidden", "width=" || width,
+            "height=" || height) | stop("*** cannot open target window")
+         x2 := width - 1
+         y2 := height - 1
+         every Fg(win2, Pixel(win1)) do {
+            DrawPoint(win2, x2, y2)
+            if x2 = 0 then {
+               x2 := width - 1
+               y2 -:= 1
+               }
+            else x2 -:= 1
+            }
+         }
+      default:  stop("*** invalid specification for rotate()")
+      } | stop("*** invalid specification for rotate()")
+
+   return win2
+
+end
+
+procedure wcatenate(win1, win2, dir)
+   local width1, width2, height1, height2, win3
+
+   /dir := "h"			# horizontal concatenation is the default
+
+   width1 := Width(win1)
+   width2 := Width(win2)
+   height1 := Height(win1)
+   height2 := Height(win2)
+
+   case dir of {
+      "h":  {
+         win3 := WOpen("canvas=hidden", "width=" || (width1 + width2),
+            "height=" || max(height1, height2)) |
+               stop("*** cannot open window for concatenation")
+         CopyArea(win1, win3)
+         CopyArea(win2, win3, 0, 0, width2, height2, width1, 0)
+         }
+      "v":  {
+         win3 := WOpen("canvas=hidden", "width=" || max(width1, width2),
+            "height=" || (height1 + height2)) |
+               stop("*** cannot open window for concatenation")
+         CopyArea(win1, win3)
+         CopyArea(win2, win3, 0, 0, width2, height2, 0, height1)
+         }
+      default:  stop("*** invalid specification for catenate()")
+      }
+
+   return win3
+
+end
diff --git a/ipl/gprocs/xgtrace.icn b/ipl/gprocs/xgtrace.icn
new file mode 100644
index 0000000..16afd10
--- /dev/null
+++ b/ipl/gprocs/xgtrace.icn
@@ -0,0 +1,81 @@
+############################################################################
+#
+#	File:     xgtrace.icn
+#
+#	Subject:  Procedures to draw traces of points
+#
+#	Author:   Ralph E. Griswold
+#
+#	Date:     November 19, 1997
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  As used here, the term "trace" refers to a sequence of points that
+#  generally consists of locations on a curve or other geometrical object.
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics
+#
+############################################################################
+#
+#  Links:  gtace, turtle
+#
+############################################################################
+
+link gtrace
+link turtle
+
+#
+#  line_trace(call) draws lines along the figure described by the trace from
+#  invoke(call).
+
+procedure line_trace(call)
+   local TPlot, point
+
+   TPlot := TGoto			# go to first point
+   every point := invoke(call) do {
+      TPlot(point.x, point.y)
+      TPlot := TDrawto			# draw subsequently
+      }
+
+   return
+
+end
+
+#
+#  segment_trace(call) draws line segments between successive pairs of
+#  points along the figure described by the trace from invoke(call).
+
+procedure segment_trace(call)
+   local TPlot, TPlotNext, point
+
+   TPlot := TGoto			# go to first point
+   TPlotNext := TDrawto
+   every point := invoke(call) do {
+      TPlot(point.x, point.y)
+      TPlot :=: TPlotNext		# draw subsequently
+      }
+
+   return
+
+end
+
+#
+#  curve_trace(call) draws a curve along the figure described by the trace
+#  from invoke(call).
+#
+procedure curve_trace(call, limit)
+   local points, n
+
+   /limit := 500			# maximum number of points allowed
+
+   DrawCurve ! coord_list(call, limit)
+
+   return
+
+end
diff --git a/ipl/gprocs/xio.icn b/ipl/gprocs/xio.icn
new file mode 100644
index 0000000..7cacd46
--- /dev/null
+++ b/ipl/gprocs/xio.icn
@@ -0,0 +1,22 @@
+############################################################################
+#
+#	File:     xio.icn
+#
+#	Subject:  Declarations to link window I/O
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link wopen
+link window
diff --git a/ipl/gprocs/xplane.icn b/ipl/gprocs/xplane.icn
new file mode 100644
index 0000000..93ae325
--- /dev/null
+++ b/ipl/gprocs/xplane.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xplane.icn
+#
+#	Subject:  Declaration to link bitplane
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link bitplane
diff --git a/ipl/gprocs/xputpixl.icn b/ipl/gprocs/xputpixl.icn
new file mode 100644
index 0000000..5240dcb
--- /dev/null
+++ b/ipl/gprocs/xputpixl.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xputpixl.icn
+#
+#	Subject:  Declaration to link putpixel
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link putpixel
diff --git a/ipl/gprocs/xqueue.icn b/ipl/gprocs/xqueue.icn
new file mode 100644
index 0000000..832e5b1
--- /dev/null
+++ b/ipl/gprocs/xqueue.icn
@@ -0,0 +1,21 @@
+############################################################################
+#
+#	File:     xqueue.icn
+#
+#	Subject:  Declaration to link enqueue
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link enqueue
diff --git a/ipl/gprocs/xutils.icn b/ipl/gprocs/xutils.icn
new file mode 100644
index 0000000..8c46067
--- /dev/null
+++ b/ipl/gprocs/xutils.icn
@@ -0,0 +1,37 @@
+############################################################################
+#
+#	File:     xutils.icn
+#
+#	Subject:  Procedures for graphics utilities
+#
+#	Author:   Gregg M. Townsend
+#
+#	Date:     June 9, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+# compatibility file
+#
+############################################################################
+
+link wopen
+link gpxop
+link gpxlib
+
+procedure Quit(win)
+   /win := &window
+   while *Pending(win) > 0 do
+      if Event(win) === QuitEvents() then
+         return win
+   fail
+end
+
+procedure Done(win)
+   /win := &window
+   until Event(win) === QuitEvents()
+   exit()
+end