diff options
Diffstat (limited to 'ipl/gprogs/travels.icn')
| -rw-r--r-- | ipl/gprogs/travels.icn | 1121 |
1 files changed, 1121 insertions, 0 deletions
diff --git a/ipl/gprogs/travels.icn b/ipl/gprogs/travels.icn new file mode 100644 index 0000000..e268405 --- /dev/null +++ b/ipl/gprogs/travels.icn @@ -0,0 +1,1121 @@ +############################################################################ +# +# File: travels.icn +# +# Subject: Program to animate the traveling salesman problem +# +# Author: Gregg M. Townsend +# +# Date: September 17, 1997 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# Usage: travels [window options] [-q] [npoints] +# +# -q (quiet) suppresses commentary normally written to stdout +# +# npoints seeds the field with that many initial cities +# and sets the count for the "reseed" button +# +# +# travels illustrates several heuristic algorithms for obtaining +# approximate solutions to the traveling salesman problem. Cities may +# be seeded randomly or entered with the mouse. Speed may be controlled +# using a slider. The CPU time, number of cities, and path length are +# displayed on a status line and written to standard output after every +# major action. +# +############################################################################ +# +# Several types of controls are provided. New cities may be added +# at any time, invalidating any current path. At least two cities must +# be seeded before a path can be constructed. A path must be constructed +# before any of the optimization algorithms can be applied. +# +# For a description on of the algorithms used, see: +# David S. Johnson +# Local Optimization and the Traveling Salesman Problem +# Proc. 17th Colloquium on Automata, Languages, & Programming +# Springer-Verlag (1990), pp. 446-461 +# +# +# Mouse Actions: +# +# Clicking the left mouse button adds a new point. +# +# +# Keyboard Actions: +# +# The digit 0 clears all points. +# The digits 1 through 9 seed 1 to 81 (n ^ 2) new points. +# +# Each of the pushbuttons below also has a keyboard equivalent +# which is indicated on the pushbutton. +# +# +# Pushbuttons: +# +# Removing and adding points: +# Clear Remove all points +# Reseed Add n random points (a command option, default 20) +# +# Path construction: +# Initial Connect points in order of initialization +# Random Random path +# Strip Strip-wise construction +# NearNbr Nearest-neighbor algorithm +# NearIns Nearest-insertion algorithm +# FarIns Farthest-insertion algorithm +# Greedy Greedy algorithm +# +# Optimizations: +# 2-Adj Swap pairs of adjacent points +# Uncross Swap pairs of intersecting segments +# 2-Opt Swap all segment pairs that shorten the path +# +# Control: +# List List coordinates of points on standard output +# Refresh Redraw the screen +# Quit Exit the program +# +# +# Delay Slider: +# +# The delay slider can be used to slow down the action. It specifies a +# number of milliseconds to pause before visiting a new point or drawing +# a new path segment. Its response is nonlinear in order to allow finer +# control of short delays. Delays are inexact due to system granularity +# and other problems. +# +# Unfortunately, the delay slider can only be changed between actions, +# not during construction or optimization. +# +############################################################################ +# +# Requires: Version 9 graphics +# +############################################################################ +# +# Links: options, optwindw, button, slider, evmux, random, graphics +# +############################################################################ + +link options +link optwindw +link button +link slider +link evmux +link random +link graphics + +$define EColor "dark blue" # emphasis color + + + +global ptlist # list of point records (permanent id order, not route) +record point( + id, # permanent id + x, y, # location + nxt, prv, # forward and backward links for route + t1, t2) # scratch cells for traversal algorithms + + + +global distlist # list of distance recs (linearized triangular matrix) +global distsrt # sorted distance list (created when needed) +record dstrec( + d, # distance between two points (x1000, stored as int) + p, q) # the two points + + + +global newpts # non-null if points are new since last report + +global havepath # non-null if we have a valid path + # (start from any point and follow links) + +global lastclk # value of &time before last computation +global delaytime # delay time between steps, in msec + +global opts # command line options +global nseed # number of points to seed + +global win # main window +global fgwin # binding for drawing in foreground color +global emwin # binding for drawing in emphasis color +global bgwin # binding for erasing in background color + +global m, w, h, bw, bh, fh # screen layout parameters +global ax, ay, aw, ah # corners and size of arena + + + + +######################### main program ######################### + + + +procedure main(args) + local base, pt, sg, hl + + # get options and open a window + opts := options(args, "qE:" || winoptions()) # get options + + /opts["W"] := 700 # default width + /opts["H"] := 500 # default height + /opts["E"] := EColor # default emphasis + /opts["T"] := "sans,bold,12" # default font + /opts["M"] := -1 # use standard margin + win := optwindow(opts, "linewidth=2") # open window + m := opts["M"] # save specified margin + h := opts["H"] # save usable height + w := opts["W"] # save usable width + + bw := 100 # button width + bh := 18 # button height + fh := 20 # footer height + + ax := m + bw + m # arena bounds and size + ay := m + aw := w - bw - m + ah := h - fh - m + + fgwin := Clone(win) + emwin := Clone(win, "fg=" || (opts["E"] | EColor | "black"), "linewidth=4") + bgwin := Clone(win, "fg=" || Bg(win), "linewidth=4") + + # set up sensor for adding points + sensor(win, &lrelease, addpt, &null, ax, ay, aw, ah) + + # set up buttons + buttonrow(win, m, m, bw, bh, 0, bh + (2 > m | 2), + "seeding", &null, &null, + "Clear 0", argless, clrpts, + "Reseed D", argless, reseed, + &null, &null, &null, # spacing + "construction", &null, &null, + "Initial I", argless, initpath, + "Random R", argless, randpath, + "Strip S", argless, strippath, + "NearNbr B", argless, nearnbr, + "NearIns N", argless, nearins, + "FarIns F", argless, farins, + "Greedy G", argless, greedypath, + &null, &null, &null, + "optimization", &null, &null, + "2-Adj A", argless, twoadj, + "Uncross U", argless, uncross, + "2-Opt T", argless, twoopt, + &null, &null, &null, + "control", &null, &null, + "Refresh H", argless, refresh, + "List L", argless, listpath, + &null, &null, &null, + "Quit Q", argless, exit, + ) + + # set up corresponding keyboard handlers + quitsensor(win) # q and Q + sensor(win, 'Ii', argless, initpath) + sensor(win, 'Rr', argless, randpath) + sensor(win, 'Ss', argless, strippath) + sensor(win, 'Bb', argless, nearnbr) + sensor(win, 'Nn', argless, nearins) + sensor(win, 'Ff', argless, farins) + sensor(win, 'Gg', argless, greedypath) + sensor(win, 'Aa', argless, twoadj) + sensor(win, 'Uu', argless, uncross) + sensor(win, 'Tt', argless, twoopt) + sensor(win, 'Ll', argless, listpath) + sensor(win, 'Dd', argless, reseed) + sensor(win, 'Hh', argless, refresh) + sensor(win, '0', argless, clrpts) + sensor(win, '123456789', reseed) + + # set up speed slider + slider(win, setdly, 0, m, m + h - bh, bw, bh, 0, 0, 1) + setdly(win, 0, 0) + + # initialize + randomize() + clrpts() + lastclk := &time + + if nseed := integer(args[1]) then + reseed() + else + nseed := 20 + + # process events + evmux(win) +end + + + +# setdly(win, arg, value) -- set delay time + +procedure setdly(win, arg, value) + local s, l + + value := integer(10001 ^ value + 0.5) - 1 + delaytime := value + s := " delay " || value || " " + l := TextWidth(win, s) + GotoXY(win, m + (bw - l) / 2, m + h - bh - m / 2) + writes(win, s) + return +end + + + +# pause() -- delay according to the current setting + +procedure pause() + if delaytime > 0 then + WDelay(win, delaytime) + return +end + + + +######################### path constructions ######################### + + + +# initpath() -- connect in initial placement order + +procedure initpath() + local i + + bgnpath(0, "placement order...") | fail + ptlist[1].nxt := &null + every i := 2 to *ptlist do { + follow(ptlist[i-1], ptlist[i]) + pause() + } + ptlist[-1].nxt := ptlist[1] + ptlist[1].prv := ptlist[-1] + drawpath(fgwin, ptlist[-1], ptlist[1]) + + havepath := 1 + report("initial path") + return +end + + + +# randpath() -- make random connections + +procedure randpath() + local l, i, p, q + + bgnpath(0, "connecting randomly...") | fail + + l := copy(ptlist) # get copy of point list + every i := 1 to *l do # shuffle it + l[i] :=: l[?i] + + p := l[1] + q := l[-1] + p.nxt := &null + every i := 2 to *l do { + follow(l[i-1], l[i]) + pause() + } + p.prv := q + q.nxt := p + drawpath(fgwin, q, p) + + havepath := 1 + report("random path") + return +end + + + +# strippath() -- construct using strips + +procedure strippath() + local i, l, n, p, q, r + + if *ptlist < 3 then + return + bgnpath(0, "stripwise algorithm") + + n := integer(sqrt(*ptlist) + .5) + l := list(n) + every !l := list() + + every p := !ptlist do { + i := integer(1 + n * (p.x - ax) / real(aw + 1)) + put(l[i], p) + } + + every i := 1 to n do + l[i] := sortf(l[i], 3) + every i := 2 to n by 2 do { + r := [] + every push(r, !l[i]) + l[i] := r + } + + q := !!l # get first point from first non-empty bin + every p := !!l do { + q.nxt := p + p.prv := q + drawpath(fgwin, q, p) + q := p + pause() + } + q := !!l + p.nxt := q + q.prv := p + drawpath(fgwin, p, q) + + havepath := 1 + report("stripwise algorithm") + return +end + + + +# nearnbr() -- nearest neighbor + +procedure nearnbr() + local f, p, q, s, d + + bgnpath(1, "nearest neighbor...") | fail + + f := p := ?ptlist + p.nxt := p.prv := &null + s := set([p]) + while *s < *ptlist do { + every d := !distsrt do { + if d.p === p then + q := d.q + else if d.q === p then + q := d.p + else + next + if member(s, q) then + next + insert(s, q) + p := follow(p, q) + p.nxt := &null + pause() + break + } + } + p.nxt := f + f.prv := p + drawpath(fgwin, p, f) + + havepath := 1 + report("nearest neighbor") + return +end + + + +# nearins() -- make path using nearest-insertion algorithm + +procedure nearins() + local d, p, q, t, todo, mind + + bgnpath(0, "nearest insertion...") | fail + + # init path with the two closest points + mind := 1000000000 + every d := !distlist do + if mind >:= d.d then { + p := d.p + q := d.q + } + p.nxt := p.prv := q + q.nxt := q.prv := p + drawpath(fgwin, p, q) + pause() + + todo := set(ptlist) # set of points not yet on path + every delete(todo, p | q) + + every t := !todo do + t.t1 := dist(t, q) # point.t1 = distance to nearest point on path + + while *todo > 0 do { # repeat for each new point added to path + mind := 1000000000 # mind = minimum distance this pass + every t := !todo do { + t.t1 >:= dist(t, p) # update pt's dist to path if latest pt closer + if mind >:= t.t1 then # check for better (smaller) min d this pass + q := t # if nearest so far + } + # point q is the remaining point nearest from any point on the path + joinpath(p, q) + delete(todo, q) + pause() + p := q + } + + havepath := 1 + redraw() + report("nearest insertion") + return +end + + + +# farins() -- make path using farthest-insertion algorithm + +procedure farins() + local d, p, q, t, todo, maxd + + bgnpath(0, "farthest insertion...") | fail + + # init path with the two most distant points + maxd := -1 + every d := !distlist do + if maxd <:= d.d then { + p := d.p + q := d.q + } + p.nxt := p.prv := q + q.nxt := q.prv := p + drawpath(fgwin, p, q) + pause() + + todo := set(ptlist) # set of points not yet on path + every delete(todo, p | q) + + every t := !todo do + t.t1 := dist(t, q) # point.t1 = distance to nearest point on path + + while *todo > 0 do { # repeat for each new point added to path + maxd := -1 # maxd = furthest distance this pass + every t := !todo do { + t.t1 >:= dist(t, p) # update pt's dist to path if latest pt closer + if maxd <:= t.t1 then # check for better (larger) maxd this pass + q := t # if farthest so far + } + # point q is the remaining point farthest from any point on the path + joinpath(p, q) + delete(todo, q) + pause() + p := q + } + + havepath := 1 + redraw() + report("farthest insertion") + return +end + + + +# joinpath(p, q) -- add q at best place in path beginning at p + +procedure joinpath(p, q) + local start, best, d + + d := dist(p, q) + dist(q, p.nxt) - dist(p, p.nxt) + start := best := p + while (p := p.nxt) ~=== start do + if d >:= dist(p, q) + dist(q, p.nxt) - dist(p, p.nxt) then + best := p + + follow(best, q) + return +end + + + +# greedypath() -- make path using greedy algorithm + +procedure greedypath() + local p, q, d, g, need + + bgnpath(1, "greedy algorithm...") | fail + + every p := !ptlist do { + p.nxt := p.prv := &null + p.t1 := p.id # point.t1 = group membership + p.t2 := 0 # point.t2 = degree of node + } + + need := *ptlist # number of edges we still need + + every d := |!distsrt do { # |! is to handle 2-pt case + p := d.p + q := d.q + if p.t2 > 1 | q.t2 > 1 then # if either is fully connected + next + if p.t1 = q.t1 & need > 1 then # if would be cycle & not done + next + + # now we are committed to adding the point + pause() + DrawLine(fgwin, p.x, p.y, q.x, q.y) # draw new edge + p.t2 +:= 1 # increase degree counts + q.t2 +:= 1 + + if /p.nxt <- q & /q.prv := p then { # if q can follow p easily + g := q.t1 ~=:= p.t1 | break # break if the final connection + while q := \q.nxt do + q.t1 := g + } + else if /q.nxt <- p & /p.prv := q then { # if p can follow q easily + g := p.t1 ~=:= q.t1 | break # break if the final connection + while p := \p.nxt do + p.t1 := g + } + else if /p.nxt := q then { # implies /q.nxt -- both are chain tails + g := p.t1 + repeat { + q.t1 := g + q.nxt := q.prv + q.prv := p + p := q + q := \q.nxt | break + } + } + else { # /p.prv & /q.prv -- both are chain heads + p.prv := q + g := p.t1 + repeat { + q.t1 := g + q.prv := q.nxt + q.nxt := p + p := q + q := \q.prv | break + } + } + + if (need -:= 1) = 0 then # quit when have all edges + break + } + + havepath := 1 + report("greedy algorithm") + return +end + + + + +# bgnpath(i, msg) -- common setup for path construction +# +# i > 0 if *sorted* distance table will be needed +# msg is status message + +procedure bgnpath(i, msg) + if *ptlist < 2 then + fail + prepdist(i) + status(msg) + if \havepath then + erasepath() + havepath := &null + lastclk := &time + return +end + + + +######################### optimizations ######################### + + + +# twoadj() -- swap pairs of adjacent points + +procedure twoadj() + local lastchg, nflips, p, q + + if /havepath then + return + status("2-adj...") + lastclk := &time + nflips := 0 + + lastchg := p := ?ptlist # pick random starting point + + repeat { + + q := p.nxt.nxt + repeat { + DrawLine(emwin, p.x, p.y, p.nxt.x, p.nxt.y) # mark current spot + if not pairtest(p, q) then # if swap doesn't help + break + flip(p, q) # do the swap + nflips +:= 1 # count it + lastchg := p # update point of last change + } + + pause() + p := p.nxt + if p === lastchg then + break # have made complete circuit without changes + } + + report("2-adj (" || nflips || " flips)") + refresh() + return +end + +procedure adjtest(p, q) + return ((p.nxt.nxt === q) | (q.nxt.nxt === p)) & pairtest(p, q) +end + + + +# twoopt() -- swap segments if total path shortens + +procedure twoopt() + pairdriver("2-opt", pairtest) + return +end + +# pairtest(p, q) -- succeed if swapping out-segments from p and q shortens path + +procedure pairtest(p, q) + return (dist(p,q) + dist(p.nxt,q.nxt)) < (dist(p,p.nxt) + dist(q,q.nxt)) & + (not (p === (q.prv | q | q.nxt))) +end + + + +# uncross() -- swap intersecting segments + +procedure uncross() + pairdriver("uncross", intersect) + return +end + +# intersect(p, q) -- succeed if outward segments from p and q intersect +# +# from comp.graphics.algorithms FAQ, by O'Rourke + +procedure intersect(p, q) + local a, b, c, d + local xac, xdc, xba, yac, ydc, yba + local n1, n2, d12, r, s + + a := p + b := p.nxt + c := q + d := q.nxt + xac := a.x - c.x + xdc := d.x - c.x + xba := b.x - a.x + yac := a.y - c.y + ydc := d.y - c.y + yba := b.y - a.y + + n1 := yac * xdc - xac * ydc + n2 := yac * xba - xac * yba + d12 := real(xba * ydc - yba * xdc) + + if d12 = 0.0 then + fail # lines are parallel or coincident + + r := n1 / d12 + s := n2 / d12 + + # intersection point is: (a.x + r * xba, a.y + r * yba) + + if 0.0 < r < 1.0 & 0.0 < s < 1.0 then + return # segments AB and CD do intersect + else + fail # segments do not intersect (though extensions do) +end + + + + +# pairdriver(label, tproc) -- driver for "uncross" and "2-opt" + +procedure pairdriver(label, tproc) + local slist, todo, nflips, a, p, q + + if /havepath then + return + status(label || "...") + lastclk := &time + nflips := 0 + + slist := list() # initial list of segments + every put(slist, path()) + todo := set() # segments to reconsider + + while p := get(slist) | ?todo do { # pick candidate segment + + delete(todo, p) + pause() + + # restart search every time p's outgoing edge changes + repeat { + + DrawLine(emwin, p.x, p.y, p.nxt.x, p.nxt.y) # mark segment in progress + + # check for swap with every other edge + every q := !ptlist do { + + if tproc(p, q) then { # if test procedure succeeds, + # a swap is worthwhile + + # the path from p.nxt through q will reverse direction; + # this will change segment labelings; so fix up "todo" set + a := q.prv + while a ~=== p do { + if member(todo, a) then { # if segment is on list + delete(todo, a) # remove under old name + insert(todo, a.nxt) # add under new name + } + a := a.prv + } + + # new segment from p will be done when we loop again + # other new segment to list + insert(todo, p.nxt) # add to list + + # now flip the edges + flip(p, q) # flip the edges + nflips +:= 1 # count the flip + + break next # restart search loop using new edge + } + } + + break # if no improvement for one full loop + } + + } + + report(label || " (" || nflips || " flips)") + refresh() + return +end + + + +######################### point maintenance ######################### + + + +# clrpts() -- remove all points + +procedure clrpts() + ptlist := [] + distlist := [] + distsrt := [] + havepath := &null + refresh() + fillrect(bgwin) + status("0 points") + return +end + + + +# reseed() -- add random points to the list + +procedure reseed(win, dummy, x, y, event) + local p, v, n + + n := integer(\event)^2 | nseed + every 1 to n do + addpt(win, &null, ax + ?aw, ay + ?ah) + return +end + + + +# addpt(win, dummy, x, y) -- add one point to the list + +procedure addpt(win, dummy, x, y) + local n, p, q + + if \havepath then { + erasepath() + havepath := &null + } + n := *ptlist + p := point(n + 1, x, y) + every q := !ptlist do + put(distlist, dstrec(integer(1000 * sqrt((q.x-x)^2 + (q.y-y)^2)), p, q)) + put(ptlist, p) + drawpt(p) + status(*ptlist || " points") + newpts := 1 + return p +end + + + +# prepdist(i) -- prepare distance data for path construction +# +# copy the distance list, if not already done, so it can be indexed quickly. +# also create the sorted list if i > 0. + +procedure prepdist(i) + static c, n + + if c ~=== distlist | n ~= *distlist then { + c := distlist := copy(distlist) + n := *distlist + } + if \i > 0 & *distsrt < *distlist then { + status("sorting distances... ") + lastclk := &time + WFlush(win) + distsrt := sortf(distlist, 1) + report("distance sort") + } + return +end + + + +# dist(p, q) -- return distance between p and q assuming p ~=== q + +procedure dist(p, q) + local m, n + m := p.id + n := q.id + if m < n then + m :=: n + return distlist[((m - 1) * (m - 2)) / 2 + n].d +end + + + +# path() -- generate current path, even if it changes during generation + +procedure path() + local l, p, q + p := q := ptlist[1] | fail + l := [p] + while (p := p.nxt) ~=== q do + put(l, p) + suspend !l +end + + +# follow(p, q) -- insert q to follow p (erases old path from p, draws new) + +procedure follow(p, q) + DrawLine(bgwin, p.x, p.y, (p.prv~===\p.nxt).x, p.nxt.y) + every drawpt(p | \p.nxt) + q.nxt := p.nxt + q.prv := p + (\p.nxt).prv := q + p.nxt := q + DrawLine(fgwin, p.x, p.y, q.x, q.y) + DrawLine(fgwin, q.x, q.y, (\q.nxt).x, q.nxt.y) + return q +end + + + +# flip(p, q) -- link p to q, and their successors to each other + +procedure flip(p, q) + local a, b + + DrawLine(bgwin, p.x, p.y, p.nxt.x, p.nxt.y) + DrawLine(bgwin, q.x, q.y, q.nxt.x, q.nxt.y) + # relink half of the chain backwards + a := q + while a ~=== p do { + a.prv :=: a.nxt + a := a.nxt + } + a := p.nxt + b := q.prv + p.nxt := q + q.prv := p + a.nxt := b + b.prv := a + DrawLine(fgwin, p.x, p.y, q.x, q.y) + DrawLine(fgwin, a.x, a.y, b.x, b.y) + every drawpt(p | q | a | b) + return +end + + + +# linkpath(p, q, ...) -- link points p, q, ... in order + +procedure linkpath(l[]) + local i, p, q, v + i := p := get(l) + v := [fgwin, p.x, p.y] + every q := !l do { + p.nxt := q + q.prv := p + p := q + put(v, p.x, p.y) + } + DrawLine ! v + every drawpt(i | !l) + return +end + + + + +######################### drawing ######################### + + + +# refresh() -- redraw screen to repair segments and points + +procedure refresh() + fillrect(bgwin) # erase segs + redraw() + return +end + + + +# redraw() -- redraw path without erasing + +procedure redraw() + local p + + every drawpt(!ptlist) + every p := !ptlist do + DrawLine(fgwin, p.x, p.y, (\p.nxt).x, p.nxt.y) + return +end + + + +# erasepath() -- erase path, redraw points if necessary + +procedure erasepath() + local l, p, v + + v := [bgwin] + every p := ptlist[1].prv | path() do + put(v, p.x, p.y) + DrawLine ! v + every drawpt(!ptlist) + return +end + + + +# drawpath(win, p, q) -- draw the path from p to q +# +# (of course, depending on the foreground color, this can hide a path, too.) + +procedure drawpath(win, p, q) + local v + + v := [win, p.x, p.y] + while p ~=== q do { + p := p.nxt + put(v, p.x) + put(v, p.y) + } + DrawLine ! v + return +end + + + +# drawpt(p) -- draw the single point p + +procedure drawpt(p) + FillRectangle(fgwin, p.x - 2, p.y - 2, 5, 5) + return +end + + + +# fillrect(win) -- fill the working area + +procedure fillrect(win) + FillRectangle(win, ax - m + 1, ay - m + 1, aw + 2 * m - 1, ah + 2 * m - 1) + return +end + + + +######################### reporting ######################### + + + +# listpath() -- list the coordinates of each point on standard output + +procedure listpath() + local p + + if \havepath then { + write("\point list in order of traversal:") + every listpt(path()) + } + else { + write("\point list (no path established):") + every listpt(!ptlist) + } + return +end + +# listpt(p) - list one point + +procedure listpt(p) + write(right(p.id, 3), ".", right(p.x, 5), right(p.y, 5), + right((\p.prv).id | "", 6), right((\p.nxt).id | "", 6)) + return +end + + + +# report(text) -- display statistics on screen and stdout +# +# The statistics include the delta time since lastclk was last set. +# +# Output to stdout is suppressed if the "-q" option was given. +# Output to stdout is double spaced if the set of points has changed. + +procedure report(text) + local p, n, d, s, dt + + dt := ((((&time - lastclk) / 1000.0) || "000") ? (tab(upto(".")) || move(3))) + s := right(*ptlist, 4) || " pts " + + if \havepath then { + d := 0 + every p := !ptlist do + d +:= dist(p, p.nxt) + d := (d + 500) / 1000 + s ||:= right("d = " || d, 10) + } + else + s ||:= " " + + s ||:= right(dt , 8) || " sec " || text + + status(s) + if /opts["q"] then { + if \newpts then + write() + write(s) + } + newpts := &null + return +end + + +# status(s) -- write s as a status message + +procedure status(s) + EraseArea(win, m + bw + m, m + h - fh) + GotoXY(win, m + bw + m, m + h - (fh / 4)) + writes(win, s) + return +end |