ftp.cs.arizona.edu/ftp.cs.arizona.edu.tar/ftp.cs.arizona.edu/icon/newsgrp/group91b.txt

Internet Message Format | 1991-06-13 | 436KB

From [e-mail]  Mon Apr  1 15:58:46 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 1 Apr 91 15:58:46 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA27326; Mon, 1 Apr 91 15:58:43 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 1 Apr
 1991 15:58 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA10724; Mon, 1 Apr 91 05:45:50
 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 1 Apr 1991 15:58 MST
Date: 1 Apr 91 08:09:44 GMT
From: haven!ni.umd.edu!uc780.umd.edu![e-mail]
Subject: RE: Survey Results : Perl vs Icon vs .... (> 500 line
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: The University of Maryland University College
References: <[e-mail]>,
 <[e-mail]>

Richard Goerwitz writes:
>I'm curious why it is that you would see any advantage in run-time
>loading other than decreased in-core mem. reqs.  If you were to use the
>Icon compiler (i.e. Icon->C translator), you wouldn't even have to
>worry about adding any code to any run-time system.

Well, I don't Icon, but I'm willing to put my foot in my mouth
anyways...

(1)  If you compile an entire application, you lose the
maintainability that the {Icon} environment provides.

(2) If you have some method of adding new primitives (accessible as
proper objects of your system) you suddenly make it possible to use
{Icon} for commercial applications (e.g. where speed is important).

Also note that it should be considered in good taste to provide, along
with any object code, the {Icon} work-alike "source" so that a year or
two down the road when somebody else wants to know what this thing is
doing they can figure it out.  If you GPL, you'd want to keep around
the intermidiate language source as well.

Raul Rockwell

From [e-mail]  Mon Apr  1 16:03:25 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 1 Apr 91 16:03:25 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA27431; Mon, 1 Apr 91 16:03:22 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 1 Apr
 1991 16:02 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA02529; Sun, 31 Mar 91
 22:06:28 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 1 Apr 1991 16:03 MST
Date: 1 Apr 91 04:33:21 GMT
From: midway!ellis.uchicago.edu![e-mail] (Richard L. Goerwitz)
Subject: RE: Survey Results : Perl vs Icon vs .... (> 500 lines)
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

We've seen an excellent summary of Icon's benefits and deficits, and I
think it is a good one (especially considering that the person in
question was only doing an initial survey).  Let me comment on some of
the conclusions reached in efforts to refine them, and ask some
question of my own.

In <[e-mail]> Stephen J Bevan writes (re-
garding Icon), that it has

> -  no packages.  Everything is in one namespace.  However ...

The "however" is for Idol, I gather.  For people who don't want to add
yet another level of indirection to their Icon programs, though, naming
conflicts remain a problem.

>-  no exceptions.

Have you looked at the Icon "error conversion" capability?  Normally,
run-time errors will result in program termination.  You can, however,
turn off this feature, and catch the errors yourself, either passing
them through an exception handler, or else passing them back to the
normal termination routine via runerr().  It's not an elegant system,
since every expression that might normally cause error termination has
to be checked individually.  I wonder if there are plans to expand
this feature.

> +  Object oriented features.
>    An extension to the language called Idol is included.
>    This converts Idol into standard Icon.
>    Idol itself looks (to me) like Smalltalk.
> +  has records.  Other types include :- sets, lists, strings, tables
> +  unlimited line length when reading
>    (Note. the newline is discarded)
> !  The only language that has enough facilities to be able to re-write
>    some of my Lex/Yacc code.
> +  stack trace on error.
> +  C interface is good.  Can extend the language by building `personal
>    interpreter'.  No dynamic linking.
> +  extensive documentation
>    9 technical reports in all (PostScript and ASCII)

> -  Unix interface is quite primitive.
>    If you just want to use a command, you can use `callout', anything
>    more complicated requires building a personal interpreter (not as
>    difficult as it may sound)

It is quite true that Icon does not provide a good low-level interface
with the operating system.  Moreover this is unlikely to change, since
one of the great aims of Icon has been to keep it portable.  Luckily,
customization (as you note) is not as difficult as it might seem.

> +  extensive test suite
> +  Usenet group exists specifically for it - comp.lang.icon
>
> -  Unless you use Idol, all procedures are at the same level
>    i.e. one scope.
> -  regular expressions not supported.
>   However, in many cases, you can use an Icon functions `find',
>   `match', `many' and `upto' instead.

"In many cases" ain't so.  ANY pattern representable by regular
expressions can also be represented via Icon's builtin string
processing control structures and functions.

I note, though, that many still want regular expressions.  The
reason usually given for NOT including them is that they lack
sufficient power.  In point of fact, they represent a miniscule subset
of the range of patterns that can be specified using Icon's native
facilities.  The advantage they would bring is that they would allow
far greater recognition speed for those patterns which can be
recognized via regular expressions, and that they would allow much
more compact expression of these patterns than can be achieved with
Icon's intrinsic functions.

Until someone does it *right*, I've written a prototype findre()
function, which is in one of the more recent IPL updates.  It
essentially combines Icon's find() function with an egrep-style
FSTN-description language.  Ideally, someone should write this in C.
Let's fool with the prototype for a while until we know exactly what
we want, and then let's try to talk some poor soul into coding it up
as part of the Icon run-time system.  A matchre() function should also
be added as well.

> +  Can trace execution.
> *  Pascal/C-like syntax
>    i.e. uses {} but has a few more keywords than C.
> +  lots of example programs included.
> +  can define your own iterators
>    i.e. your own procedures for iterating through arbitrary structures.
> +  co-expressions.  Powerful tool, hard to explain briefly.  See
>    chapter 13 of the Icon Programming Language.

> -  co-expressions haven't been implemented on Sun 4s (the type of
>    machine I use)

Please correct me if I'm wrong, but I believe I saw the coexpression
code for the Sun4 posted almost a year ago.

> +  has an `initial' section in procedures that is only ever executed
>    once and allows you to initialise C like static variables with the
>    result of other functions (unlike C).
> +  arbitrary precision integers.

Wish list:

> E.2.4 Add a regular expression data type.  Modify the functions find
>       and match to perate appropriately when their first argument is a
>       regular expression.

I'd modify this to say, add findre() and matchre() to the list of
builtin functions.  Most C libraries have regexp routines that can be
drafted to serve in these capacities.  I know that regular expression
don't fit into the traditional image of what Icon string processing
has always been.  Practical advantages of speed and compactness,
though, far outweigh this supposed disadvantage, and would make Icon
much more useful for many real-world tasks.

> E.2.5 \  All of these suggest extending
> E.5.4  | the string scanning facilities to
> E.5.5 /  cope with files and strings in a uniform way.

Not sure what you mean.

> E.12.1 Provide a way to load functions (written in C) at runtime

My impression is that inclusion of this feature would be
hopelessly implementation dependent, and would dramatically increase
the complexity of maintaining the many implementations that exist.
I'm curious why it is that you would see any advantage in run-time
loading other than decreased in-core mem. reqs.  If you were to use the
Icon compiler (i.e. Icon->C translator), you wouldn't even have to
worry about adding any code to any run-time system.
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Mon Apr  1 22:27:16 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 1 Apr 91 22:27:16 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA01885; Mon, 1 Apr 91 22:27:14 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 1 Apr
 1991 22:26 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA09229; Mon, 1 Apr 91 21:22:58
 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 1 Apr 1991 22:26 MST
Date: 1 Apr 91 11:50:48 GMT
From: mcsun!ukc!mucs!m1![e-mail] (Stephen J Bevan)
Subject: Icon (was Re: Survey Results : Perl vs Icon vs ... ))
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Department of Computer Science, University of Manchester
References: <[e-mail]>

In <[e-mail]> Richard L. Goerwitz
writes :-

>> -  no packages.  Everything is in one namespace.  However ...
>
>The "however" is for Idol, I gather.  For people who don't want to add
>yet another level of indirection to their Icon programs, though, naming
>conflicts remain a problem.

I was thinking about the indirection stuff myself, however I received
a message from Clinton Jeffery <[e-mail]> about Idol
and in it he says :-

``... its method lookup is a constant time operation unlike Smalltalk's''

I'm not exactly sure how this is achieved, but maybe it removes some
of the worries about slow execution.

>>-  no exceptions.
>
>Have you looked at the Icon "error conversion" capability?

No this one slipped me by.

>> -  regular expressions not supported.
>>   However, in many cases, you can use an Icon functions `find',
>>   `match', `many' and `upto' instead.
>
>"In many cases" ain't so.  ANY pattern representable by regular
>expressions can also be represented via Icon's builtin string
>processing control structures and functions.

Excuse the poor phrasing on my part.  I didn't mean to imply that Icon
couldn't handle the expressions.  What I meant was that in a lot of
cases, you can replace a regexp with one of the above functions, and
in all cases, you can replace it with a combination of the above.

>> -  co-expressions haven't been implemented on Sun 4s (the type of
>>    machine I use)
>
>Please correct me if I'm wrong, but I believe I saw the coexpression
>code for the Sun4 posted almost a year ago.

You are right, I've only been reading comp.lang.icon for about month
and so wasn't aware of it.  All I can say is that the copy of Icon v8
I retrieved, explicitly mentioned the fact that co-expressions didn't
work on Sun4s.  I assume the code will be in the next release.

>> E.2.4 Add a regular expression data type.  Modify the functions find
>>       and match to perate appropriately when their first argument is a
>>       regular expression.
>
>I'd modify this to say, add findre() and matchre() to the list of
>builtin functions.  Most C libraries have regexp routines that can be
>drafted to serve in these capacities.

Well after spending a day adding regular expressions to ELK, I
wouldn't be so sure about the regexp facilies of C libraries.  For
example the regexp library with SunOS 4.1 only has ed/grep style
regular expression, not egrep ones.  I therefore used the GNU regexp
code which implements Emacs like regexps i.e. egrep standard, but with
different quoting conventions.  This works well for me as I've written
more Emacs Lisp code than egrep/awk code.  If you prefer the standard
egrep style, I'd recommend Henry Spencer's regexp code. (This is used
by both Python and TCL, in slightly modified forms)

>> E.2.5 \  All of these suggest extending
>> E.5.4  | the string scanning facilities to
>> E.5.5 /  cope with files and strings in a uniform way.
>
>Not sure what you mean.

Well to quote ``The Implementation of the Icon Programming Language''
by Ralph E. Griswold and Madge T. Griswold :-

E.2.5
``Unify string and file data types so that string operations can be
performed on files.''

E.4.1 (this is E.5.4 refered to above.  There is a typo in the book
which refers to E.4 as 5.4.  This was somehow further mangled by me to
produce E.5.4!)
``Many problems that should be easy to deal with using string scanning
are complicated by the fact that the data to be processed is contained
in a file that consists of a sequence of lines that logically
constitute a single string. ...''

E.4.2 (this was E.5.5, reason as above)
``Extend string scanning to apply to files''

This topic is also mentioned in a recent post by David Gudeman in
alt.lang.cfutures

>> E.12.1 Provide a way to load functions (written in C) at runtime
>I'm curious why it is that you would see any advantage in run-time
>loading other than decreased in-core mem. reqs.

Maybe you should ask Madge or Ralph Griswold, it's in their book!
Personally, I thought it would be useful for the reason you mention
i.e.  you only load what you need.  However given the following I
don't think it is necessary :-

>If you were to use the Icon compiler (i.e. Icon->C translator), you
>wouldn't even have to worry about adding any code to any run-time
>system.

I knew that an Icon compiler was been developed, but I didn't actually
know that it was available until after I posted.  Personally I
wouldn't be looking for an increase in speed (although its alway
welcome, even on a SPARCstation!), I'd be more interested in the C
interface i.e. how easy would it be to add extensions like, for
example, dbm support?  (note. that was a rhetorical question)

Stephen J. Bevan            [e-mail]

From [e-mail]  Wed Apr  3 06:12:10 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 3 Apr 91 06:12:10 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Osprey.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA19634; Wed, 3 Apr 91 06:12:08 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 3 Apr
 1991 06:11 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA29165; Wed, 3 Apr 91 04:55:54
 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 3 Apr 1991 06:11 MST
Date: 3 Apr 91 09:27:21 GMT
From: eru!hagbard!sunic!mcsun!hp4nl!charon![e-mail] (Guido
 van Rossum)
Subject: RE: Survey Results : Perl vs Icon vs .... (> 500 lines)
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
References: <[e-mail]>,
 <[e-mail]>

Richard L. Goerwitz replies to Stephen Bevan, regarding Icon:

Bevan:
>> -  Unix interface is quite primitive.
>>    If you just want to use a command, you can use `callout', anything
>>    more complicated requires building a personal interpreter (not as
>>    difficult as it may sound)

Goerwitz:
>It is quite true that Icon does not provide a good low-level interface
>with the operating system.  Moreover this is unlikely to change, since
>one of the great aims of Icon has been to keep it portable.  Luckily,
>customization (as you note) is not as difficult as it might seem.

I don't buy the argument that you can't provide a good Unix interface
because of portability.

Python is designed to be just as portable as Icon (runs on the Mac,
for starters) but its Unix interface is quite good (and will improve).
The trick is that all the Unix dependencies are encapsulated in a
separate module.  Unix dependent applications won't run on non-Unix
systems, but then they are probably not needed there either.  Many
applications and library modules can be (and are!) written without the
use of explicit Unix features.  Of course, the standard I/O interface
exists on all systems.

There is no excuse for not providing a decent Unix interface for a
language that runs under Unix.  Leaving it up to local initiative
("customization") is fatal for portability.

--Guido van Rossum, CWI, Amsterdam <[e-mail]>
"Life's gotta be more than meeting pretty faces and sitting on them"

From [e-mail]  Wed Apr  3 11:44:25 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 3 Apr 91 11:44:25 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Osprey.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA00221; Wed, 3 Apr 91 11:44:22 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 3 Apr
 1991 11:43 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA07914; Wed, 3 Apr 91 10:35:38
 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 3 Apr 1991 11:43 MST
Date: 3 Apr 91 15:11:53 GMT
From: midway!ellis.uchicago.edu![e-mail] (Richard L. Goerwitz)
Subject: RE: Survey Results : Perl vs Icon vs .... (> 500 lines)
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>,
 <[e-mail]>, <[e-mail]>

In article <[e-mail]> [e-mail] (Guido van Rossum) writes:
>
>>> -  [the Icon-]Unix interface is quite primitive.
>>>    If you just want to use a command, you can use `callout', anything
>>>    more complicated requires building a personal interpreter (not as
>>>    difficult as it may sound)
>
>Goerwitz:
>>It is quite true that Icon does not provide a good low-level interface
>>with the operating system.  Moreover this is unlikely to change, since
>>one of the great aims of Icon has been to keep it portable....
>
>I don't buy the argument that you can't provide a good Unix interface
>because of portability.
>
>Python is designed to be just as portable as Icon (runs on the Mac,
>for starters) but its Unix interface is quite good (and will improve).
>The trick is that all the Unix dependencies are encapsulated in a
>separate module.  Unix dependent applications won't run on non-Unix
>systems, but then they are probably not needed there either.

What is portability?  Portability doesn't just involve the compiler or
interpreter itself.  It's a property of code written for it as well.
Why?  Because the code is as important as the language tools themselves.
What good is it, say, to be make it easy to reimplement a compiler for
more than one system when code written for that compiler will present
a horrendous problem?

Portability is also not just a theoretical thing.  The proof is in the
pudding.  How many platforms is Python actively used on?  Here's a list
for Icon.  Note that most programs will run practically unaltered on
each of the listed platforms.  Do you know of any language for which a
similar claim could be made for so many machines and operating systems?

    MS-DOS
    OS/2
    Mac (MPW and standalone)
    Atari
    Apollo (AEGIS)
    IBM 370 (MVS/XA and VM/CMS)
    Amiga
    DEC VAX (8650, running VMS)

And for Unix-oids:

    BSD 4.3
    SunOS 4.0
    Ultrix
    AIX
    Xenix
    Mach (on the NeXT)
    SYSVR3 (4 also?)

This is just what I can think of offhand.  There are probably others as
well.

>There is no excuse for not providing a decent Unix interface for a
>language that runs under Unix.  Leaving it up to local initiative
>("customization") is fatal for portability.

I'm not sure, but I think you've got this backwards.  Customization
*creates* nonportability.  Still, I think you are right that languages
need a good OS interface in order to be useful for certain types of
tasks.  The question is, "What features would you regard as vital for
work in a Unix environment?"  I'll be curious to see your answer.
Mine would be:

    ability to call C functions
    ability to store C pointers for calls to C functions
    built-in support for conversion from Icon to C types
    intrinsic fork()/exec()/wait() ability
    intrinsic ability to work with pipes
    intrinsic system() function

These would be the basic things I'd want.  Icon has three of them.  It
lacks the other two.  Yet another it partially implements, but the inter-
face is nontrivial for complex objects (I'm talking about Icon->C type
conversions).

-Richard ([e-mail])
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From @um.cc.umich.edu:[e-mail]  Wed Apr  3 19:02:53 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 3 Apr 91 19:02:53 MST
Received: from umich.edu by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA00116; Wed, 3 Apr 91 19:02:49 -0700
Received: from um.cc.umich.edu by umich.edu (5.61/1123-1.0)
    id AA22765; Wed, 3 Apr 91 18:26:36 -0500
Received: from MTS.cc.Wayne.edu by um.cc.umich.edu via MTS-Net; Wed, 3 Apr 91 18:20:17 EST
Date: Wed, 3 Apr 91 18:20:20 EST
From: [e-mail]
To: [e-mail]
Message-Id: <[e-mail]>
Subject: Using the ``map'' function


In doing the index for my latest book, I need to sort the entries using a
nonstandard collating sequence.  I therefore need a ``keytrans'' function
that transforms a sorting key to a key that uses the correct collating
sequence.  Here's the obvious way to do it in Icon:

procedure keytrans(key)
   static collator
   initial {collator := ...} # printable chars in collating sequence order
   return map(key, collator, &ascii[33:128])
end

This is simple but slow since the map must be regenerated for each key.
Here's the other way:

procedure keytrans(key)
   static collator, lookup
   initial {
      collator := ...
      lookup = map(&ascii[33:128], collator, &ascii[33:128])
      }
   local c, retval
   retval := ""
   every c := !key do
      retval ||:= lookup[ord(c) - 31]
   return retval
end

This is inelegant but fast.

Is there any way I can have my cake and eat it too?  I wouldn't mind a small
loss in speed, but the difference here seems pretty big.

Paul Abrahams
[e-mail]

From [e-mail]  Wed Apr  3 19:52:34 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 3 Apr 91 19:52:34 MST
Received: from relay.metaphor.com by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA01041; Wed, 3 Apr 91 19:52:27 -0700
Received: from laguna.Metaphor.COM by relay.metaphor.com (4.1/SMI-4.1)
    id AA00313; Wed, 3 Apr 91 18:47:42 PST
Received: by laguna.Metaphor.COM (4.0/SMI-4.0)
    id AA09079; Wed, 3 Apr 91 18:51:32 PST
Date: Wed, 3 Apr 91 18:51:32 PST
From: [e-mail] (Bob Alexander)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: Re:  Using the ``map'' function
Cc: [e-mail]

Hi Paul --

In your initial procedure (the slow one) it's likely that much of the
time used in repeatedly executing

       return map(key, collator, &ascii[33:128])

is due to the fact that every call converts the cset, &ascii, to a
string.

Also, there is an optimization in the iconx code for map() such that
the internal translation table is not rebuilt if the second and third
arguments are the same (i.e. identical descriptors) as for the previous
map() call.  That optimization cannot be used in your proc.

Given all that, I'll bet this will execute a lot faster (the proof is
left to the reader :)

    procedure keytrans(key)
       static collator, ascii
       initial {
          collator := ...
          ascii := &ascii[33:128]
       }
       return map(key, collator, ascii)
    end

-- Bob Alexander

Metaphor Computer Systems   [phone] x751   [e-mail]
====^=== Mountain View, CA  ...{uunet}!{decwrl,apple}!metaphor!alex

From [e-mail]  Wed Apr  3 21:57:43 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 3 Apr 91 21:57:43 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Osprey.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA02486; Wed, 3 Apr 91 21:57:41 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 3 Apr
 1991 21:57 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA25670; Wed, 3 Apr 91 20:50:57
 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 3 Apr 1991 21:57 MST
Date: 4 Apr 91 03:40:38 GMT
From: att!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: bits -> bytes
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago

Perhaps I'm opening a can of worms, like I did with the last such
posting ("terrible code").  Anyway, I just wrote a section of code
for some compression work I'm doing, and I just don't like the
looks of it.  Is there a clearer and/or more efficient way of do-
ing this sort of thing in Icon??

-Richard

(what sort of thing I'm talking about will shortly become clear;
behold the code -)

#
#  outbits() & inbits()
#
#  Pass to outbits(i, len) an integer i, and a length parameter (len),
#  and outbits will suspend byte-sized chunks of i converted to
#  characters (most significant bits first) until there is not enough
#  left of i to fill up an 8-bit character.  The remaining portion is
#  stored in a buffer until outbits() is called again, at which point
#  the buffer is combined with the new i and then output in the same
#  manner as before.  The buffer is flushed by calling outbits() with
#  no i argument.
#
#  A trivial example of how outbits() might be used:
#
#      outtext := open("some.file.name","w")
#      l := [1,2,3,4]
#      every writes(outtext, outbits(!l,3))
#      writes(outtext, outbits(&null,3))           # flush buffer
#
#  List l may be reconstructed with inbits() (see inbits.icn):
#
#      intext := open("some.file.name")
#      l := []
#      while put(l, inbits(intext, 3))
#
#  Note that outbits() is a generator, while inbits() is not.
#

procedure outbits(i, len)

    local old_part, new_part, window, old_byte_mask
    static old_i, old_len, byte_length, byte_mask
    initial {
    old_i := old_len := 0
    byte_length := 8
    byte_mask := (2^byte_length)-1
    }

    old_byte_mask := (0 < 2^old_len - 1) | 0
    window := byte_length - old_len
    old_part := ishift(iand(old_i, old_byte_mask), window)

    # If we have a no-arg invocation, then flush buffer (old_i).
    if /i then {
    old_i := old_len := 0
    return char(old_part)
    } else {
    new_part := ishift(i, window-len)
    len -:= (len >= window) | {
        old_len +:= len
        old_i := ior(ishift(old_part, len-window), i)
        fail
    }
    suspend char(ior(old_part, new_part))
    }

    until len < byte_length do {
    suspend char(iand(ishift(i, byte_length-len), byte_mask))
    len -:= byte_length
    }

    old_len := len
    old_i := i
    fail

end


procedure inbits(f, len)

    local i, byte, old_byte_mask
    static old_byte, old_len, byte_length
    initial {
    old_byte := old_len := 0
    byte_length := 8
    }

    old_byte_mask := (0 < 2^old_len - 1) | 0
    old_byte := iand(old_byte, old_byte_mask)
    i := ishift(old_byte, len-old_len)

    len -:= (len > old_len) | {
    old_len -:= len
    return i
    }

    while byte := ord(reads(f)) do {
    i := ior(i, ishift(byte, len-byte_length))
    len -:= (len > byte_length) | {
        old_len := byte_length-len
        old_byte := byte
        return i
    }
    }

end
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Fri Apr  5 16:04:36 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 5 Apr 91 16:04:36 MST
Received: from relay.metaphor.com by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA09355; Fri, 5 Apr 91 16:04:34 -0700
Received: from laguna.Metaphor.COM by relay.metaphor.com (4.1/SMI-4.1)
    id AA00534; Fri, 5 Apr 91 14:59:48 PST
Received: by laguna.Metaphor.COM (4.0/SMI-4.0)
    id AA10400; Fri, 5 Apr 91 10:53:52 PST
Date: Fri, 5 Apr 91 10:53:52 PST
From: [e-mail] (Bob Alexander)
Message-Id: <[e-mail]>
To: eru!kth.se!sunic!mcsun!ukc!mucs!m1![e-mail]
Subject: Re: Survey Results
Cc: [e-mail]

I read your language survey with great interest, since (1) I'm also
currently in the process of surveying languages for a particular use,
and (2) I'm an Icon fan, user, and implementor.

Regarding (1), you've done a really nice job of researching the
languages and sharing your findings -- my interest is piqued to further
investigate a couple of new languages.  Thanks.

Regarding (2), I watched the icon-group traffic stimulated by your
posting, and noticed a couple of area that might not have been
covered.  So here are my additions:

> -  Unix interface is quite primitive.
>    If you just want to use a command, you can use `callout', anything
>    more complicated requires building a personal interpreter (not as
>    difficult as it may sound)

I'm not sure just what constitutes a good UNIX interface, but Icon has
great access to "commands" via subshells.  It has a system() function
just like C, and has popen() access for both reading and writing via
the "p" option of the Icon open() function.  "callout" was really
intended for adding C functions to Icon, not for access to UNIX
"commands".  (However, if what you intended by the term "commands" is
UNIX system calls, I agree the built-in interface is weak, although
some of that sort of work can be done through subshell commands).

> +  can define your own iterators
>    i.e. your own procedures for iterating through arbitrary structures.

Merely the tip of the generator/goal-directed iceberg :-)!

>     The Icon Programmming Language
>     Ralph E. Griswold and Madge T. Griswold
>     Prentice Hall 1983

There's a second edition of the excellent "Icon Book" that is even
bigger and better than the original:

Griswold, Ralph E. and Madge T. Griswold.  "The Icon Programming
Language, Second Edition", Prentice-Hall, Inc., Englewood Cliffs, New
Jersey.  1990.

-- Bob Alexander

Metaphor Computer Systems   [phone] x751   [e-mail]
====^=== Mountain View, CA  ...{uunet}!{decwrl,apple}!metaphor!alex

From [e-mail]  Sat Apr  6 04:19:06 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Sat, 6 Apr 91 04:19:06 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Osprey.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA21193; Sat, 6 Apr 91 04:19:04 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sat, 6 Apr
 1991 04:18 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA16343; Sat, 6 Apr 91 03:12:14
 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sat, 6 Apr 1991 04:18 MST
Date: 5 Apr 91 14:22:37 GMT
From: eru!hagbard!sunic!mcsun!ukc!mucs!m1![e-mail] (Stephen J
 Bevan)
Subject: Portability (was Re: Survey Results : Perl vs Icon vs ...)
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Department of Computer Science, University of Manchester
References: <[e-mail]>

> What is portability?  Portability doesn't just involve the compiler or
> interpreter itself.  It's a property of code written for it as well.

If we are talking about the base language, then I'd agree with this.
However, if you have a decent module system (like Python) you can put
system specific features in separate modules.  i.e if you are running
under Amoeba, you can use the Amoeba module, if you are running on a
Mac, you can use the Mac module.  BTW I'm not saying the modules have to
impement the same thing, rather they take advantage of the facilties
of the machine.

Where's the portability problem?

Stephen J. Bevan            [e-mail]

From ksr!ksr.com![e-mail]  Sun Apr  7 11:20:37 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 7 Apr 91 11:20:37 MST
Received: from relay1.UU.NET by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA06775; Sun, 7 Apr 91 11:20:35 -0700
Received: from ksr.UUCP by relay1.UU.NET with UUCP
    (5.61/UUNET-shadow-mx) id AA06792; Sun, 7 Apr 91 14:20:31 -0400
Received: from kaos.ksr.com by ksr.com (4.0/SMI-3.2)
    id AA24983; Sat, 6 Apr 91 18:23:38 EST
Received: by kaos.ksr.com (4.0/SMI-3.2)
    id AA19070; Sat, 6 Apr 91 18:23:37 EST
Message-Id: <[e-mail]>
To: [e-mail]
Subject: Bignum bug in Icon Version 8
Date: Sat, 06 Apr 91 18:23:36 EST
From: Tim Peters <[e-mail]>

Attempting to add the most negative native integer to a bignum causes an
"Illegal instruction" trap on our SPARC (Solbourne, pretty much
equivalent to a Sun-4) installation of Icon V8.

Following is a terminal session showing the problem:

kaos 338= cat bug.icn
procedure main()
   local i, j
   write( "host: ", &host )
   write( "version: ", &version )
   write( "features:" )
   every write( "   ", &features )

   i := -2147483647
   i -:= 1
   j := 6103515625
   write(i," ",j)
   i +:= j
end
kaos 339= /usr/local/lib/icon/v8/bin/icont -u bug -x
Translating:
bug.icn:
  main (521/15000)
No errors
Linking:
Executing:
host: kaos
version: Icon Version 8.0.  May 7, 1990
features:
   UNIX
   ASCII
   co-expressions
   direct execution
   environment variables
   error trace back
   executable images
   expandable regions
   external functions
   large integers
   math functions
   memory monitoring
   pipes
   string invocation
   system function
-2147483648 6103515625
Illegal instruction
kaos 340= echo $?
132
kaos 341=

There's a longish (perhaps a second) pause between the output of i & j
and the "Illegal instruction" trap, leading me to believe that Icon has
gotten horribly confused.

Note that i is -2^31, the most negative native integer on this "long
ints are 4 bytes" machine.  The problem does not occur for other values
of i (well, I didn't try *all* possible values ... <grin>), and goes
away if i is intialized via

  i := -2147483648

instead.  Indeed, *most* plausible ways of setting i to -2^31 make the
problem go away:  I assume the code sequence in the test case is special
only in that it causes i to "look like" a native integer internally,
while most other ways cause i to look like a bignum internally.

Finally, I doubt this is a local installation problem, because I've used
Icon's bignums extensively over several months, and this is the first
major error I've stumbled into.

If I can be of any further assistance in tracking this down, please let
me know.

one-of-icon's-admirers-ly y'rs  - tim

Tim Peters   Kendall Square Research Corp
[e-mail],  ksr![e-mail]

From @um.cc.umich.edu:[e-mail]  Sun Apr  7 20:17:10 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 7 Apr 91 20:17:10 MST
Received: from umich.edu by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA03010; Sun, 7 Apr 91 20:17:07 -0700
Received: from um.cc.umich.edu by umich.edu (5.61/1123-1.0)
    id AA28022; Sun, 7 Apr 91 23:17:01 -0400
Received: from MTS.cc.Wayne.edu by um.cc.umich.edu via MTS-Net; Sun, 7 Apr 91 23:11:32 EDT
Date: Sun, 7 Apr 91 23:11:42 EDT
From: [e-mail]
To: [e-mail]
Message-Id: <[e-mail]>
Subject: Efficiency of the `map' function


Thanks to all for your informative comments about the efficiency
of the map function.  I had guessed that it might do some caching
of its arguments.  I'm glad to hear that it really does and in
particular that its cache can hold more than one item.

I'm still wondering, though, how the map cache works and what its
capacity is.  Is the cache associated with each call or is it
global over the program?  It seems pretty difficult to get a
decent implementation of map without a cache, since each call
requires processing every character in the second argument and
possibly in the third as well.  There does seem to be a hazard
here: writing calls on map that aren't cached and therefore take
a long time to execute.  Not knowing the caching policy, it would
be easy for someone (like me) to inadvertently write a noncached
map call.

There's a deeper issue buried here, what some have called
`performance transparency'.  It's the property of a programming
language that enables a programmer to gauge the relative costs of
different constructs.  Certainly someone familiar with the
innards of the Icon implementation can gauge these costs, but as
someone who isn't familiar with the innards, I've always found
that difficult.

Paul Abrahams
[e-mail]

From @um.cc.umich.edu:[e-mail]  Sun Apr  7 20:17:30 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 7 Apr 91 20:17:30 MST
Received: from umich.edu by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA03020; Sun, 7 Apr 91 20:17:28 -0700
Received: from um.cc.umich.edu by umich.edu (5.61/1123-1.0)
    id AA28042; Sun, 7 Apr 91 23:17:22 -0400
Received: from MTS.cc.Wayne.edu by um.cc.umich.edu via MTS-Net; Sun, 7 Apr 91 23:13:00 EDT
Date: Sun, 7 Apr 91 23:13:06 EDT
From: [e-mail]
To: [e-mail]
Message-Id: <[e-mail]>
Subject: Plusses and minuses of Icon


I've been following with interest the discussion about the
plusses and minuses of Icon.  My own view is that we shouldn't
expect a single programming language to be the best one around
for absolutely everything, any more than we expect that of other
fine tools.  Icon is superb for prototyping medium-size programs,
for quick and dirty solutions, and for symbol manipulation tasks,
especially those where goal-directed evaluation helps.  Examples
of tasks where I've found it beyond compare are an index
generation program for a book, a bootstrap version of a compiler,
and a printer-specific simulator of the IBM Script document
formatter.  Moreover, its internal structure and its superb
engineering make it a pleasure to use.

At the same time I cannot imagine that Icon would *ever* be the
language of choice for, say, writing a disk caching program in a
competitive commercial environment where the name of the game is
coming out first in the PC Magazine speed comparisons.  Nor can I
imagine it being used for writing a million-line spaceship
control program.  Two of its limitations are the inherent
efficiency of its code and the weakness of its global packaging
mechanisms.

The proponents of nearly every language I know seem to feel that
criticism of the language for a particular application implies
criticism of the language in general.  I think that feeling is
misplaced.  With respect to Icon in particular, a very useful
activity would be to try to spell out the scope of tasks at which
Icon excels without attempting to make that scope universal.
There are few language around that are as good at *anything* as
Icon is at the tasks for which it is suited.

Several people have argued that Idol solves the global packaging
problem.  That argument is in a sense irrelevant, for reasons
that have nothing to do with the intrinsic merits of Idol.  Idol
is not Icon; if we're talking about Icon, then let's leave Idol
out of it.  Perhaps Idol is the natural direction in which Icon
should evolve, and perhaps Idol will turn out to be Icon 9.0 (or
n.0).  But Idol does not as yet have the wide distribution, the
supporting structure, or the backlog of experience that Icon
does.  This is in no way a criticism of it or even a statement
about the limitations of its future.  If we're discussing the
merits of languages, let's keep our languages straight.


Paul Abrahams
[e-mail]

From [e-mail]  Mon Apr  8 15:34:51 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 8 Apr 91 15:34:51 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA28894; Mon, 8 Apr 91 15:34:49 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 8 Apr
 1991 15:34 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA15549; Mon, 8 Apr 91 12:49:54
 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 8 Apr 1991 15:34 MST
Date: 8 Apr 91 09:45:22 GMT
From: mcsun!hp4nl!charon![e-mail] (Guido van Rossum)
Subject: RE: Survey Results : Perl vs Icon vs .... (> 500 lines)
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
References: <[e-mail]>, <[e-mail]>,
 <[e-mail]>

[e-mail] (Richard L. Goerwitz) writes:

>What is portability?  Portability doesn't just involve the compiler or
>interpreter itself.  It's a property of code written for it as well.
>Why?  Because the code is as important as the language tools themselves.
>What good is it, say, to be make it easy to reimplement a compiler for
>more than one system when code written for that compiler will present
>a horrendous problem?
>
>Portability is also not just a theoretical thing.  The proof is in the
>pudding.  How many platforms is Python actively used on?  Here's a list
>for Icon.  Note that most programs will run practically unaltered on
>each of the listed platforms.  Do you know of any language for which a
>similar claim could be made for so many machines and operating systems?

If I understand you well, you can make this claim for Icon because
Icon forbids things that are inherently system-dependent.  This means
that probably a host of programs that would benefit from Icon's
high-level problem-solving abilities won't be written in Icon because
it lacks the low-level interfaces needed to gather the data or
whatever.

True, if a program opens a pipe and forks off a process that calls
sendmail it won't be portable to the Mac.  But forbidding such things
even when the OS provides the functionality forces the author to use a
non-portable solution anyway (such as writing a shell script wrapper
around an Icon program).  I argue that if the language at least allows
you to make non-portable OS calls, users are better off -- of course
assuming standard modularization techniques are available to isolate
non-portable portions of programs, and encouraging portable solutions
where they exist.

>[list of platforms on which Ican is used deleted]

I don't really want to engage in "mine is longer than yours" contests,
but just for the record: Python is out only two months now and has
already been ported to all of the Unix platforms you mention (plus
hpux) and some of the micro ones (Mac, MS-DOS, Atari ST).  I don't
claim that all Python programs run on all platforms, because some
platforms don't provide some built-in modules, but Python programs
that don't use system-dependent modules will run everywhere
without change.  The crux is that a non-portable Python program is
immediately recognizable because it imports a system-dependent module.
Also note that Python provides uniform interfaces for OS-dependent
features that are available on many systems but not all -- if you have
a symbolic link system call, it will be called posix.symlink().
Programs can dynamically test for the presence of such features (which
is unly useful if they have a way of handling their absence).

>[...]  Still, I think you are right that languages
>need a good OS interface in order to be useful for certain types of
>tasks.  The question is, "What features would you regard as vital for
>work in a Unix environment?"  I'll be curious to see your answer.
>Mine would be:
>
>    ability to call C functions
>    ability to store C pointers for calls to C functions
>    built-in support for conversion from Icon to C types
>    intrinsic fork()/exec()/wait() ability
>    intrinsic ability to work with pipes
>    intrinsic system() function

>These would be the basic things I'd want.  Icon has three of them.  It
>lacks the other two.  Yet another it partially implements, but the inter-
>face is nontrivial for complex objects (I'm talking about Icon->C type
>conversions).

You don't say which three Icon has and I don't know enough about Icon
to guess.  Python has all that you mention except fork/exec/wait and
pipes, which are easy enough to add, but since this is a one-person
project, for now I am content with system() and temporary files.

Disclaimer: maybe I seem stubborn on this point, but I have worked on
a language project where OS independence was considered so important
that the language didn't even have a primitive to open a file and read
data from it within a program.  The language didn't become a terrible
success, even though it had other properties that made it a big leap
forward from other languages...

--Guido van Rossum, CWI, Amsterdam <[e-mail]>
"Twenty years ago, Dan Bernstein would be defending Assembler against HLL's"

From [e-mail]  Tue Apr  9 05:16:51 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 9 Apr 91 05:16:51 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA00431; Tue, 9 Apr 91 05:16:49 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Tue, 9 Apr
 1991 05:16 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA15630; Tue, 9 Apr 91 05:00:44
 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Tue, 9 Apr 1991 05:16 MST
Date: 9 Apr 91 08:23:13 GMT
From: olivea!samsung!transfer!lectroid!jjmhome!smds![e-mail] (Richard
 Harter)
Subject: RE: Survey Results : Perl vs Icon vs .... (> 500 lines)
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: SMDS Inc., Concord, MA
References: <[e-mail]>,
 <[e-mail]>

In article <[e-mail]>, [e-mail] (Richard L. Goerwitz) writes:

> What is portability?  Portability doesn't just involve the compiler or
> interpreter itself.  It's a property of code written for it as well.
> Why?  Because the code is as important as the language tools themselves.
> What good is it, say, to be make it easy to reimplement a compiler for
> more than one system when code written for that compiler will present
> a horrendous problem?

There are some issues that weren't addressed in this discussion.  In
languages which have OS command capability one has to come to terms with
the fact that different OS's have differing command syntax and differing
file system syntax.  Portability of command code across OS's really implies
that the language must supply that portability.  Consider, for example,
path names.  UNIX and VMS both have a path naming system that amounts to
device - directory tree list - file name.  If the code refers to files by
path name then the language should provide a standard function to return
a correct path name from the components [or equivalent functionality].  I
am supposing here that the language is strong enough so that path name
elements are symbolic and switchable in a config file.

One can list a number of such requirements, depending on the objectives
of the language in question.  In general, however, portability of code
in the language requires that all host OS interface capability be portable
across the OS's being supported.
--
Richard Harter, Software Maintenance and Development Systems, Inc.
Net address: jjmhome!smds!rh Phone: [phone]
US Mail: SMDS Inc., PO Box 555, Concord MA 01742
This sentence no verb.  This sentence short.  This signature done.

From [e-mail]  Tue Apr  9 06:04:05 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 9 Apr 91 06:04:05 MST
Received: from mis.mcw.edu (mis3.mis.mcw.edu) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA00505; Tue, 9 Apr 91 06:03:54 -0700
Date: Tue, 9 Apr 1991 08:01 CST
From: Chris Tenaglia - 257-8765 <[e-mail]>
Subject: Comparative Languages (icon vs perl etal)
To: [e-mail]
Message-Id: <[e-mail]>
X-Organization: Medical College of Wisconsin MIS Department (Milwaukee, WI)
X-Vms-To: IN%"[e-mail]"


I run icon under VMS. I use it usually as a file filter. Typical languages
such as BASIC, FORTRAN, PASCAL, and C may generate faster running code, but
I usually find myself spending all my time fighting typed variables. VMS
has a shell language called DCL which is easy to program, but it's
interpreted and runs 10 times slower than icon in regards to file I/O.
I often find myself making DCL/icon hybrid applications. DCL offers much
faster screen I/O, so I use it to front end icon filters which are much
faster with file I/O.

As far as structured languages go, Icon has one thing to it's advantage that
all the other 'structured' languages lack. No GOTO. The other languages
preach against GOTO, yet implement it anyway. Icon doesn't even acknowledge
its existence and thus, no GOTO. In my years of Icon programming, I've never
needed a GOTO in it. Apparently it was well thought out and implemented.

There is another string handling language in the genre of icon and perl.
It's ABC. I've seen it for PC and MAC. I've heard it exists for unix, and
a VMS implementation is in the works. It's a nifty interactive environment
set up to handle strings. It doesn't have a lot of features, but it looks
like it my be a nice first programming to teach.

Chris Tenaglia (System Manager) | Medical College of Wisconsin
8701 W. Watertown Plank Rd.     | Milwaukee, WI 53226
[phone]                   | [e-mail], mcwmis!tenaglia

From [e-mail]  Tue Apr  9 09:34:26 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 9 Apr 91 09:34:26 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA01411; Tue, 9 Apr 91 09:34:23 -0700
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Tue, 9 Apr
 1991 09:33 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA20832; Tue, 9 Apr 91 08:50:52
 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Tue, 9 Apr 1991 09:34 MST
Date: 9 Apr 91 15:14:51 GMT
From: usc!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE: Comparative Languages
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>


There seems to be some misunderstanding about where Icon "fits in" in
the great scheme of programming languages.  Having worked with Icon
very intensely for several years now, I feel I can report effectively
on it, and would like to do so here.  I would only offer my standard
word of warning:  I'm trained as a philologist, and have never taken a
CS or programming course from any CS department in any university I've
attended.

First, let's speak diachronically.  How did Icon evolve?  A simple
illustration will suffice here, I think:


SNOBOL  ---->  SL5  -----\
                           \----> Icon
                           /
ALGOL  --->  Pascal  ----/


Along about '76 or so, the people at the U of Arizona working on SL5
suddenly realized that the evaluation mechanisms originally confined
to string scanning in SNOBOL could actually be generalized to the
entire language.  You might say, "Whaddya think Prolog is?"  Prolog,
though, is a somewhat constrained implementation of first order
predicate logic :-), and is foreign to most programmers (and even many
theorists).  Instead of going off on some "tangent," the people at the
U of Arizona designed a language that utilized backtracking and
goal-directed evaluation within the context of a more standard,
Algol-derived, structures.

Icon was first implemented in FORTRAN (save the barfing, please), and
then later in C (1979 or so?).  It's now one of the most widely
implemented of the "unknown" programming languages.

Okay, that's my mangled version of Icon's evolution.  Now let's talk
synchronically (i.e. typologically).

One thing I find amusing is that people often put perl and Icon in the
same category.  About all they have in common is that they are both
optimized for string handling of one kind or another.  If there is any
real relation, it's via awk, which took on a few SNOBOL-ish features
(e.g. the ~ "contains" operator).  Awk, perl, and Icon all have
associative arrays and what not, and free the user from having to
worry about storage.  Many LISP dialects, though, have these same
features, and I don't seem LISP as being all that closely related to
Icon.  Perl and awk are also regexp based, which makes them very good
at recognizing simple languages and patterns (fundamentally these are
the same).  Icon, though slower at handling these same patterns, is
much more of a general-purpose programming language, and is capable of
recognizing, and effectively parsing, patterns which cannot be handled
by your run-of-the-mill DFA.  Icon really isn't very much like perl,
except in the very, very general typological sense of being geared
for more than low-level systems programming and numerical processing.

Put in practical terms, Icon represents a successful admixture of
Prolog-like backtracking mechanisms with an Algol-like structure and
SNOBOL-inspired string handling capabilities.  It is very strictly,
but dynamically, typed, and offers conversion facilities allowing the
user to move effortlessly from char set to string to integer or real
data-types and back again.  Icon is at its best doing string
processing, parsing, data conversion, and anything involving a more
heuristic, rather than purely algorithmic, approach.  Icon is also
good for prototyping and for small jobs that would ordinarily be done
using awk.  I use Icon mainly for medium-scale indexing and
concordance programs.  I also use it for fairly large-scale text
retrieval engines and for things like semiautomatic collation of
manuscripts, and linguistic analysis of ancient textual corpora.

Icon is clearly at its worst doing anything that requires close
interface with the hardware or operating system, or which requires
pointer-based access to memory locations.  Icon has no pointers, so
there is just no way to "get at" anything on this low a level without
dipping down into its C interface.  Icon also lacks OS-specific I/O
capabilities (e.g. under Unix there is no support for terminfo or
termio-based I/O, and interfacing the curses library to it is clumsy,
due to Icon's inability to store C pointers without kludges like
casting them to ints, and then converting them to its integer data
type).  If some solution to these problems could be found, Icon would
become viable for commercial software systems.  As yet, it can be used
for certain such projects.  It is, however, not suitable for many
others.

Icon is popular among people in the liberal arts, specifically
literary and linguistic people.  One of them - Alan Corre - has in
fact written a book on using Icon.  It is also, ironically, popular
among language theorists who like to stick offbeat and interesting
feathers in their caps.  Icon is also, naturally, popular among the
many people who have worked on it at one time or another.

Icon would be an ideal first language, since it offers all the
advantages of a Pascal, without many of its disadvantages.  It handles
garbage collection, storage allocation, and necessary type
conversions, freeing the beginning programmer to think about things
that are more important.  It also makes things like mathematical sets,
lists, hash tables, and strings into trivially simple data objects,
again freeing the programmer to think about the general typology of
his or her solution, and not so much about the as-yet irrelevant
details of implementation.  From Icon it is not difficult to move into
other Algol-derived dialects, since the overt structure is basically
the same.  Icon also gives one a leg up in languages like Prolog which
make use of vaguely similar backtracking mechanisms.  Though these
advantages would be important for beginning programmers planning to
move into other areas, Icon's most valuable asset as an instructional
language is that teachers competent to use it would not have to
separate out the "humanities" students (who are making up a larger and
larger share of low-level CS classes).  Icon has all the facilities
that both the "Hum" and "Sci" students would need on the introductory
level.

I hope that this posting clears up some of the many misconceptions
people seem to have about Icon.  If there are inaccuracies, I'm sure
that someone who's been more "officially" involved with it can clear
them up.


--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From @um.cc.umich.edu:[e-mail]  Tue Apr  9 11:24:16 1991
Received: from megaron.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 9 Apr 91 11:24:16 MST
Received: from umich.edu by megaron.cs.arizona.edu (5.61/15) via SMTP
    id AA04329; Tue, 9 Apr 91 11:24:12 -0700
Received: from um.cc.umich.edu by umich.edu (5.61/1123-1.0)
    id AA00823; Tue, 9 Apr 91 14:24:06 -0400
Received: from MTS.cc.Wayne.edu by um.cc.umich.edu via MTS-Net; Tue, 9 Apr 91 13:30:32 EDT
Date: Tue, 9 Apr 91 13:29:58 EDT
From: [e-mail]
To: [e-mail]
Message-Id: <[e-mail]>
Subject: Portability


An example of a portable Icon function with a nonportable
implementation is the file name generator I posted a while back.
Given a file name with wildcards, its result sequence is the set
of specific file names that match.  The DOS implementation uses a
specific system call, while the Unix implementation (I'd guess)
would use a shell echo call with redirected output (since
wildcard interpretation is generally done in the shell, not in
the underlying system.)  Note that DOS wildcards and Unix
wildcards have somewhat different interpretations: DOS
essentially ignores characters after `*', while Unix doesn't; and
the DOS treatment of the file extension is quite different from
that of Unix.

Path name interpretation is another example of a portable
function with a non-portable implementation, since DOS uses `\'
but Unix uses `/' (and maybe the Mac uses something else again).
But the notion of a path makes sense in any system that has
tree-structured directories.  (Does anyone know how this maps to
the IBM OS/370 world?)

Paul Abrahams
[e-mail]

From [e-mail]  Wed Apr 10 15:02:02 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 10 Apr 91 15:02:02 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA03042; Wed, 10 Apr 91 15:01:58 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 10 Apr
 1991 15:01 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA15302; Wed, 10 Apr 91
 14:39:08 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 10 Apr 1991 15:01 MST
Date: 10 Apr 91 21:23:50 GMT
From: [e-mail] (Nigel Sharp)
Subject: RE: Comparative Languages
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: National Optical Astronomy Observatories, Tucson AZ
References: <[e-mail]>,
 <[e-mail]>


I hope you will forgive a neophyte posting.
Some years ago I used SNOBOL/Spitbol for some tasks in pattern matching
(including literary manuscript analysis for author identification)
and algebra manipulation, and found it to be a very lovely language.
I may soon need to do some similar work, and have been following some
news groups to catch up to the state of the art.  I was wondering if one
of the current experts could tell me a) if a knowledge of Snobol helps,
b) if Icon is similar enough that I won't be starting from scratch, and
c) (sorry about this one) which books are recommended (the article I am
"following" mentioned one written by a literary type, but without
details).  My past experience lends me to favour Icon, as you might expect.

Before you notice I'm in Tucson and could walk across and ask the
inventors, let me say that I have too much respect to bother them
directly with such trivial questions.

Nigel Sharp, [e-mail]

From [e-mail]  Wed Apr 10 19:52:42 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 10 Apr 91 19:52:42 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA16147; Wed, 10 Apr 91 19:52:39 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 10 Apr
 1991 19:52 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA23947; Wed, 10 Apr 91
 19:39:30 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 10 Apr 1991 19:52 MST
Date: 11 Apr 91 02:12:29 GMT
From: midway!quads.uchicago.edu![e-mail] (Richard L. Goerwitz)
Subject: partial input completion utility
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago


I just wrote this as part of a larger project, and I believe it would
be of general interest.  To anyone who tries it out:  Please let me
know if you find problems or make modifications that significantly
affect performance (ahem - for the *better*).

-Richard


############################################################################
#
#    Name:     complete.icn
#
#    Title:     complete partial input string
#
#    Author:     Richard L. Goerwitz
#
#    Version: 1.2
#
############################################################################
#
#  This file contains a single procedure, complete(s,st), which
#  completes a string (s) relative to a set or list of strings (st).
#  Put differently, complete() lets you supply a partial string, s,
#  and get back those strings in st that s is either equal to or a
#  substring of.
#
#  Lots of command interfaces allow completion of partial input.
#  Complete() simply represents my personal sentiments about how this
#  might best be done in Icon.  If you strip away the profuse comments
#  below, you end up with less than thirty lines of actual source
#  code.
#
#  I have arranged things so that only that portion of an automaton
#  which is needed to complete a given string is actually created and
#  stored.  Storing automata for later use naturally makes complete()
#  eat up more memory.  The performance gains make it worth the
#  trouble, though.  If, for some reason, there comes a time when it
#  is advisable to reclaim the space occupied by complete's static
#  structures, you can just call it without arguments.  This
#  "resets" complete() and forces an immediate garbage collection.
#
#  Example code:
#
#      commands := ["run","stop","quit","save","load","continue"]
#      while line := read(&input) do {
#          cmds := list()
#          every put(cmds, complete(line, commands))
#          case *cmds of {
#              0 : input_error(line)
#              1 : do_command(cmds[1])
#              default : display_possible_completions(cmds)
#          }
#          etc...
#
#  More Iconish methods might include displaying successive
#  alternatives each time the user presses the tab key (this would,
#  however, require using the nonportable getch() routine).  Another
#  method might be to use the first string suspended by complete().
#
############################################################################
#
#  Links: none
#
############################################################################


procedure complete(s,st)

    local dfstn, c, l, old_char, newtbl, str, strset
    static t
    initial t := table()

    # No-arg invocation wipes out static structures & causes an
    # immediate garbage collection.
    if /s & /st then {
    t := table()
    collect()        # do it NOW
    fail
    }
    type(st) == ("list"|"set") |
    stop("error (complete):  list or set expected for arg2")

    # Seriously, all that's being done here is that possible states
    # are being represented by sets containing possible completions of
    # s relative to st.  Each time a character is snarfed from s, we
    # check to see what strings in st might represent possible
    # completions, and store these in a set for future use.  At some
    # point, we either run into a character in s that makes comple-
    # tion impossible (fail), or we run out of characters in s (in
    # which case we succeed, & suspend each of the possible
    # completions).

    # Store any sets we have to create in a static structure for later
    # re-use.
    /t[st] := table()

    # We'll call the table entry for the current set dfstn.  (It really
    # does enable us to do things deterministically.)
    dfstn := t[st]

    # Snarf one character at a time from s.
    every c := !s do {

    # The state we're in is represented by the set of all possible
    # completions before c was read.  If we haven't yet seen char
    # c in this state, run through the current-possible-completion
    # set, popping off the first character of each possible
    # completion, and then construct a table which uses these
    # initial as keys, and the completions that are possible for
    # each of these characters are the values for those keys.
    if /dfstn[st] then {

        # To get strings that start with the same char together,
        # sort the current string set (st).
        l := sort(st)
        newtbl := table()
        old_chr := ""
        every str := !l do {
        str ?:= (chr := move(1), tab(0)) | next
        if old_chr ~==:= chr then
            strset := set()
        insert(newtbl, chr, insert(strset, str))
        }
        insert(dfstn, st, newtbl)
    }

    # What we've done essentially is to create a table in which
    # the keys represent labeled arcs out of the current state,
    # and the values represent possible completion sets for those
    # paths.  What we need to do now is store that table in dfstn
    # as the value of the current state-set (i.e. the current
    # range of possible completions).  Once stored, we can then
    # see if there is any arc from the current state (dfstn[st])
    # with the label c (dfstn[st][c]).  If so, its value becomes
    # the new current state (st), and we cycle around again for
    # yet another c.
    st := \(\dfstn[st])[c] | fail     # see NB below
    }

    # Eventually we run out of characters in c.  The current state
    # (i.e. the set of possible completions) can simply be suspended
    # one element at a time, with s prefixed to each element.  If, for
    # instance, st had contained ["hello","help","hear"] at the outset
    # and s was equal to "hel", we would now be suspending "hel" ||
    # !set(["lo","p"]).
    suspend s || !st

    # NB: Slight performance gains could be had in certain cases by
    # checking the size of st.  If size = 1 and s is a substring of
    # its only element (or else matches in its entirety), then we are
    # essentially finished.  No need to go on and on creating nodes
    # and arcs.  Storage space gains could be had by only inserting
    # arcs needed in order to handle the current character, c, instead
    # of creating all possible arcs out the current state whenever a
    # new arc is needed.

end
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From isidev![e-mail]  Thu Apr 11 06:25:52 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 11 Apr 91 06:25:52 MST
Received: from relay1.UU.NET by optima.cs.arizona.edu (4.1/15)
    id AA06835; Thu, 11 Apr 91 06:25:49 MST
Received: from isidev.UUCP by relay1.UU.NET with UUCP
    (5.61/UUNET-shadow-mx) id AA08584; Thu, 11 Apr 91 09:25:47 -0400
Date: Thu, 11 Apr 91 09:25:47 -0400
From: isidev![e-mail]
Message-Id: <[e-mail]>
To: uunet!cs.arizona.edu![e-mail]
Subject: Re: partial input ...

I know I should resist but it's like a challenge.  I just can't let a
verbose Icon program go by without wanting to terse it up.  I think of Icon
as making it easier on me as a programmer.  If Icon is going to do all this
work for me why not let it?  That's only partly rhetorical.

Anyway, what follows contains a terser version of the complete() procedure.
I included the original version since the program below tests both.  I
took the comments (which were useful by the way) out of the original since
it was 40 lines even without them:

procedure main()

    l := ["idaho","ohio","utah","indiana","illinois","texas","iowa"]

    write("\nProgrammer does the work:")
    every write("\t",complete("i",l))

    write("\nIcon does the work:")
    every write("\t",terscomp("i",l))
end

procedure terscomp(s,st)
    suspend match(s,p := !st) & p
end

procedure complete(s,st)

    local dfstn, c, l, old_char, newtbl, str, strset
    static t
    initial t := table()

    if /s & /st then {
    t := table()
    collect()
    fail
    }
    type(st) == ("list"|"set") |
    stop("error (complete):  list or set expected for arg2")

    /t[st] := table()

    dfstn := t[st]

    every c := !s do {

    if /dfstn[st] then {

        l := sort(st)
        newtbl := table()
        old_chr := ""
        every str := !l do {
        str ?:= (chr := move(1), tab(0)) | next
        if old_chr ~==:= chr then
            strset := set()
        insert(newtbl, chr, insert(strset, str))
        }
        insert(dfstn, st, newtbl)
    }

    st := \(\dfstn[st])[c] | fail
    }

    suspend s || !st

end

--- ---
 | S | Iconic Software, Inc.  -  Jerry Nowlin  -  uunet!isidev!nowlin
--- ---


From [e-mail]  Thu Apr 11 10:29:21 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 11 Apr 91 10:29:21 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA13449; Thu, 11 Apr 91 10:29:19 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 11 Apr
 1991 10:02 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA13077; Thu, 11 Apr 91
 09:56:42 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 11 Apr 1991 10:29 MST
Date: 11 Apr 91 16:27:49 GMT
From: agate!bionet!uwm.edu!linac!midway!quads.uchicago.edu![e-mail]
 (Richard L. Goerwitz)
Subject: RE: partial input ...
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

In article <[e-mail]> [e-mail] writes:
>I know I should resist...

Jerry, the whole reason I posted was that I had hoped people would
not be able to resist :-) !

>Anyway, what follows contains a terser version of the complete() procedure.

I fooled with my program a while, and got it to run faster than the
"let Icon do the work" approach, but let me point out that the speed
difference is less than 5% in most instances, and never more than 10%.

If anyone wants what I came up with, I'll gladly send it out.  I don't
really see any reason why anyone should want it, though, when there is
a three-line equivalent that does pretty much the same thing (and uses
less memory to boot).


-Richard
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Thu Apr 11 10:57:45 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 11 Apr 91 10:57:45 MST
Received: from relay.metaphor.com by optima.cs.arizona.edu (4.1/15)
    id AA14391; Thu, 11 Apr 91 10:57:42 MST
Received: from laguna.Metaphor.COM by relay.metaphor.com (4.1/SMI-4.1)
    id AA00144; Thu, 11 Apr 91 10:52:52 PDT
Received: by laguna.Metaphor.COM (4.0/SMI-4.0)
    id AA14124; Thu, 11 Apr 91 10:56:43 PDT
Date: Thu, 11 Apr 91 10:56:43 PDT
From: [e-mail] (Bob Alexander)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: Re: partial input ...

I, too, was interested in seeing how the obvious terser version of
Richard G's complete() procedure would work.  My terse version was much
like Jerry N's (before I saw Jerry's).  So I did some timings, and
here's what I found:  The terse version was faster when used with a
list with a size on the order of Richard's or Jerry's sample program
(how much faster depended on the size of input string).  *However*,
when the list gets large (~100 entries), Richard's wins hands down.

I guess that makes sense -- Richard's run time will vary
(predominantly) with the size of the abbreviated string, where the
terse method varies with the size of the list.

-- Bob Alexander

Metaphor Computer Systems   [phone] x751   [e-mail]
====^=== Mountain View, CA  ...{uunet}!{decwrl,apple}!metaphor!alex

From [e-mail]  Thu Apr 11 16:58:40 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 11 Apr 91 16:58:40 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA29887; Thu, 11 Apr 91 16:58:36 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 11 Apr
 1991 16:57 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA26261; Thu, 11 Apr 91
 15:59:00 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 11 Apr 1991 16:58 MST
Date: 11 Apr 91 21:22:52 GMT
From: pacbell.com!mips!sdd.hp.com!wuarchive!uwm.edu!linac!midway!ellis.uchicago.edu![e-mail]
 (Richard L. Goerwitz)
Subject: RE: partial input ...
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

[e-mail] (Bob Alexander) writes:
>I, too, was interested in seeing how the obvious terser version of
>Richard G's complete() procedure would work.  My terse version was much
>like Jerry N's (before I saw Jerry's).  So I did some timings, and
>here's what I found:  The terse version was faster when used with a
>list with a size on the order of Richard's or Jerry's sample program
>(how much faster depended on the size of input string).  *However*,
>when the list gets large (~100 entries), Richard's wins hands down.
>
>I guess that makes sense -- Richard's run time will vary
>(predominantly) with the size of the abbreviated string, where the
>terse method varies with the size of the list.

I managed to get performance of the version I posted to a level where
it offers an acceptable increase over Jerry's version.  I confess that
one of the big reasons I wrote it was just to determine whether
Icon could offer me a fairly fast, deterministic way of handling
such problems.

At one point several months ago I actually wrote an Icon-only egrep-
type program that actually constructed a full-blown deterministic au-
tomaton, constructing only what it needed in order to accept or re-
ject a line.  Trouble is that it actually ran much slower than a simi-
lar program I wrote that goes to a nondeterministic pushdown automaton
under certain circumstances.  I would guess that for very complex fstns
the deterministic algorithm would be faster, but in practical use it
just didn't cut the mustard.  (The nondeterministic version of this
program is in one or another IPL update as findre.icn.)

Anyway, it frustrated me that Icon didn't really let me get at anything
on a low enough level to solve basic pattern-matching problems deter-
ministically and with reasonable storage requirements (I still wish
Icon had *some* form of pointers for simple data types).  This little
string completion utility was really just another attempt on my part
to solve this problem of performance and deterministic automata in
Icon.  The fact that it now runs faster than the "obvious" solution
only gratifies me in the sense that I might be able to apply the tech-
nique used here to problems where the performance gain would be a lot
more significant.

Since a couple of people asked for the "fixed" version, I'm reposting
it.

-Richard


############################################################################
#
#    Name:     complete.icn
#
#    Title:     complete partial input string
#
#    Author:     Richard L. Goerwitz
#
#    Version: 1.3
#
############################################################################
#
#  This file contains a single procedure, complete(s,st), which
#  completes a string (s) relative to a set or list of strings (st).
#  Put differently, complete() lets you supply a partial string, s,
#  and get back those strings in st that s is either equal to or a
#  substring of.
#
#  Lots of command interfaces allow completion of partial input.
#  Complete() simply represents my personal sentiments about how this
#  might best be done in Icon.  If you strip away the profuse comments
#  below, you end up with less than thirty lines of actual source
#  code.
#
#  I have arranged things so that only that portion of an automaton
#  which is needed to complete a given string is actually created and
#  stored.  Storing automata for later use naturally makes complete()
#  eat up more memory.  The performance gains make it worth the
#  trouble, though.  If, for some reason, there comes a time when it
#  is advisable to reclaim the space occupied by complete's static
#  structures, you can just call it without arguments.  This
#  "resets" complete() and forces an immediate garbage collection.
#
# Example code:
#
#      commands := ["run","stop","quit","save","load","continue"]
#      while line := read(&input) do {
#          cmds := list()
#          every put(cmds, complete(line, commands))
#          case *cmds of {
#              0 : input_error(line)
#              1 : do_command(cmds[1])
#              default : display_possible_completions(cmds)
#          }
#          etc...
#
#  More Iconish methods might include displaying successive
#  alternatives each time the user presses the tab key (this would,
#  however, require using the nonportable getch() routine).  Another
#  method might be to use the first string suspended by complete().
#
#  NOTE: This entire shebang could be replaced with a slightly slower
#  and much smaller program suggested to me by Jerry Nowlin and Bob
#  Alexander.
#
#      procedure terscompl(s, st)
#          suspend match(s, p := !st) & p
#      end
#
#  This program will work fine for lists with just a few members, and
#  will use a lot less memory.
#
############################################################################
#
#  Links: none
#
############################################################################



procedure complete(s,st)

    local dfstn, c, l, old_char, newtbl, str, strset
    static t
    initial t := table()

    # No-arg invocation wipes out static structures & causes an
    # immediate garbage collection.
    if /s & /st then {
    t := table()
    collect()        # do it NOW
    fail
    }
    type(st) == ("list"|"set") |
    stop("error (complete):  list or set expected for arg2")

    # Seriously, all that's being done here is that possible states
    # are being represented by sets containing possible completions of
    # s relative to st.  Each time a character is snarfed from s, we
    # check to see what strings in st might represent possible
    # completions, and store these in a set for future use.  At some
    # point, we either run into a character in s that makes comple-
    # tion impossible (fail), or we run out of characters in s (in
    # which case we succeed, & suspend each of the possible
    # completions).

    # Store any sets we have to create in a static structure for later
    # re-use.
    /t[st] := table()

    # We'll call the table entry for the current set dfstn.  (It really
    # does enable us to do things deterministically.)
    dfstn := t[st]

    # Snarf one character at a time from s.
    every c := !s do {

    # The state we're in is represented by the set of all possible
    # completions before c was read.  If we haven't yet seen char
    # c in this state, run through the current-possible-completion
    # set, popping off the first character of each possible
    # completion, and then construct a table which uses these
    # initial as keys, and the completions that are possible for
    # each of these characters are the values for those keys.
    if /dfstn[st] then {

        # To get strings that start with the same char together,
        # sort the current string set (st).
        l := sort(st)
        newtbl := table()
        old_chr := ""
        every str := !l do {
        str ? { chr := move(1) | next; str := tab(0) }
        if old_chr ~==:= chr then {
            strset := set([str])
            insert(newtbl, chr, strset)
        }
        else insert(strset, str)
        }
        insert(dfstn, st, newtbl)
    }

    # What we've done essentially is to create a table in which
    # the keys represent labeled arcs out of the current state,
    # and the values represent possible completion sets for those
    # paths.  What we need to do now is store that table in dfstn
    # as the value of the current state-set (i.e. the current
    # range of possible completions).  Once stored, we can then
    # see if there is any arc from the current state (dfstn[st])
    # with the label c (dfstn[st][c]).  If so, its value becomes
    # the new current state (st), and we cycle around again for
    # yet another c.
    st := \dfstn[st][c] | fail
    if *st = 1 & match(s,!st)
    then break
    }

    # Eventually we run out of characters in c.  The current state
    # (i.e. the set of possible completions) can simply be suspended
    # one element at a time, with s prefixed to each element.  If, for
    # instance, st had contained ["hello","help","hear"] at the outset
    # and s was equal to "hel", we would now be suspending "hel" ||
    # !set(["lo","p"]).
    suspend s || !st

end
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From ralph  Sun Apr 14 07:34:25 1991
Date: Sun, 14 Apr 91 07:34:25 MST
From: "Ralph Griswold" <ralph>
Message-Id: <[e-mail]>
Received: by cheltenham.cs.arizona.edu; Sun, 14 Apr 91 07:34:25 MST
To: icon-group
Subject: Icon Compiler for UNIX Platforms

        Icon Compiler for UNIX Platforms

As mentioned earlier, a preliminary release of the optimizing compiler for the
Icon programming language is now available for UNIX platforms. This compiler
generates stand-alone executable files unlike the Icon interpreter. The
compilation process itself is slow compared with the interpreter, but the
resulting executable files run much faster than interpreted ones.

The Icon compiler produces C code, so you'll need a C compiler to use it.

The preliminary release corresponds approximately to Version 7.6 of Icon
and does not have all Version 8 features. Version 8 of the compiler will
be released later.

The compiler is available in two ways: in "object" packages for specific UNIX
platforms and as source code.

If you want to run the compiler and there's an object package for your
platform, all you need to do is pick up the object package and install it,
which is a comparatively simple process.

If there's not an object package for your platform or if you are interested
in the source code, you can get that and build your own compiler. Building
the compiler takes quite a bit of machine time. It also requires about 6MB
of disk space to build.

At present there are object packages for the following UNIX platforms:

    DECstation 3100 running Ultrix
    HP 9000/300 running HP/UX
    HP 9000/800 running HP/UX
    Intel 386 running System V
    Iris 4D running IRIX
    Macintosh running A/UX
    NeXT running Mach
    PS/2 running AIX
    Sequent Symmetry running DYNIX
    Sun 3 Workstation running SunOS
    Sun 4 Workstation running SunOS
    UNIX PC (AT&T 3B1)
    VAX running 4.3 BSD
    VAX running Ultrix

Implementations for other platforms will be added as they are completed.

To get a copy of the Icon compiler, do an anonymous FTP to cs.arizona.edu.
Then cd to /icon/v8/Compiler. There are three subdirectories, Docs,
Packages, and Source.

The subdirectory Docs contains PostScript for documents relating to the
installation and use of the Icon compiler.

The subdirectory Packages contains object packages in additional
subdirectories, one for each presently supported platform. The subdirectory
names identify the platforms.

The subdirectory Source contains the source code for the Icon compiler.

See the READ.ME files in the various directories for additional information.

Please direct any questions to me, not icon-group.


  Ralph Griswold / Dept of Computer Science / Univ of Arizona / Tucson, AZ 85721
  [phone]   [e-mail]  uunet!arizona!ralph


From @cunyvm.cuny.edu:[e-mail]  Wed Apr 17 08:00:33 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 17 Apr 91 08:00:33 MST
Message-Id: <[e-mail]>
Received: from CUNYVM.CUNY.EDU by optima.cs.arizona.edu (4.1/15)
    id AA19932; Wed, 17 Apr 91 08:00:30 MST
Received: from CSUOHIO.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.2MX) with BSMTP id 8353; Wed, 17 Apr 91 11:00:55 EDT
Date: 91/04/17 10:57:37
From: [e-mail]
To: [e-mail]
Subject: content analysis






APRIL 17, 1991

BEING NEW TO ELETRONIC MAIL.....
I AM RESENDING THIS MESSAGE BECAUSE I'M UNSURE IF IT INITIALLY REACHED
THE ICON-GROUP.  I WOULD APPRECIATE ANY RESPONSE TO AFFIRM PROCEDURES ON
THIS END.  THANKS.

WE'RE DOING A CONTENT ANALYSIS OF SURVEY DATA THAT REQUIRES MORE
than word frequency counts, something more on the level of a qualitative
factor analysis.  I am the research associate at the Child Guidance Center of
Greater Cleveland, a non-profit 401(c)(3) organization.  Having purchased the
MS-DOS/386 version of Icon and the book Icon Programming for Humanists late
last year but only being able to upgrade memory beyond 1 meg recently, I'm in
a fix to put together a program (by 4/16/91) beyond word counts.  Can anyone
help?


Bill Burkey
Child Guidance Center
2525 E 22
Cleveland, OH  44115
[phone] x23
bitnet <r1325@csuohio>

   

From [e-mail]  Wed Apr 17 08:04:56 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 17 Apr 91 08:04:56 MST
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA20395; Wed, 17 Apr 91 08:04:52 MST
Received: from CEARN.cern.ch (MAILER@CEARN) by Arizona.edu with PMDF#10282;
 Wed, 17 Apr 1991 08:04 MST
Received: from CSUOHIO.BITNET (R1325) by CEARN.cern.ch (Mailer R2.07B) with
 BSMTP id 0002; Wed, 17 Apr 91 17:04:05 GVA
Date: 91/04/17 11:00:20
From: [e-mail]
Subject: content analysis
To: [e-mail]
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]






APRIL 17, 1991

BEING NEW TO ELETRONIC MAIL.....
I AM RESENDING THIS MESSAGE BECAUSE I'M UNSURE IF IT INITIALLY REACHED
THE ICON-GROUP.  I WOULD APPRECIATE ANY RESPONSE TO AFFIRM PROCEDURES ON
THIS END.  THANKS.

WE'RE DOING A CONTENT ANALYSIS OF SURVEY DATA THAT REQUIRES MORE
than word frequency counts, something more on the level of a qualitative
factor analysis.  I am the research associate at the Child Guidance Center of
Greater Cleveland, a non-profit 401(c)(3) organization.  Having purchased the
MS-DOS/386 version of Icon and the book Icon Programming for Humanists late
last year but only being able to upgrade memory beyond 1 meg recently, I'm in
a fix to put together a program (by 4/16/91) beyond word counts.  Can anyone
help?


Bill Burkey
Child Guidance Center
2525 E 22
Cleveland, OH  44115
[phone] x23
bitnet <r1325@csuohio>

   

From [e-mail]  Wed Apr 17 08:09:04 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 17 Apr 91 08:09:04 MST
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA20949; Wed, 17 Apr 91 08:09:01 MST
Received: from UKACRL.BITNET (MAILER@UKACRL) by Arizona.edu with PMDF#10282;
 Wed, 17 Apr 1991 08:08 MST
Received: from CSUOHIO.BITNET (R1325) by UKACRL.BITNET (Mailer R2.07) with
 BSMTP id 9743; Wed, 17 Apr 91 16:04:53 BST
Date: 91/04/17 10:59:10
From: [e-mail]
Subject: content analysis
To: [e-mail]
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]






APRIL 17, 1991

BEING NEW TO ELETRONIC MAIL.....
I AM RESENDING THIS MESSAGE BECAUSE I'M UNSURE IF IT INITIALLY REACHED
THE ICON-GROUP.  I WOULD APPRECIATE ANY RESPONSE TO AFFIRM PROCEDURES ON
THIS END.  THANKS.

WE'RE DOING A CONTENT ANALYSIS OF SURVEY DATA THAT REQUIRES MORE
than word frequency counts, something more on the level of a qualitative
factor analysis.  I am the research associate at the Child Guidance Center of
Greater Cleveland, a non-profit 401(c)(3) organization.  Having purchased the
MS-DOS/386 version of Icon and the book Icon Programming for Humanists late
last year but only being able to upgrade memory beyond 1 meg recently, I'm in
a fix to put together a program (by 4/16/91) beyond word counts.  Can anyone
help?


Bill Burkey
Child Guidance Center
2525 E 22
Cleveland, OH  44115
[phone] x23
bitnet <r1325@csuohio>

   

From [e-mail]  Wed Apr 17 09:36:04 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 17 Apr 91 09:36:04 MST
Received: from judy.cs.iastate.edu by optima.cs.arizona.edu (4.1/15)
    id AA24333; Wed, 17 Apr 91 09:36:01 MST
Received: from kickapoo.cs.iastate.edu.noname by judy.cs.iastate.edu (4.1) id AA15899; Wed, 17 Apr 91 11:35:13 CDT
Received: by kickapoo.cs.iastate.edu.noname (4.1/SMI-4.1)
    id AA06833; Wed, 17 Apr 91 11:35:13 CDT
Date: Wed, 17 Apr 91 11:35:13 CDT
From: [e-mail] (Kelvin Don Nilsen)
Message-Id: <[e-mail]>
To: [e-mail]
Cc: [e-mail]
In-Reply-To: [e-mail]'s message of 91/04/17 10:57:37 <[e-mail]>
Subject: content analysis


>Date: 91/04/17 10:57:37
>From: [e-mail]


>APRIL 17, 1991

>BEING NEW TO ELETRONIC MAIL.....
>I AM RESENDING THIS MESSAGE BECAUSE I'M UNSURE IF IT INITIALLY REACHED
>THE ICON-GROUP.  I WOULD APPRECIATE ANY RESPONSE TO AFFIRM PROCEDURES ON
>THIS END.  THANKS.

>WE'RE DOING A CONTENT ANALYSIS OF SURVEY DATA THAT REQUIRES MORE
>than word frequency counts, something more on the level of a qualitative
>factor analysis.  I am the research associate at the Child Guidance Center of
>Greater Cleveland, a non-profit 401(c)(3) organization.  Having purchased the
>MS-DOS/386 version of Icon and the book Icon Programming for Humanists late
>last year but only being able to upgrade memory beyond 1 meg recently, I'm in
>a fix to put together a program (by 4/16/91) beyond word counts.  Can anyone
>help?


>Bill Burkey
>Child Guidance Center
>2525 E 22
>Cleveland, OH  44115
>[phone] x23
>bitnet <r1325@csuohio>


i'm not sure i understand what your needs are.  are you looking for an
 Icon programmer to do volunteer work for you?  are you trying to find
 an off-the-shelf package that does "qualitative factor analysis"?  what
 exactly do you mean by "qualitative factor analysis"?  what is the point
 you are trying to make about 4/16/91?  is this your deadline?  is this
 when you want the volunteers to be done?  or is this just the date on
 which you composed your message (which would be redundant and wrong, since
 you date the article 4/17/91)?

perhaps it would be helpful if you could provide a sample survey response,
 and accompany this with the sort of analysis report that you expect the
 icon program to provide for you.

by the way, your message did reach the icon group.


Kelvin Nilsen/Dept. of Computer Science/Iowa State University/Ames, IA  50011
 [phone]   [e-mail]  uunet!atanasoff!kelvin


From [e-mail]  Thu Apr 18 21:13:09 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 18 Apr 91 21:13:09 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA08983; Thu, 18 Apr 91 21:13:03 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 18 Apr
 1991 21:03 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA04514; Thu, 18 Apr 91
 20:53:55 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 18 Apr 1991 21:03 MST
Date: 18 Apr 91 14:27:01 GMT
From: hsi!mlfarm![e-mail] (Ronald Florence)
Subject: cron.icn
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Maple Lawn Farm, Stonington, CT

A friend who takes a mail/news feed from us with an ms-dos system
wanted to be able to poll when he was on-the-road.  I know next to
nothing about ms-dos, don't want to learn about things like TSRs, and
Icon is the only language our systems share.  This was the quick &
dirty solution.  The busy-loops are dumb (I anticipate flames), but
Icon tables made this fun.

I'd urge NOT running this code on a multi-tasking system like Unix,
unless you're interested in seeing how high your system load can
reach.
--

Ronald Florence            [e-mail]


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#    cron.icn
# This archive created: Thu Apr 18 10:25:34 1991
# By:    Ronald Florence (Maple Lawn Farm, Stonington, CT)
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'cron.icn'
then
    echo shar: "will not over-write existing file 'cron.icn'"
else
cat << \SHAR_EOF > 'cron.icn'
############################################################################
#
#    Name:    cron.icn
#
#    Title:    Cron Daemon
#
#    Author:    Ronald Florence ([e-mail])
#
#    Date:    18 April 1991
#
#    Version: 1.0
#
############################################################################
#
#  This program provides a crude cron daemon for ms-dos or other
#  single-tasking systems.  If a scheduled command fails, it is
#  retried at a specified interval.
#
#    usage: cron [-r] [-c cmd] [-t tries] [-i interval] 0-23 [0-59]
#           cron < cron-table [ > cron.log ]
#
#  The command-line usage invokes a single command at a specified time.
#  The -r option runs the daemon continuously.  Defaults for the command,
#  interval, and retries can be specified in the code.  The second usage
#  reads an ascii table in the following format:
#
#     # hour  minute  interval  retries   command
#        0      15       5         3      uuio | mail postmaster
#        1      35       0         0      rnews *.nws
#        6      30       2         2      make coffee
#
#  Lines beginning with `#' in the table are treated as comments.
#
############################################################################
#
#  Link: options
#  Bugs: This busy-loop should NOT be run on multi-tasking systems.
#        Commands scheduled at conflicting times may not be invoked.
#        The cron-table is not compatible with Unix cron tables.
#
############################################################################

link options

procedure main(arg)

  usage := ["usage: cron [-r] [-c cmd] [-t tries] [-i interval] 0-23 [0-59]",
        "       cron < cron-table"]

  default_cmd := "uuio"
  default_interval := 5
  default_retries := 3

  cmd := table(0)
  interval := table(0)
  retries := table(0)

  if *arg > 0 then {
    opts := options(arg, "c:i+t+r")
    h := integer(arg[1])
    m := integer(arg[2]) | 0
    (/h | h < 0 | h > 23 | m < 0 | m > 59 ) & { every write(!usage); exit(-1) }
    t := h * 3600 + m * 60
    cmd[t] := \opts["c"] | default_cmd
    interval[t] := \opts["i"] | default_interval
    retries[t] := \opts["t"] | default_retries
  }
  else every s := !&input do s ? {
    ="#" & next
    tmp := []
    while tab(upto(&digits)) \4 do put(tmp,tab(many(&digits)))
    t := pop(tmp) * 3600 + pop(tmp) * 60
    interval[t] := pop(tmp)
    retries[t] := pop(tmp)
    cmd[t] := (tab(many(' \t')), tab(0))
  }

  write(&errout, "time\tint\tret\tcommand")
  write(&errout, "-------------------------------")
  every t := key(cmd) do
    write(&errout, right(t/3600, 2, "0"), ":", left((t % 3600)/60, 2, "0"),
      "\t", interval[t], "\t", retries[t], "\t", cmd[t])

  while t := now() do (t = key(cmd)) & {
    try := 0
    repeat {
      (system(cmd[t]) = 0) & {
    write(cmd[t], " completed ", &dateline)
    while t = now()
    break
      }
      write(cmd[t], " FAILED ", &dateline)
      ((try +:= 1) >= retries[t]) & break
      repoll := now() + interval[t] * 60
      while repoll > now()
    }
    (*arg = 0) | \opts["r"] | exit(try)
  }
end

procedure now()
  time := []
  &clock ? while tab(upto(&digits)) do put(time,tab(many(&digits)))
  return time[1] * 60 * 60 + time[2] * 60 + time[3]
end
SHAR_EOF
if test 3218 -ne "`wc -c < 'cron.icn'`"
then
    echo shar: "error transmitting 'cron.icn'" '(should have been 3218 characters)'
fi
fi
exit 0
#    End of shell archive
--

Ronald Florence            [e-mail]

From [e-mail]  Sun Apr 21 19:53:33 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 21 Apr 91 19:53:33 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA17113; Sun, 21 Apr 91 19:53:24 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sun, 21 Apr
 1991 19:52 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA03934; Sun, 21 Apr 91
 19:47:42 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sun, 21 Apr 1991 19:52 MST
Date: 21 Apr 91 13:31:23 GMT
From: eru!hagbard!sunic!mcsun!cernvax!chx400!chx400!hslrswi![e-mail]
 (Norman H. Azadian)
Subject: Klondike solitaire, v3.01, part 2/6
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Hasler AG


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    klonstr.icn
#    getchlib.icn
# This archive created: Sun Apr 21 15:03:15 1991
# By:    Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'klonstr.icn'" '(5135 characters)'
if test -f 'klonstr.icn'
then
    echo shar: will not over-write existing file "'klonstr.icn'"
else
cat << \SHAR_EOF > 'klonstr.icn'
#klonstr.icn    910309    NHA
#Routines to implement strategic play for klondike solitaire.
#For each strategy there is a procedure with the same name.
#findBest() is the interface to the rest of klondike.


#    t a k e F i r s t
# This strategy is the simplest possible, simply taking the first suggestion
# proffered by suggest().  Equivalent to find1().
# Note that it is therefore dependent on the exact implementation of suggest().
# When Thumbing, terminate upon second occurrence of *deckDown = 0.
procedure takeFirst ()
local emptySeen, s
    until (\emptySeen) & (*deckDown = 0)  do  {
        /emptySeen  :=  (*deckDown = 0)
        (s := suggest())  &  return (s || "0")        #good move found
        ((*deckUp + *deckDown) = 0)  &  break        #no cards to thumb through
        writeInfo (Vbold || "T" || Vnormal || "humb")
        push (ops, thumb())
    }
    fail                                    #nothing left to do
end                                            #takeFirst


#    i n t e r a c t i v e
# For multi-choice positions, allows the user to choose.
procedure interactive ()
local suggestions, emptySeen, s, op
    until (\emptySeen) & (*deckDown = 0)  do  {
        /emptySeen  :=  (*deckDown = 0)
        suggestions := []                    #generate a new list of suggestions
        every put (suggestions, suggest())
        (1 = *suggestions)  &  (return (suggestions[1] || "0"))    #one possibility
        if (1 < *suggestions)  then  {                    #multiple -- user picks
            outputAt (lineCount, 40, VclearEOL, Vreverse)
            every s := !suggestions  do  writes (s[2:0], " ")
            writeInfo (Vblink || "choose a move")
            until any(cset("123456789abc"[1+:*suggestions]), (s := getch()))  do
                complain()
            op := suggestions["16r" || s]
            outputAt (lineCount, 40, VclearEOL, Vnormal)
            every s := !suggestions  do
                if s == op  then
                    output (Vreverse, op[2:0], Vnormal, " ")
                else
                    writes (s[2:0], " ")
            return (op || "0")
        }
        # no useful moves found -- thumb
        ((*deckUp + *deckDown) = 0)  &  break        #no cards to thumb through
        writeInfo (Vbold || "T" || Vnormal || "humb")
        push (ops, thumb())
    }
    fail                                    #nothing left to do
end                                            #interactive


#    d e c k F i r s t
# The idea here is that, if possible, nothing will get done in this
# pass through the deck until a card has been taken from the deck.
# Otherwise, the strategy is simply takeFirst.
# We run with automaticAce disabled simply so we can know when
# we take one from the deck.
# Since there is no way to know that we are starting a new game, we cannot
# guarantee that the flags are correct in the event of user intervention.
procedure deckFirst ()
local s
static taken, modified
initial    {
    taken := &null                            #assume nothing taken from deck yet
    modified := &null                        #nothing done yet on this pass
}
    automaticAce := &null
    repeat {
        every s := suggest()  do
            if (\taken) | (s[2] == "D")  then  {
                modified := taken := 1        #[sic]
                return (s || "0")
            }
        ((*deckUp + *deckDown) = 0)  &  break        #no cards to thumb through
        writeInfo (Vbold || "T" || Vnormal || "humb")
        push (ops, thumb())
        if 0 = *deckDown  then                #end of a pass through the deck
            if \modified  then
                modified := taken := &null    #normal case -- reset flags
            else
                if \taken then
                    break                    #nothing left to do  [sic]
                else
                    taken := 1                #allow other moves for next pass
    }
    modified := taken := null                #reset flags for next game
    fail                                    #nothing useful left to do
end                                            #deckFirst


#    f i n d B e s t
# If called with a parameter, the parameter is taken to be the name of a play
# strategy and is saved for future use by findBest() after sanity checking.
# An empty string is taken to be a request to use the default strategy.
# Note that, at least for now, the name of the strategy procedure is
# necessarily identical to the name of the strategy.
#
# If called without any parameter, returns with the move selected by the
# pre-determined strategy routine.
# Largely for hysterical raisons, strategy routines are expected to do their
# own Thumbing until either they find a good move to return, or they decide
# there is no point to continuing and so return failure.
# Strategy routines are expected to keep the user informed of any moves
# (e.g. Thumbing) that they do before returning.
#
# Note that the strategy procedure may decide it is necessary to
# unilaterally disable the automaticAce option during its execution.
# Therefore automaticAce is saved here and restored before returning.
# However, if the strategy procedure leaves automaticAce intact, then
# any Ace uncovered whilst thumbing will be automaticall moved and the
# search will continue.  It does not count as a move.
procedure findBest (s)
static strategies, strategyProc
local automaticAceSave
initial {
    strategies := set ( ["takeFirst", "interactive", "deckFirst"] )
}
    if \s  then  {                            #remember strategy
        (s == "")  &  (s := "takeFirst")    #default strategy
        (s == !strategies)  |  stop ("klondike: unknown strategy  ", s)
        strategyProc := (strategy := s)        #remember for future use
    } else {                                #execute strategy
        automaticAceSave := automaticAce
        s := strategyProc()
        automaticAce := automaticAceSave
        (s === &null)  &  fail
    }
    return s
end                                            #findBest
SHAR_EOF
if test 5135 -ne "`wc -c < 'klonstr.icn'`"
then
    echo shar: error transmitting "'klonstr.icn'" '(should have been 5135 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'getchlib.icn'" '(9166 characters)'
if test -f 'getchlib.icn'
then
    echo shar: will not over-write existing file "'getchlib.icn'"
else
cat << \SHAR_EOF > 'getchlib.icn'
############################################################################
#
#    Name:     getchlib.icn
#
#    Title:     Implementation of getch() for Unix (and more)
#
#    Author:     Richard L. Goerwitz
#
#    Version: 1.13
#
############################################################################
#
#  I place this and future versions of getchlib in the public domain - RLG
#
############################################################################
#
#  Implementing getch() is a much, much more complex affair under Unix
#  than it is under, say, MS-DOS.  This library represents one,
#  solution to the problem - one which can be run as a library, and
#  need not be compiled into the run-time system.  Note that it will
#  not work on all systems.  In particular, certain Suns (with a
#  screwy stty command) and the NeXT 1.0 OS (lacking the -g option for
#  stty) do not run getchlib properly.  See the bugs section below for
#  workarounds.
#
#  Four basic utilities are included here:
#
#    getch()        - waits until a keystroke is available &
#        returns it without displaying it on the screen
#    getche()    - same as getch() only with echo
#    getse(s)    - like getche() only for strings.  The optional
#        argument s gives getse() something to start with.  Use this
#           if, say, you want to read single characters in cbreak mode,
#           but get more input if the character read is the first part
#           of a longer command.  If the user backspaces over everything
#           that has been input, getse() fails.  Returns on \r or \n.
#    reset_tty()    - absolutely vital routine for putting the cur-
#           rent tty line back into cooked mode; call it before exiting
#           or you will find yourself with a locked-up terminal; use it
#           also if you must temporarily restore the terminal to cooked
#           mode
#
#  Note that getse() *must* be used in place of read(&input) if you
#  are planning on using getch() or getche(), since read(&input)
#  assumes a tty with "sane" settings.
#
#  Warning:  The routines below do not do any sophisticated output
#  processing.  As noted above, they also put your tty line in raw
#  mode.  I know, I know:  "Raw is overkill - use cbreak."  But in
#  a world that includes SysV, one must pick a lowest common denomi-
#  nator.  And no, icanon != cbreak.
#
#  BUGS: These routines will not work on systems that do not imple-
#  ment the -g option for the stty command.  The NeXT workstation is
#  an example of such a system.  Tisk, tisk.  If you have a SunOS stty
#  that is too clever (read stupid) to write its output to a pipe,
#  then substitute /usr/5bin/stty (or whatever your system calls the
#  System V stty command) for /bin/stty in this file.  If you have no
#  SysV stty command online, then you can try replacing every instance
#  of "stty -g 2>&1" below with "stty -g 2>&1 1> /dev/tty" or
#  something similar.
#
############################################################################
#
#  Example program:
#
#      The following program is a simple file viewer.  To run, it
#  needs to be linked with itlib.icn, iscreen.icn, and this file
#  (getchlib.icn).
#
#  procedure main(a)
#
#      # Simple pager/file searcher for Unix systems.  Must be linked
#      # with itlib.icn and iscreen.icn.
#
#      local intext, c, s
#
#      # Open input file
#      intext := open(a[1],"r") | {
#      write(&errout,"Can't open input file.")
#      exit(1)
#      }
#
#      # Initialize screen
#      clear()
#      print_screen(intext) | exit(0)
#
#      # Prompt & read input
#      repeat {
#      iputs(igoto(getval("cm"), 1, getval("li")))
#      emphasize()
#      writes("More? (y/n or /search):")
#      write_ce(" ")
#      case c := getche() of {
#          "y" : print_screen(intext) | break
#          " " : print_screen(intext) | break
#          "n" : break
#          "q" : break
#          "/" : {
#          iputs(igoto(getval("cm"), 1, getval("li")))
#          emphasize()
#          writes("Enter search string:")
#          write_ce(" ")
#          pattern := GetMoreInput()
#          /pattern | "" == pattern & next
#          # For more complex patterns, use findre() (IPL findre.icn)
#          if not find(pattern, s := !intext) then {
#              iputs(igoto(getval("cm"), 1, getval("li")))
#              emphasize()
#              write_ce("String not found.")
#              break
#          }
#          else print_screen(intext, s) | break
#          }
#      }
#      }
#
#      reset_tty()
#      write()
#      exit(0)
#
#  end
#
#  procedure GetMoreInput(c)
#
#      local input_string
#      static BS
#      initial BS := getval("bc") | "\b"
#
#      /c := ""
#      if any('\n\r', chr := getch())
#      then return c
#      else {
#      chr == BS & fail
#      writes(chr)
#      input_string := getse(c || chr) | fail
#      if any('\n\r', input_string)
#      then fail else (return input_string)
#      }
#
#  end
#
#  procedure print_screen(f,s)
#
#      if /s then
#      begin := 1
#      # Print top line, if one is supplied
#      else {
#      iputs(igoto(getval("cm"), 1, 1))
#      write_ce(s ? tab(getval("co") | 0))
#      begin := 2
#      }
#
#      # Fill the screen with lines from f; clear and fail on EOF.
#      every i := begin to getval("li") - 1 do {
#      iputs(igoto(getval("cm"), 1, i))
#      if not write_ce(read(f) ? tab(getval("co") | 0)) then {
#          # Clear remaining lines on the screen.
#          every j := i to getval("li") do {
#          iputs(igoto(getval("cm"), 1, j))
#          iputs(getval("ce"))
#          }
#          iputs(igoto(getval("cm"), 1, i))
#          fail
#      }
#      }
#      return
#
#  end
#
#  procedure write_ce(s)
#
#      normal()
#      iputs(getval("ce")) |
#      writes(repl(" ",getval("co") - *s))
#      writes(s)
#      return
#
#  end
#
############################################################################
#
#  Requires: UNIX
#
#  Links: itlib.icn
#
############################################################################


global c_cc, current_mode        # what mode are we in, raw or cooked?
record termio_struct(vintr,vquit,verase,vkill)

procedure getse(s)

    # getse() - like getche, only for strings instead of single chars
    #
    # This procedure *must* be used instead of read(&input) if getch
    # and/or getche are to be used, since these put the current tty
    # line in raw mode.
    #
    # Note that the buffer can be initialized by calling getse with a
    # string argument.  Note also that, as getse now stands, it will
    # fail if the user backspaces over everything that has been input.
    # This change does not coincide with its behavior in previous ver-
    # sions.  It can be changed by commenting out the line "if *s < 1
    # then fail" below, and uncommenting the line "if *s < 1 then
    # next."

    local chr
    static BS
    initial {
    BS := getval("bc") | "\b"
    if not getval("bs") then {
        reset_tty()
        stop("Your terminal can't backspace!")
    }
    }

    /s := ""
    repeat {
    case chr := getch() | fail of {
        "\r"|"\n"    : return s
        c_cc.vkill   : {
        if *s < 1 then next
        every 1 to *s do writes(BS)
        s := ""
        }
        c_cc.verase   : {
        # if *s < 1 then next
        writes(BS) & s := s[1:-1]
        if *s < 1 then fail
        }
        default: writes(chr) & s ||:= chr
    }
    }

end



procedure setup_tty()
    change_tty_mode("setup")
    return
end



procedure reset_tty()

    # Reset (global) mode switch to &null to show we're in cooked mode.
    current_mode := &null
    change_tty_mode("reset")
    return

end



procedure getch()

    local chr

    # If the global variable current_mode is null, then we have to
    # reset the terminal to raw mode.
    if /current_mode := 1 then
    setup_tty()

    chr := reads(&input)
    case chr of {
    c_cc.vintr : reset_tty() & stop()  # shouldn't hard code this in
    c_cc.vquit  : reset_tty() & stop()
    default : return chr
    }

end



procedure getche()

    local chr

    # If the global variable current_mode is null, then we have to
    # reset the terminal to raw mode.
    if /current_mode := 1 then
    setup_tty()

    chr := reads(&input)
    case chr of {
    c_cc.vintr  : reset_tty() & stop()
    c_cc.vquit  : reset_tty() & stop()
    default : writes(chr) & return chr
    }

end



procedure change_tty_mode(switch)

    # global c_cc   (global record containing values for kill, etc. chars)
    local get_term_params, i
    static reset_string
    initial {
    getval("li")    # check to be sure itlib is set up
    find("unix",map(&features)) |
        stop("change_tty_mode:  These routines must run under Unix.")
    get_term_params := open("/bin/stty -g 2>&1","pr")
    reset_string := !get_term_params
    close(get_term_params)
    reset_string ? {
        # tab upto the fifth field of the output of the stty -g cmd
        # fields of stty -g seem to be the same as those of the
        # termio struct, except that the c_line field is missing
        every 1 to 4 do tab(find(":")+1)
        c_cc := termio_struct("\x03","\x1C","\x08","\x15")
        every i := 1 to 3 do {
        c_cc[i] := char(integer("16r"||tab(find(":"))))
        move(1)
        }
        c_cc[i+1] := char(integer("16r"||tab(0)))
    }
    }

    if switch == "setup"
    then system("/bin/stty -echo raw")
    else system("/bin/stty "||reset_string)

    return

end
SHAR_EOF
if test 9166 -ne "`wc -c < 'getchlib.icn'`"
then
    echo shar: error transmitting "'getchlib.icn'" '(should have been 9166 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0
--
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]

From [e-mail]  Sun Apr 21 19:53:56 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 21 Apr 91 19:53:56 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA17123; Sun, 21 Apr 91 19:53:51 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sun, 21 Apr
 1991 19:52 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA03962; Sun, 21 Apr 91
 19:48:29 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sun, 21 Apr 1991 19:53 MST
Date: 21 Apr 91 14:08:13 GMT
From: eru!hagbard!sunic!mcsun!cernvax!chx400!chx400!hslrswi![e-mail]
 (Norman H. Azadian)
Subject: Klondike solitaire, v3.01, part 5/6
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Hasler AG


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    klonsub.icn
# This archive created: Sun Apr 21 15:04:30 1991
# By:    Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'klonsub.icn'" '(14804 characters)'
if test -f 'klonsub.icn'
then
    echo shar: will not over-write existing file "'klonsub.icn'"
else
cat << \SHAR_EOF > 'klonsub.icn'
#klonsub.icn    901029    NHA
#some subroutines for Klondike



#    d i e I f
# If the first argument succeeds, then write out the remaining args & die.
# Note that the remaining arguments must succeed.
procedure dieIf (failed, writeArgs[])
    writeCursor (1, 20)
    every writes (&output, !writeArgs)
    write (&output)
    display ()
    every writes (&errout, !writeArgs)
    write (&errout)
    runerr (500)
end                                            #dieIf


#    f i t O n S t a c k
# Given a card and a stack number, fail unless card can be added to the stack.
# Note that we disallow putting an Ace on a stack, period.  This prevents
# ever building a stack with 13 cards, which we can't display in 25 rows.
procedure fitOnStack (c, n)
    if *stackUp[n] = 0  then  {
        dieIf (*stackDown[n] ~= 0, "Up empty, Down not")
        (c.rank = 13)  |  fail                #only a king can go to empty stack
    } else {
        (c.rank = (stackUp[n][-1].rank - 1))  |  fail            #top wrong rank
        (color[c.suit] == color[stackUp[n][-1].suit])  &  fail    #top same color
        (c.rank = 1)  &  fail                                    #no aces on stak
        dieIf (*stackUp[n] >= 12, "stack too big")
    }
    return                                    #success
end                                            #fitOnStack


#    s u g g e s t
# Suggest a(nother) possible (useful) move in this situation.
# Suspends with an operation string for the suggested move.
# Fails if there is none and you should Thumb.
# This internal routine is currently the heart and soul of all program play.
procedure suggest ()
local i, j, k
    # look at deckUp to see if the top card fits on an ace pile
    (deckUp[1].rank = (pile[deckUp[1].suit] + 1))  &  suspend "MDA"

    # look at deckUp to see if the top card fits on a stack
    every (fitOnStack (deckUp[1], i := 1 to 7))  do  suspend "MD" || string(i)

    # look at each stack to see if top card can be put on an ace pile
    every (stackUp[i := 1 to 7][-1].rank  =  pile[stackUp[i][-1].suit] + 1)  do
        suspend "M" || string(i) || "A"

    # look at each stack to see if one can be (usefully) moved to another
    every fitOnStack (stackUp[i := 7 to 1 by -1][1], j := 1 to 7)  do
        if 0 < *stackDown[i]  then
            suspend  "M" || string(i) || string(j)
        else
            # possibility, but since there are no cards hidden under
            # this pile, we reject it UNLESS there are no empty slots
            # AND at least one of the following is true:
            #    (1) deckUp[1].rank = 13
            #    (2) there is a king with cards hidden beneath it
            if not (*stackUp[1 to 7] = 0)  then
                if deckUp[1].rank = 13  then
                    suspend  "M" || string(i) || string(j)        #(1)
                else
                    # only suspend once, no matter how many kings there are
                    if ( (stackUp[k := 1 to 7][1].rank = 13)  &
                         (0 < *stackDown[k]) )  then
                        suspend  "M" || string(i) || string(j)    #(2)

    # punt (Thumb)
    fail
end                                            #suggest


#    c h e c k 4 a c e
# Only has an effect when global automaticAce is set!
# Given a stack number, check for an ace as the top of stackUp[n].
# If present, move it over to it's ace pile, turn over the next card
# from stackDown, and check again.
# Must not be more than one up card in stack.
# Returns a string of the operations performed.
procedure check4ace (n)
local c, op
    op := ""
    if \automaticAce  then  {
        dieIf (1 < *stackUp[n])
        while stackUp[n][1].rank = 1  do  {
            op ||:= (c := pop (stackUp[n])).suit    #remove ace from the stack
            writeStack (n)
            pile[c.suit] := 1                #move to ace pile
            writePile (c.suit)
            click ()
            if push (stackUp[n], get(stackDown[n])) then {    #turn over card
                writeStack (n)
                click ()
            }
        }
    }
    return op
end                                            #check4ace


#    m o v e S t a c k
# Move a stack to another stack, no questions asked.
# Updates video and audio.
# Returns any automatic ace operations that were done as a consequence.
##It would be nice to do this in a visually and audibly more satisfying way
procedure moveStack (src, dst)
    # move up cards from src stack to dst stack
    while put (stackUp[dst], get(stackUp[src]))
    writeStack (src)
    writeStack (dst)
    click ()
    # turn over new card (if any) on src stack
    put (stackUp[src], get(stackDown[src]))     |  return ""    #empty stackDown
    writeStack (src)
    click ()
    return check4ace (src)
end                                            #moveStack


#    m o v e 1
# This is the internal move, taking an operation string.  No Thumbs allowed.
# Upon success it returns the (possibly modified) operation string.
# There's some redundant code here, but it makes the action look better
# (at least on slow machines).
procedure move1 (op)
local src, dst, c
    dieIf ((op[1] ~== "M"),  op)
    src := op[2]
    dst := op[3]
    if src == "D"  then  {                    # Deck -> somewhere
        c := deckUp[1]
        if dst == "A"  then  {                # Deck -> Ace
            if c.rank = (pile[c.suit] + 1)  then  {
                op[4] := c.suit                # Deck -> Ace:  fits - do it
                pop (deckUp)
                writeDeckUp ()
                pile[c.suit] +:= 1
                writePile (c.suit)
            } else {
                fail                        # Deck -> Ace:  doesn't fit
            }
        } else  {                            # Deck -> stack
            if fitOnStack (c, dst)  then {
                pop (deckUp)                # Deck -> stack:  fits - do it
                writeDeckUp ()
                put (stackUp[dst], c)
                writeStack (dst)
            } else {
                fail                        # Deck -> stack: doesn't fit
            }
        }
        click ()
        if \automaticAce  then  {
            while deckUp[1].rank = 1  do  {
                op ||:= (c := pop(deckUp)).suit
                writeDeckUp ()
                pile[c.suit] := 1
                writePile (c.suit)
                click ()
            }
        }
    } else {                                # stack -> somewhere
        if dst == "A"  then  {                # stack -> Ace
            c := stackUp[src][-1]            #copy of card on top of stack
            if c.rank = (pile[c.suit] + 1)  then  {
                op[4] := c.suit                # stack -> Ace:  fits - do it
                pull (stackUp[src])
                writeStack (src)
                pile[c.suit] +:= 1
                writePile (c.suit)
                click ()
                if 0 = *stackUp[src]  then  {
                    op[4] +:= 4                #mark this case for undo()
                    put (stackUp[src], get(stackDown[src]))    #turn over a card
                    writeStack (src)
                    if 0 < *stackUp[src]  then  {
                        click ()
                        op ||:= check4ace (src)
                    }
                }
            } else {
                fail                        # stack -> Ace:  doesn't fit
            }
        } else {                            # stack -> stack
            if fitOnStack (stackUp[src][1], dst)  then  {
                                            # stack -> stack:  fits - do it
                op[4] := "123456789abcdef"[*stackUp[src]]
                op ||:= moveStack (src, dst)
            } else {
                fail                        # stack -> stack:  doesn't fit
            }
        }
    }
    return  op                                #success
end                                            #move1


#    t h u m b
# Move to next spot in deckDown
# Returns the operation performed (usually just "T3"), or fail if none possible.
procedure thumb ()
local c, op
    ((*deckDown) = (*deckUp) = 0)  &  (complain(), fail)    #no cards left
    if 0 = *deckDown  then  {                #no cards left in hand
        while push (deckDown, pop(deckUp))    #pick up (and turn) the face-up deck
        writeDeckUp ()                        #show the (empty) deck on table
        writeDeckDown ()                    #show the face-down deck [in hand]
        click ()
    }
    op := ( "T"  ||  ((*deckDown >= 3) | *deckDown) )
    every | push (deckUp, pop(deckDown)) \ 3
    writeDeckDown ()
    writeDeckUp ()
    click ()
    if \automaticAce  then  {
        while deckUp[1].rank = 1  do  {
            op ||:= (c := pop (deckUp)).suit
            writeDeckUp ()
            pile[c.suit] := 1
            writePile (c.suit)
            click ()
        }
    }
    return op
end                                            #thumb


#    u n d o
# Backup one move, including any automatic ace moves
# This is the internal routine.
procedure undo ()
local op, suit
    if op := pop (ops)  then  {
        writeInfo (expandOp(op))
        # op looks like:  Msdixxx
        # where x is an [optional] number 1..4 of an ace pile
        # and s is either a stack number or "D"
        # and d is either "A" or a number 1..7 of a stack
        # and i is an extra piece of info which is only occasionally used
        case op[1]  of   {
        "M"        :    {
                    dieIf ((*op < 4) | ((/automaticAce) & (4 < *op)), op)
                    if op[2] == "D"  then  {
                        #Move cards from Ace piles to deck, starting at end
                        while 4 < *op  do  {
                            suit := op[-1]
                            pile[suit] := 0
                            writePile (suit)
                            push (deckUp, card(suit,1))
                            writeDeckUp ()
                            click ()
                            op[-1] := ""
                        }
                        if op[3] == "A"  then  {
                            # unMove Deck to Ace op[4]
                            suit := op[4]
                            push (deckUp, card(suit,pile[suit]))
                            pile[suit] -:= 1
                            writePile (suit)
                        } else {
                            # unMove Deck to stack op[3]
                            push (deckUp, pull(stackUp[op[3]]))
                            writeStack (op[3])
                        }
                        writeDeckUp ()
                    } else {
                        #Move cards from Ace piles to stack, starting at end
                        while 4 < *op  do  {
                            suit := op[-1]
                            pile[suit] := 0
                            writePile (suit)
                            dieIf (1 < *stackUp[op[2]], op)
                            push (stackDown[op[2]], pull(stackUp[op[2]]))
                            push (stackUp[op[2]], card(suit,1))
                            writeStack (op[2])
                            click ()
                            op[-1] := ""
                        }
                        if op[3] == "A"  then  {
                            # unMove stack op[2] to Ace pile op[4]
                            if 4 < (suit := op[4])  then  {
                                suit -:= 4        #ace pile card was last on stack
                                dieIf (1 < *stackUp[op[2]], op)
                                push (stackDown[op[2]], pull(stackUp[op[2]]))
                            }
                            put (stackUp[op[2]], card(suit,pile[suit]))
                            pile[suit] -:= 1
                            writePile (suit)
                            writeStack (op[2])
                        } else {
                            # unMove top op[4] cards on stack op[2]
                            # to stack op[3]
                            dieIf (1 < *stackUp[op[2]], op)
                            push (stackDown[op[2]], pull(stackUp[op[2]]))
                            every 1 to ("16r" || op[4])  do
                                push (stackUp[op[2]], pull(stackUp[op[3]]))
                            writeStack (op[3])
                            writeStack (-op[2])
                        }
                    }
                }
        "T"        :    {
                    dieIf (((/automaticAce) & (*op ~= 2)), op)
                    ## op looks like:  Tcxx
                    ## where c is the number of cards thumbed (usually 3)
                    ## and x is an optional number 1..4 of an ace pile
                    ## There can be 0,1,2, or 3 of these x's.
                    # move cards from Ace piles to deck, starting at end
                    while 2 < *op  do  {
                        suit := op[-1]
                        pile[suit] := 0
                        writePile (suit)
                        push (deckUp, card(suit,1))
                        writeDeckUp ()
                        click ()
                        op[-1] := ""
                    }
                    # then undo the Thumb operation itself
                    dieIf (0 = *deckUp)
                    every 1 to op[2]  do
                        push (deckDown, pop(deckUp))
                    if 0 = *deckUp  then
                        while push (deckUp, pop(deckDown))
                    writeDeckUp ()
                    writeDeckDown ()
                }
        default    :    runerr (500, op)
        }
        click ()
    } else {
        ## Admittedly this is a bit of a kluge, but better than nothing ?
        (0 = *deckDown)  &  while push (deckDown, pop(deckUp))
        writeDeckUp ()
        writeDeckDown ()
        complain ("At Beginning")
    }
    return
end                                            #undo


#    s h o w L i s t
# Display a list of cards at the current cursor position.
# Intended for debugging only .
procedure showList (lst)
local c
    every c := !lst  do
        output (color[c.suit], rankID[c.rank], suitID[c.suit], Vnormal, " ")
    return
end                                            #showList


#    c a r d 2 s t r
# Given a list of card records, returns a string representation.
# Even an empty list results in a non-zero string length.
procedure card2str (lst)
local c, s
    s := "$"
    every c := !lst  do
        s ||:= string(c.suit) || "123456789abcd"[c.rank]
    return s
end                                            #card2str


#    s t r 2 c a r d
# Given a string [as generated by card2str()],
# return corresponding list of card records.
# Fails if the string is invalid.
procedure str2card (s)
local cc, i
    (s[i:=1] == "$")  |  fail
    cc := []
    while put (cc, card(s[i+:=1], integer("14r"||s[i+:=1])))
    return cc
end                                            #str2card


#    s a v e S t a t e
# Saves the current state in the named file, which is created/overwritten
# as necessary.
# Fails if the state was not successfully saved.
# Obviously the ordering here must exactly match that in restoreState().
procedure saveState (filename)
local f, i
    (f := open ((directory || filename), "c"))  |  fail
    write (f, &dateline)
    write (f, firstSeed)
    write (f, lastSeed)
    write (f, &random)
    every write (f, !pile)
    every write (f, card2str(!stackUp))
    every write (f, card2str(!stackDown))
    write (f, card2str(deckUp))
    write (f, card2str(deckDown))
    write (f, totalGames)
    write (f, totalWins)
    write (f, totalAces)
    every write (f, !ops)
    return close (f)
end                                            #saveState


#    r e s t o r e S t a t e
# Restore game from the named file.
# Fails if the file isn't there, isn't readable, or isn't correct format.
# Otherwise returns date the file was last written.
# Note that we do not update the screen here !!
# Obviously the ordering here must exactly match that in saveState().
procedure restoreState (filename)
local f, date
    (f := open ((directory || filename), "r"))  |  fail
    (25 < *(date := read(f)))  |  fail
    firstSeed    := read (f)
    lastSeed     := read (f)
    &random      := read (f)
    every ((!pile) := read(f))
    every ((!stackUp)   := str2card (read(f)))
    every ((!stackDown) := str2card (read(f)))
    deckUp   := str2card (read(f))
    deckDown := str2card (read(f))
    totalGames    := read (f)
    totalWins    := read (f)
    totalAces    := read (f)
    ops := []
    while push (ops, read (f))
    dieIf (not close (f), f)
    return date
end                                            #restoreState


#    i n i t V a r i a b l e s
# Initialize the various lists so that everyone can reference them.
procedure initVariables ()
    ops       := []                                #no operations done yet
    deckUp    := []                                #deck in hand, face-up
    deckDown  := []                                #deck in hand, face-down
    stackUp   := list(7, 0)                        #columns on table, face up
    stackDown := list(7, 0)                        #columns on table, face down
    pile      := list(4, 0)                        #aces - only top rank stored
    every put (deckDown, card(1 to 4, 1 to 13))    #take cards out of the box
    return
end                                            #initVariables


#    n e w G a m e
# Set up all the global variables for a new game.
# Returns the seed used to generate this game.
procedure newGame ()
local i, j, s, seed
    initScreen ()

    initVariables ()                        #reset everything to ground zero

    writeInfo (Vblink || "Shuffling")
    seed := &random
    every  | (?deckDown :=: ?deckDown)  \ 123
    writeInfo ("")

    every !stackUp   := []
    every !stackDown := []
    every  push(stackUp[i := 1 to 7], get(deckDown))  do  {
        writeStack (-i)
        click ()
        every push (stackDown[j := i+1 to 7], get(deckDown))  do  {
            writeStack (-j)
            click ()
        }
###        writeStack (-i)                        ### this could replace 2 calls above
    }
    writeDeckDown(1)

    #handle any Aces which are showing
    every *(s := check4ace (i := 1 to 7)) ~= 0  do
        push (ops, "M" || string(i) || "A" || string(integer(s) + 4))
    return seed
end                                            #newGame


#    e x p a n d O p
# Given an operation string, return an expanded human-readable equivalent.
procedure expandOp (op)
static opChars
local s
initial    {
    opChars := table("oops!")
    opChars["A"] := Vbold || "A" || Vnormal || "ce"
    opChars["D"] := Vbold || "D" || Vnormal || "eck"
    every  opChars[s := !"1234567"]  :=  Vbold || s || Vnormal
}
    # This slightly more efficient scheme assumes op[1] is 1st char of result
    return (Vbold || op[1] || Vnormal ||
            case op[1]  of  {
            "M"        :    ( "ove " || opChars[op[2]] || " to " || opChars[op[3]] )
            "Q"        :    "uit"
            "T"        :    "humb"
            default    :    runerr (500, op)
            })
end                                            #expandOp
SHAR_EOF
if test 14804 -ne "`wc -c < 'klonsub.icn'`"
then
    echo shar: error transmitting "'klonsub.icn'" '(should have been 14804 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0
--
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]

From [e-mail]  Sun Apr 21 19:54:23 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 21 Apr 91 19:54:23 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA17137; Sun, 21 Apr 91 19:54:14 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sun, 21 Apr
 1991 19:53 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA03923; Sun, 21 Apr 91
 19:47:22 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sun, 21 Apr 1991 19:53 MST
Date: 21 Apr 91 13:29:42 GMT
From: eru!hagbard!sunic!mcsun!cernvax!chx400!chx400!hslrswi![e-mail]
 (Norman H. Azadian)
Subject: Klondike release, v3.01, part 1/6
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Hasler AG

Here's a good version of the Klondike (solitaire) card game for which I
posted a beta version some time ago.  This is the result of an international
joint effort between me in Switzerland and Richard Goerwitz in Chicago.

Six parts are necessary to keep each one under 20KBytes.
Note that the unix end-of-line convention (just a newline) is used,
so you might need to take special measures with your editor under DOS.
Note also that the tab interval is 4.

NHA
---
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    readme
#    klondike.man
#    makefile.dos
#    makefile.unx
#    klonstub.icn
# This archive created: Sun Apr 21 15:03:00 1991
# By:    Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'readme'" '(4587 characters)'
if test -f 'readme'
then
    echo shar: will not over-write existing file "'readme'"
else
cat << \SHAR_EOF > 'readme'
README    910330    NHA    version 3.00

Just when you'd about given up hope, Klondike is finally being released
in "final" form.  It's bigger and slower than ever, and chock full of
marginal features.  It should, however, run on just about any PC or unix
machine known to man.

In case you didn't catch the initial beta release, Klondike is an Icon
implementation of the single-player card game variously known under such
names as Solitaire or Patience.  When you get tired of playing, you can
let the machine take over for you.


INSTALLATION - DOS
==================
For a fast start simply:

    icont  -c  iolib  kloncon  klonsub  klonstr
    icont  -u  -Si1000  -Sn2000  klondike
    iconx  klondike

Later you might want to move IOLIB.ICN to your Icon library directory,
and compile it there. If you have "make" on your machine, you can copy
"makefile.dos" to "makefile", and use make to build klondike.icx for you.


INSTALLATION - UNIX
===================
For a fast start simply:

    icont  -c  iolib
    cp  makefile.unx  makefile
    make
    iconx  klondike

Later you might want to move IOLIB.ICN and GETCHLIB.ICN to your Icon
library directory, and compile them there.


NOTES
=====
Richard Goerwitz provided the GETCHLIB library package to allow
operation under unix.  He also provided the IOLIB library package that
is essential if your terminal isn't ANSI compatible.  He assures me that
it should be adequate for most terminals currently in use.  If, however,
you are stuck with an old slow terminal that requires padding, you
will need his industrial-strength ITLIB package instead of IOLIB.
You can get this direct from Richard at "[e-mail]".
All suggestions, bug reports and compliments for these libraries should
be directed to Richard.  All of these libraries will probably become
available in the Icon Program Library at some point in the future.

On a PC the "A" and "C" commands can be interrupted by hitting (nearly)
any key on the keyboard.  Under unix, the natural way to do this would
be to use SIGINT.  Alas, for the sake of portability we had to forgo this
feature.  This is because the terminal needs to run in raw mode to
implement the getch() function, and signals aren't available in raw mode.
With BSD this could be handily solved by using cbreak mode instead of raw
mode, but that isn't a possibility under SysV.  The kbhit() that DOS
uses doesn't port well to unix.

If for some reason you can't/won't run an ANSI driver on your PC, it is
possible to run with the termcap capabilities provided by IOLIB.  To do
this you will need a TERMCAP file.  I have such a beast, as does Richard,
but I have not included it in the distribution because probably no one
will actually use it.  If you are the exception, you can get it from one
of us, or you could write it yourself.

For terminals with only 24 lines, a kluge is necessary in order to
display the maximal-length stack of 12 cards.  The top card (at the
bottom of the screen) is moved up one row so that it covers up the
suit and rank of the card it rests upon.  However, you know it must
be a 3, and it can't be used anyway until the 2 on top of it is put
onto its ace pile.

One of the excuses for writing this was to have a means of evaluating
various strategies for playing klondike solitaire.  A strategy is easily
coded in klonstr.icn, and then tested with a batch file that uses the
-S, -B and -I options.  On my AT clone, Klondike can pump out nearly
5 games per minute in batch mode, thus an overnight run can produce
3000-4000 games worth of statistics.  And under unix you can run it
in background with "nice" to soak up those excess machine cycles.

On a PC, the size of the .ICX file is limited to 65KBytes.  As long as
you are running an ANSI driver, you don't actually need IOLIB, and you
can save a bunch of space in KLONDIKE.ICX by stubbing it out.  This will
probably be essential if you want to add any play strategies to
klonstr.icn.  Assuming that your IOLIB is in a library directory
distinct from where you keep your Klondike, you can accomplish this by
simply doing the following in your Klondike directory:

    copy  klonstub.icn  iolib.icn
    icont  -c  iolib

I am very interested in suggestions, ideas, speed ups, and above all,
bug reports.  I'd also like to hear about your experiences with
alternate strategies.

Enjoy!

NHA
---
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]
SHAR_EOF
if test 4587 -ne "`wc -c < 'readme'`"
then
    echo shar: error transmitting "'readme'" '(should have been 4587 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'klondike.man'" '(9788 characters)'
if test -f 'klondike.man'
then
    echo shar: will not over-write existing file "'klondike.man'"
else
cat << \SHAR_EOF > 'klondike.man'

    NAME
        klondike -- one of the many versions of solitaire

    SYNOPSIS
        klondike  [-AQZ]  [-B[gameCount]]  [-D[directory]]  [-I[reportInterval]
                    [-P[phraseFile]]  [-RrandomSeed]  [-Sstrategy]
                    [-T[termType]]")

    DESCRIPTION
        A popular variation on the Klondike version of Solitaire (or
        Patience) as described on page 181 of my 1963 version of "Hoyle's
        Rules of Games".  The difference is that here we go through the
        deck (stock) 3 cards at a time instead of one-by-one, and we allow
        it any number of times.

        This program runs best on a PC with a color monitor.  It will
        run on any system providing an ANSI-compatible screen by simply
        giving option -Tmono or -Tcolor as appropriate.  Further,
        thanks largely to Richard L. Goerwitz's encouragement, help
        and excellent iolib package, it should run on just about any
        (non-magic-cookie) terminal supported by termcap.

    OPTIONS
        Except for strategy, options may be either upper or lower case.
        They may be given in any order.  Parameters follow their options
        with no whitespace inbetween.  Each option must be given as a
        separate argument.  Except for toggling options, only the last
        occurence of an option is honored.

        -A      By default uncovered Ace cards are automatically
                promoted to an Ace pile.  This option toggles that
                behaviour. Note that, in any case, it is not allowed
                to put an Ace onto a stack, as this could lead to
                building stacks which are too big to display with
                a 25 line screen.  Some computer-play strategies
                will unilaterally disable this option during
                programmed play.

        -B[count]
                Batch mode.  The requested number of games is played
                and a line of ASCII is written to standard output
                with four tab-separated numbers: random seed, number
                of games played, number of games won, and number of
                cards promoted to the ace piles.  Before exiting,
                the usual additional statistics are dumped (with
                explanatory text) to stderr.  If the count is 0 or
                missing, games are played forever (or until interrupted).

                In batch mode play can always be terminated with
                an interrupt from the user, as defined by system-
                dependent routine userInterrupt() in kloncon.icn.
                Under DOS this consists of entering any character
                from the keyboard.

                No I/O is ever done other than that described
                above.  In particular, the checkpoint file,
                klondike.sav, generated by a previous Boss command,
                is ignored in batch mode.

        -D[dir] gives the directory to be used for all file I/O.
                The dir string is simply pre-pended to all filenames,
                including the phrase file if given.  If dir is not
                given, environment variables $HOME and then $ROOTDIR
                are tried.  Failing these, the current directory is
                used.

        -I[reportInterval]
                enables intermediate reporting of results when
                running in Batch mode.  Default is 1.

        -P[file]
                Normally an incorrect keystroke is greeted by one
                of a set of stock phrases.  With this option phrases
                are instead taken from the indicated file, 1 per line,
                up to 16 printing characters each.  For the hard of
                humor, funny phrases may be disabled altogether by
                giving the option without any file name.

        -Q      toggle Quiet mode.  Klondike is initially noisy,
                with clicks for card movement and bells for
                getting attention.  With this option there are
                no clicks, and bells are visual if possible.

        -Rseed  set the random seed to the designated value.

        -Sstrategy
                allows the user to determine which of the programmed
                strategy play possibilities will be used for all
                computer play (commands Automatic and Continuous).
                The default strategy is called "takeFirst", others
                may be discovered by reading file klonstr.icn.
                NOTE that case IS important in the strategy name.

        -T[termtype]
                use termcap instead of assuming that this is a PC with
                an ANSI screen.  If termtype is given then that name
                is sought in /etc/termcap, otherwise environment
                variables TERMCAP and TERM are consulted in the usual
                manner.  Termcap screens are always considered to be
                monochrome.  Three special (case-independent) values
                for termtype are defined:  PC, MONO, and COLOR.
                PC gives the default behaviour, i.e. an ANSI driver
                (ANSI.SYS or compatible) must be running, and the
                BIOS is consulted to see whether it is monochrome
                or color.  This BIOS dependency is avoided with
                COLOR and MONO.

        -Z      toggle debugging mode.  In debugging mode the
                debug command (Z) is allowed.  Debugging mode
                is initially disabled since it allows cheating.

    COMMANDS
        H or ?  display a Help screen.  Under DOS, F1 also works.

        ^L      (control-L) redraws the screen

        A       Automatic mode.  Plays the game until nothing useful
                remains to be done, or until any key is struck.

        B       Boss key.  The screen is blanked and the current position
                is saved.  When the game is started again in the usual
                way, this saved game will be automatically restored and
                the save file deleted.

        C       Continuous mode.  The computer plays games automatically
                until interrupted.  Two statistics are displayed:
                the number of games already played, and the total number
                of aces which have been promoted to the ace piles.

        F       Find next useful move, thumbing as necessary.  If invoked
                immediately again, the move is performed and the next
                one is sought.  Note that unless automatic ace mode
                is disabled with the -A option, ace promotion will be
                automatic, and not considered as a useful move.  Note
                also that no strategy is used, i.e. the move found is
                not necessarily the best.

        M       Move a card from the deck or a stack to a stack or an
                ace pile.

        Q       Quit this game, with the opportunity to play another.

        S       Suggest a possible move.  Hitting this key multiple times
                results in multiple suggestions being displayed.  When
                there is nothing interesting left to do, it will suggest
                "Thumb".  Otherwise the possibilities are listed in no
                particular order.

        T       Thumb.  Remove the top 3 cards from the face-down deck
                and turn them over (as a group) onto the face-up deck.

        U       Undo.  This can be used all the way back to the start
                of the current game.

        Z       Debug.  This is only enabled when the -Z option has
                been given on the command line.  There is a sub-menu
                of commands available, including a (very brief) Help
                summary.

        The Move command takes two parameters: source and destination.
        Possible sources are:  D for the Deck of face-up cards; and a
        number from 1 to 7 inclusive, meaning the corresponding stack.
        Possible destinations are the stacks (1-7) and A for the
        appropriate ace pile.  For instance, to move the visible card
        from the face-up deck to stack 4, one types the three characters:
        "MD4".  Actually, the "M" character itself is optional, which
        explains why the "debug" command isn't invoked with a "D".

    ENVIRONMENT VARIABLES
        KLONDIKE        the contents of this variable are pre-pended
                        to the command line.
        HOME, ROOTDIR   used for directory when -D given without arg.
        TERM, TERMCAP   used for terminal type determination as usual.

    FILES
        klondike.sav    Boss key checkpoints the position here.
        klondike.sv?    State checkpointed here with the S debug command.
                        "?" can be any (upper-case) character legal in
                        your filesystem.

    BUGS
        On 24-line terminals you will have to guess at the suit of the
        next-to-top card in a maximal-length stack.
        "Continuous" command not (gracefully) stoppable under SYS V unix.
        Slow, particularly with non-ANSI terminals.
        The program's play is simplistic; no interesting strategic play
        has yet been programmed.
        The average time statistic is sometimes wrong for PCs, and is
        always wrong when the Boss command has been used.

    ACKNOWLEDGEMENTS
        The termcap capability was contributed by Richard L. Goerwitz.
        The inspiration, name, and some elements of the user interface
        were lifted wholesale from a computer game copyrighted in 1985
        by Allyn Wade.

    VERSION
        3.01 -- 30 March, 1991

    AUTHOR
        Norman H. Azadian
        [e-mail]
SHAR_EOF
if test 9788 -ne "`wc -c < 'klondike.man'`"
then
    echo shar: error transmitting "'klondike.man'" '(should have been 9788 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'makefile.dos'" '(506 characters)'
if test -f 'makefile.dos'
then
    echo shar: will not over-write existing file "'makefile.dos'"
else
cat << \SHAR_EOF > 'makefile.dos'
#makefile.dos    910322    NHA
#A DOS makefile for klondike
#
#Assumes that iolib.u? is already available somewhere along $IPATH.
#If you don't want to use iolib (because you have an ANSI screen/terminal
#and you are running out of memory) then you can do the following:
#    cp  klonstub.icn  iolib.icn
#    icont  -c  iolib.icn

.SUFFIXES:    .u1  .icn  .icx

.icn.u1:
    icont -c  $?

klondike.icx:    klondike.icn  kloncon.u1  klonstr.u1  klonsub.u1
    icont -u -Si1000 -Sn2000  klondike

clean:
    rm  -f  *.u?  klondike.icx
SHAR_EOF
if test 506 -ne "`wc -c < 'makefile.dos'`"
then
    echo shar: error transmitting "'makefile.dos'" '(should have been 506 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'makefile.unx'" '(444 characters)'
if test -f 'makefile.unx'
then
    echo shar: will not over-write existing file "'makefile.unx'"
else
cat << \SHAR_EOF > 'makefile.unx'
#makefile.unx    910322    NHA
#An unix makefile for klondike
#
#Assumes that iolib.u? and getchlib.u? are already available somewhere
#along $IPATH.
#Note that only getchlib is linked on the command line.  Everything else
#is linked in the program.

.SUFFIXES:    .u1  .icn

.icn.u1:
    icont -c  $?

klondike:    klondike.icn  kloncon.u1  klonstr.u1  klonsub.u1  getchlib.u1
    icont -u -Si1000 -Sn2000  klondike  getchlib.u1

clean:
    rm  -f  *.u?  klondike
SHAR_EOF
if test 444 -ne "`wc -c < 'makefile.unx'`"
then
    echo shar: error transmitting "'makefile.unx'" '(should have been 444 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'klonstub.icn'" '(571 characters)'
if test -f 'klonstub.icn'
then
    echo shar: will not over-write existing file "'klonstub.icn'"
else
cat << \SHAR_EOF > 'klonstub.icn'
#klonstub.icn    910310    NHA
#Stubs for iolib.icn
#Copy this file to iolib.icn to reduce runtime memory requirements.
#Obviously this will only be effective if you have an ANSI screen/terminal.

procedure setname (term)
    stop ("klondike:  invoked stub version of setname(", image(name), ")")
end

procedure getval (id)
    stop ("klondike:  invoked stub version of getval(", image(id), ")")
end

procedure igoto (cm, dstcol, dstline)
    stop ("klondike:  invoked stub version of igoto()")
end

procedure iputs (cp, affcnt)
    stop ("klondike:  invoked stub version of iputs()")
end
SHAR_EOF
if test 571 -ne "`wc -c < 'klonstub.icn'`"
then
    echo shar: error transmitting "'klonstub.icn'" '(should have been 571 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0
--
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]

From [e-mail]  Sun Apr 21 19:54:33 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 21 Apr 91 19:54:33 MST
Resent-From: [e-mail]
Received: from  by optima.cs.arizona.edu (4.1/15)
    id AB17137; Sun, 21 Apr 91 19:54:25 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sun, 21 Apr
 1991 19:53 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA03945; Sun, 21 Apr 91
 19:48:06 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sun, 21 Apr 1991 19:53 MST
Date: 21 Apr 91 14:07:16 GMT
From: eru!hagbard!sunic!mcsun!cernvax!chx400!chx400!hslrswi![e-mail]
 (Norman H. Azadian)
Subject: Klondike solitaire, v3.01, part 4/6
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Hasler AG


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    kloncon.icn
# This archive created: Sun Apr 21 15:04:11 1991
# By:    Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'kloncon.icn'" '(19868 characters)'
if test -f 'kloncon.icn'
then
    echo shar: will not over-write existing file "'kloncon.icn'"
else
cat << \SHAR_EOF > 'kloncon.icn'
#kloncon.icn    901029    NHA
# Console interface routines for Klondike.
#
# TO FIX:
#
#
# TO DO:
#
# -    develop a visual indication (for isQuiet) for a PC
# -    Click for each card moved in a stack ??
#

link    iolib                                #non-ANSI screen output subroutines


# constants
global    rankID, suitID                        #card identification chars
global    isANSI                                # non-&null for ANSI-compatible
global    isMonochrome                        # non-&null when running Black&White
global    output                                #function for writing control chars
global    lineCount                            #total possible rows on screen
# Video control strings, etc
global    Vnormal, Vreverse, Vblink, Vbold, VclearAll, VclearEOL, VbackSpace,Vbell
global  Vcontrols, ESC                        #set of control strings, ESC char
global    visualBell                            # non-&null when Vbell is visual
global    color                                #list of suit color strings


#    u s e r I n t e r r u p t
# Succeeds iff the user wishes to interrupt the action.
# THIS ROUTINE IS SYSTEM DEPENDENT.
# For DOS, we simply look to see if any keystroke is waiting, discarding
# it/them.  Your system may be different.
procedure userInterrupt ()
static keyWaiting
initial    {
    keyWaiting  :=  if \type(kbhit)  then  "kbhit"
}
    if \isDOS  then
        while keyWaiting()  do  {
            (getch() == "\0")  &  getch()    #eat interrupting keystroke
            return                            #success means "interrupt requested"
        }
    else
        (\keyWaiting)  &  keyWaiting()  &  getch()  &  return
    fail                                    #failure = "interrupt NOT requested"
end                                            #userInterrupt


#    m y P u t s
# Output all the strings, using iputs() for control strings.
# This slightly cheesy algorithm requires that all control strings
# start with ESC.  This, however, does not apply when \isANSI,
# since this routine isn't called then.
# Note that if isQuiet changes while running (using debug command), then
# Vbell and visualBell may not be optimally set.
procedure myPuts (sl[])
static outstr
local s
initial    {
    outstr := table("Oops!")
    outstr[VclearAll]    := getval("cl")     |  (getval("ho") || getval("cd"))
    outstr[VclearEOL]    := getval("ce")
    outstr[Vnormal]        := getval("me") || getval("ue")
    outstr[Vbold]        := getval("md" | "us")
    outstr[Vblink]        := getval("mb")
    outstr[Vreverse]    := getval("mr" | "so")
    outstr[VbackSpace]    := if getval("bs")  then  "\b"  else  getval("le")
    if \isQuiet  then
        outstr[Vbell]    := (visualBell := getval("vb"))  |  getval("bl")
    else
        outstr[Vbell]    := getval ("bl")  |  "\^G";
}
    while s := string(get(sl))  do
        s ?    {
            while writes (tab(upto(ESC)))  do
                iputs (outstr[=(!Vcontrols)])
            writes (tab(0))
        }
    return
end                                            #myPuts


#    g e t A N S I t y p e
# Determine if this ANSI-compatible screen is monochrome or color.
# This only works on a PC with the ANSI.SYS (or similar) driver installed.
procedure getANSItype ()
local i
    if \isPC  then  {
        i := ord (Peek([16r40, 16r49]))            #BIOS display mode byte
        case i  of  {
            2        :    isMonochrome := 1
            3        :    isMonochrome := &null    #living color
            7        :    isMonochrome := 1
            default    :    stop ("Klondike:  unknown BIOS display mode ", i)
        }
    } else
        runerr (500, "Klondike:  but I thought you were on a PC !")
    return
end                                            #getANSItype


#    i n i t C o n s t a n t s
# Initialize the program "constants".  These are actually variables that
# are set just once at the beginning of the world.
procedure initConstants (termtype)
local Vred, Vblack                            #suit color strings

    lineCount := 25                            #assume the best
    case  (map(termtype, &lcase, &ucase))  of  {
        "PC"    :    { getANSItype ();            isANSI := 1        }
        "MONO"    :    { isMonochrome := 1;        isANSI := 1     }
        "COLOR"    :    { isMonochrome := &null;    isANSI := 1        }
        default    :    { isMonochrome := 1;        isANSI := &null
                        (0 < *termtype)  &  setname (termtype)
                        lineCount := getval("li")
        }
    }
    (lineCount < 24)  &
        stop ("klondike: need at least 24-line terminal.  Yours is ", lineCount)

    # Use this function for outputting any string containing control characters,
    # unless you're sure that the screen is ANSI-compatible.
    output  :=  if \isANSI  then  writes  else  myPuts

    # set Video control strings, plus the set of all Video control strings
    ESC                := "\e"                    #escape character
    VclearAll        := "\e[2J"                #clear screen and home cursor
    VclearEOL        := "\e[K"                #clear to End Of Line
    Vnormal            := "\e[0m"
    Vbold            := "\e[1m"
    Vblink            := "\e[5m"
    Vreverse        := "\e[7m"
    if \isANSI  then  {
        VbackSpace    := "\b"
        Vbell        := "\^G"
    } else {
        #additional escape required for myPuts()
        VbackSpace    := "\e\b"
        Vbell        := "\e\^G"                #ding dong, Avon calling
    }
    Vcontrols         := set( [VclearAll, VclearEOL, Vnormal, Vbold,
                            Vblink, Vreverse, VbackSpace, Vbell] )

    if \isMonochrome  then  {
        Vred    := Vnormal
        Vblack    := Vreverse
    } else {
        Vred    := "\e[0;47;31m"            # "extra" 0 seems to be necessary
        Vblack    := "\e[0;47;30m"            # "extra" 0 seems to be necessary
    }

    # Suits are: 1=Hearts, 2=Diamonds, 3=Clubs, 4=Spades
    suitID := if \isPC  then  "\3\4\5\6"  else  "HDCS"
    color  := [Vred, Vred, Vblack, Vblack]
    rankID := "A23456789TJQK"
    return
end                                            #initConstants


#    i n i t S c r e e n
# Initialize output and write the fixed parts of the screen.
# initConstants() must have been called earlier.
# Note that the screen and its mode must remain unmodified if \invisible.
procedure initScreen ()
local f
static vertical
initial {
    vertical  :=  if \isANSI  then  "\272"  else  "|"
}

    (\invisible)  &  return
    if \isANSI  then  {
        if (\isPC)  then
            if \isMonochrome  then  writes ("\e[=2h")    #25x80 B&W   text mode
            else  writes ("\e[=3h")                        #25x80 color text mode
        writes (Vnormal, VclearAll, "\e[=7l")        #clear screen, prevent wrap
    } else {
        if not iputs (getval("is"))  then  {        #terminal Init Ftring
            if f := open (getval("if"), "r") then {    #terminal Init File
                while writes (reads(f))                ## should use iputs() ??
                close (f)
            }
        }
        iputs (getval("ti"))                        #Termcap Init string
        output (VclearAll)
    }

    every writeStackNumber (1 to 7, Vnormal)
    writeCursor (2, 64)
    if \isANSI  then
        writes ("\311\315\315\315\315SOLITAIRE\315\315\315\315")
    else
        writes ("=====SOLITAIRE====")
    every writeAt (3 to lineCount, 64, vertical)
    outputAt ((if lineCount = 25 then  25  else  1),  66,
                Vbold, "Q", Vnormal, "=Quit  ", Vbold, "H", Vnormal, "=Help")
    return
end                                            #initScreen


#    t e r m i n a t e S c r e e n
# Put the screen in the correct state prior to program termination.
procedure terminateScreen ()
static resetCooked
initial    {
    resetCooked  :=  if \type(reset_tty)  then  "reset_tty"
}
    if /invisible  then
        if \isANSI  then
            write ("\e[=7h", VclearAll, Vnormal)    #set cursor wrap mode
        else {
            output (VclearAll, Vnormal, getval("te"))
            (/isDOS)  &  (\resetCooked)  &  resetCooked ()
        }
    return
end                                            #terminateScreen


#    w r i t e C u r s o r
# Position the cursor to row,col.
# Screen origin (top left corner) is row=1 and col=1.
procedure writeCursor (row, col)
static cm
initial {
    (\isANSI)  |  (cm  :=  (getval("cm")  |  (getval("ch") || getval("cv"))))
}
    if /invisible  then
        if \isANSI  then
            writes ("\e[", row, ";", col, "H")
        else
            iputs (igoto(cm, col, row))
    return
end                                            #writeCursor


#    w r i t e A t
# Position the cursor to row,col and then write the following string(s).
# Screen origin (top left corner) is row=1 and col=1.
# Note that the standard write() should normally not be used because the newline
# doesn't work when running in raw mode under unix.
procedure writeAt (row, col, s[])
    if /invisible  then  {
        writeCursor (row, col)
        writes! (s)
    }
    return
end                                            #writeAt


#    o u t p u t A t
# Position the cursor to row,col and then write the following string(s).
# Screen origin (top left corner) is row=1 and col=1.
procedure outputAt (row, col, s[])
    if /invisible  then  {
        writeCursor (row, col)
        output! (s)
    }
    return
end                                            #outputAt


#    w r i t e S t a c k N u m b e r
# Write the indicated stack number with the specified video attribute.
# Note that this will almost surely alter your current cursor position.
procedure writeStackNumber (num, attr)
    (\invisible)  | outputAt (1, [3,12,21,30,39,48,57][num], attr, num, Vnormal)
    return
end                                            #writeStackNumber


#    w r i t e F r o n t
# Displays an image of the specified card fronts at the specified spot.
## WARNING: The input cards must be in a list!
# Top left corner of the first card will be placed at the specified position.
# Successive cards are displayed two rows higher (lower position on the screen).
# Cursor need not be in any particular position before this, and is left
# in a random position afterwards.  Video is always left normal (not reversed).
# Cards are 7 columns wide by 5 rows tall.
# We only display the first 2 rows of each card, except for the top card.
# With 25 rows, we can put 12 cards in a stack (assuming we start in row 2).
# But if there are 11 in the stack we can only display 4 rows of the top card.
# If there are 12 cards, we can only display 2 rows of the topmost card.
# With a 24 row screen, the topmost card (a 2) is moved up one line on a full
# stack.  This will obscure the 3 that it is resting on, but the topmost 2 will
# be visible, which is rather more important.
##We can only write a row at a time due to a problem with ANSI col 80 handling.
procedure writeFront (cardlist, row, col)
local card
static vertical, topHorizontal, bottomHorizontal
initial {
    if \isANSI  then  {
        topHorizontal     := "\332\304\304\304\304\304\277"
        vertical         := "\263"
        bottomHorizontal := "\300\304\304\304\304\304\331"
    } else {
        topHorizontal     := "-------"
        vertical         := "|"
        bottomHorizontal := "-------"
    }
}
    dieIf (lineCount < row, row)
    # output first 2 rows of every card
    # for long stack and short screen the next-to-top card is mostly obscured
    every  card := !cardlist  do  {
        (row = lineCount)  &  (row -:= 1)            #long stack, short screen
        outputAt (row, col, Vreverse, topHorizontal)
        outputAt (row+:=1, col, vertical, color[card.suit], rankID[card.rank],
                        suitID[card.suit], Vreverse, "   ", vertical)
        row +:= 1
    }

    # maybe put out some more rows of the top card
    if row <= lineCount  then  {
        outputAt (row, col, Vreverse, vertical, "     ", vertical)
        if (row +:= 1) <= lineCount  then  {
            outputAt (row, col, vertical, "   ", color[card.suit],
                       rankID[card.rank], suitID[card.suit], Vreverse, vertical)
            if (row +:= 1) <= lineCount  then
                writeAt (row, col, bottomHorizontal)    #last row of top card
        }
    }
    output (Vnormal)
    return
end                                            #writeFront


#    w r i t e B a c k
# Puts an image of the back of a card at the specified spot on the screen.
procedure writeBack (row, col)
static backLine
local i
initial {
    backLine := list(5)
    if \isANSI  then  {
        backLine[1] := "\332\304\304\304\304\304\277"
        backLine[2] := "\263\332\304\304\304\277\263"
        backLine[3] := "\263\263\040\040\040\263\263"
        backLine[4] := "\263\300\304\304\304\331\263"
        backLine[5] := "\300\304\304\304\304\304\331"
    } else {
        backLine[1] := "-------"
        backLine[2] := "| --- |"
        backLine[3] := "| | | |"
        backLine[4] := "| --- |"
        backLine[5] := "-------"
    }
}
    (\invisible)  |  (every writeAt (row, col, !backLine)  do  row +:= 1)
    return
end                                            #writeBack


#    w r i t e B l a n k
# Blanks a card-sized area at the specified spot on the screen.
procedure writeBlank (row, col)
    (\invisible)  |  (every writeAt (row + (0 to 4),  col,  "       "))
    return
end                                            #writeBlank


#    w r i t e S t a c k
# Display the specified stack.  Left end is bottom of stackUp, top of stackDown.
# Stacks start in row 2, column1; with 2 columns between stacks.
# Optimized to avoid re-writing cards that are already on the screen.
# prevs[] holds, for each stack, the total number of visible (up) cards
# on that stack as of the last time writeStack() was called.  This allows
# us to simply draw (or erase) the cards that have been added (or subtracted).
# By special arrangement, this routine can be called with a negative stack
# number!  This is a hint that our idea of what is on the display is actually
# wrong, and therefore the entire stack needs to be re-displayed.  This can
# happen in two situations:  1) in refreshScreen(), the entire screen is cleared
# before calling writeStack();  2) in undo() when undoing a move between
# stacks, the bottom card needs to be changed, although the normal algorithm
# would consider that it is already correctly displayed.  Note that in neither
# case is the stack shrinking, therefore we don't need to worry about erasing
# any cards that were displayed last time.
procedure writeStack (n)
local row, col
static prevs, blankLine, firstRow, lastRow
initial    {
    prevs := [0,0,0,0,0,0,0]                    #previous stack height displayed
    blankLine := repl (" ", 7)
    # first and last screen rows for each card in a stack
    firstRow := [2,4,6,8,10,12,14,16,18,20,22,24]
    lastRow  := [6,8,10,12,14,16,18,20,22,24,lineCount,lineCount]
}
    (\invisible)  &  return
    (n < 0)  &  (prevs[n := abs(n)] := 0)        #n < 0  forces complete re-write
    col := (n * 9) - 8                            #leftmost column for this stack

    if (*stackUp[n]) <= prevs[n]  then  {
        # the stack just got smaller (or stayed the same)
        # blank out two rows for each card that has been removed
        row := lastRow[prevs[n]] + 1            #<last row used by top card> + 1
        while *stackUp[n] < prevs[n]  do  {
            every  writeAt (row -:= (1 | 1),  col,  blankLine)
            prevs[n] -:= 1                        #countdown and update
        }
        dieIf (*stackUp[n] ~= prevs[n], prevs[n])
        # re-write new top card
        if *stackUp[n] = 0  then
            (if *stackDown[n] = 0  then  writeBlank  else  writeBack) (2, col)
        else
            writeFront ([stackUp[n][-1]], firstRow[prevs[n]], col)
    } else {
        # the stack just got bigger -- display new cards
        writeFront (stackUp[n][prevs[n]+1:0], firstRow[prevs[n]+1], col)
        prevs[n] := *stackUp[n]                #remember how much is displayed
    }
    # display the number of hidden cards
    writeAt (4, (7 + col), " 123456???"[1+*stackDown[n]])
    return
end                                            #writeStack


#    w r i t e P i l e
# Displays an image of the specified ace pile, face up (or blank if empty)
procedure writePile (n)
static pileRow, pileCol
initial {
    pileRow := [3,3,9,9]
    pileCol := [66,74,66,74]
}
    if /invisible  then
        if  0 = pile[n]  then
            writeBlank (pileRow[n], pileCol[n])
        else
            writeFront ([card(n,pile[n])], pileRow[n], pileCol[n])
    return
end                                            #writePile


#    w r i t e D e c k D o w n
# Displays an image of deckDown (the face-down deck) in the proper spot.
# Avoids re-displaying blank or card back that is already on the screen.
# Parameter is non-null to force displaying something (assuming not invisible).
procedure writeDeckDown (forget)
static p
initial    {
    forget := 1                                #assume the screen is blank
}
    if /invisible  then  {
        (\forget)  &  (p := writeDeckDown)    #anything but writeBlank | writeBack
        (p ~===:= (if 0 < *deckDown  then  writeBack else writeBlank)) (20, 74)
        writeAt (19, 76, right(*deckDown, 2))    #display card count in deckDown
    }
    return
end                                            #writeDeckDown


#    w r i t e D e c k U p
# Displays an image of deckUp (the face-up deck) in the proper spot.
procedure writeDeckUp ()
    if /invisible  then  {
        writeFront ([deckUp[1]], 20, 66)  |  writeBlank (20, 66)
        writeAt (19, 68, right(*deckUp, 2))        #write number of cards in deckUp
    }
    return
end                                            #writeDeckUp


#    c o u n t C o n t r o l s
# Returns a count of video control sequences in the proffered string.
# This is not a very general algorithm, being valid only for our V constants.
procedure countControls (s)
local count                                    #of [invisible] video control chars
local seq                                    #control sequence found
    count := 0
    every  find ((seq := (!Vcontrols)), s)  do  count +:= *seq
    return count
end                                            #countControls


#    w r i t e I n f o
# Displays a new short string (up to 16 printing characters) centered in the
# officially approved information area of the screen.
# All known video attributes (in set "Vcontrols") are specially handled.
# An empty string results in clearing the area.
# We always revert to normal text mode after outputting the string.
procedure writeInfo (s)
    (\invisible)  |  outputAt (15, 65, Vnormal, VclearEOL,
                            trim(center(s, 16+countControls(s)), ' '), Vnormal)
    return
end                                            #writeInfo


#    c l i c k
# Make a quick sound to accompany card transfers, if possible and not Quiet.
procedure click ()
local x
    if (not \isQuiet)  &  (\isPC)  then  {
        x := InPort (16r61)
        OutPort (16r61, 3)
        OutPort (16r61, x)
    }
    return
end                                            #click


#    b e e p
# The short beep produced under isPC is not as annoying as the normal beeeeep.
# This always puts out something, although it might be a visual indication.
procedure beep ()
local x
    if (\isPC)  then  {                        #no visual indication yet for a PC
        x := InPort (16r61)
        every  | OutPort (16r61, 3) \ 22
        OutPort (16r61, x)
    } else
        output (Vbell)
    return
end                                            #beep


#    c o m p l a i n
# Let the boob know he done something wrong, with a dash of humor.
# Complaint can be specified, otherwise a generic one will be selected for you.
# Phrases can be up to 16 visible characters long.
# Additionally there may be embedded recognized video control sequences.
# Complaint will always be bold, and will blink if isQuiet.
procedure complain (complaint)
static phrases
local f, s
initial {
    phrases := ["INVALID"]                    #irreducible minimum
    if \phraseFile  then  {
        if f := open((directory || phraseFile), "r")  then  {
            while put (phrases,
                        trim(center(s, 16+countControls(s := read(f))), ' '))
            close (f)
            (1 < *phrases)  &  pop(phrases)    #success -- remove ours
        }
    } else {
        phrases |||:= [
"cut that out!",    "oops!",            "be nice!",         "get real",
"be serious",        "What??",            "huh?",                "idiot alert",
"dummy!",            "Hey man!",            "giggle giggle",    "engage brain",
"NOW what?",        "yuk yuk",            "funky dude",        "wake up, man",
"yeah, real funny",    "totally awesome",    "boffo",            "boogie boogie",
"Bozo!",            "watch it!",        "oi vey",            "~@?$!&*=(*%^!*",
"forty lashes!",    "way cool, dude",    "ha ha ha",            "see an analyst",
"go fly a kite",    "wish upon a star",    "basket case",        "braindamaged",
"dummkopf",            "holy cow",            "reject",            "try harder",
"think again",        "watch your hands",    "We're not amused",    "adjust fingers",
"gimme a break",    "R U 4 real ?",        "that's a laugh",    "Ho Ho Ho",
"space case",        "space cadet",        "call AA",            "oh yeah?",
"dum de dum dum",    "try thinking",        "sigh",                "get a life"
        ]
    }
    (\debugging)  &  writeInfo (*phrases || " phrases")
}
    /complaint := ?phrases
    #Note that isQuiet can change while running if debugging is enabled (-Z)
    if (\isQuiet)  &  (not \visualBell)  then
        writeInfo (Vbold || Vblink || complaint)
    else {
        writeInfo (Vbold || complaint)
        beep()
    }
    return
end                                            #complain


#    g e t C m d C h a r
# Returns an upper-case command character, echoed to current cursor position.
# Fails if character wasn't "normal" and complaint was made.
# For ESC, abort information is written, and ESC is returned.
# Normal calling sequence (from within a command procedure) is thus:
#        until (s := getCmdChar ())
#        (s == ESC)  &  fail
# Under DOS, F1 [function key 1] is specially treated as a request for Help.
procedure getCmdChar ()
local s
    s := getch ()                            #get command character
    if s == "\0"  then  {                    #non-ASCII character
        s := getch ()                        #check keyboard scan code
        if (\isDOS)  &  (s == ";")  then  {
            s := "h"                        #jigger F1 to look like "Help"
        } else {
            complain ()
            fail
        }
    }
    s := map (s, &lcase, &ucase)
    if s == ESC  then
        writeInfo (Vbold || "Cmd Aborted.")
    else
        writes (s)                            #echo the command character
    return  s
end                                            #getCmdChar


#    r e f r e s h S c r e e n
# Re-write entire screen.
procedure refreshScreen ()
    if /invisible  then  {
        initScreen ()
        every writeStack (-1 to -7 by -1)
        every writePile (1 to 4)
        writeDeckDown (1)
        writeDeckUp ()
    }
    return
end                                            #refreshScreen
SHAR_EOF
if test 19868 -ne "`wc -c < 'kloncon.icn'`"
then
    echo shar: error transmitting "'kloncon.icn'" '(should have been 19868 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0
--
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]

From [e-mail]  Sun Apr 21 19:55:13 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 21 Apr 91 19:55:13 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA17181; Sun, 21 Apr 91 19:55:05 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sun, 21 Apr
 1991 19:53 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA03979; Sun, 21 Apr 91
 19:48:51 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sun, 21 Apr 1991 19:54 MST
Date: 21 Apr 91 14:06:05 GMT
From: eru!hagbard!sunic!mcsun!cernvax!chx400!chx400!hslrswi![e-mail]
 (Norman H. Azadian)
Subject: Klondike solitaire, v3.01, part 3/6
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Hasler AG


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    klondike.icn
# This archive created: Sun Apr 21 15:03:59 1991
# By:    Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'klondike.icn'" '(19820 characters)'
if test -f 'klondike.icn'
then
    echo shar: will not over-write existing file "'klondike.icn'"
else
cat << \SHAR_EOF > 'klondike.icn'
#klondike.icn    901207    NHA
#The Klondike version of Solitaire; main program and command routines.
#
# TO FIX:
#
#
# TO DO:
#
# -    Add a "cheated" flag ??
# -    Find a better way to determine isPC.
# -    Implement an heuristic to discover optimal play
#

link    kloncon                                #klondike console I/O subroutines
link    klonstr                                #klondike strategy subroutines
link    klonsub                                #klondike miscellaneous subroutines

record card(suit, rank)                        #suit is 1..4, rank is 1..13

#    v a r i a b l e s
# lists of record card
global deckUp                                #face Up portion of deck (stock)
global deckDown                                #face Down portion of deck
global stackUp                                #list of face Up cards per stack
global stackDown                            #list of face Down cards per stack
# others
global pile                                    #ace piles - top rank only
global ops                                    #list of all operations ever done
global isDOS, isPC                            # "state of our world" flags
global debugging, automaticAce                #command-line flags
global invisible, isQuiet                    # for visual and audible feedback
global strategy                                #strategy to use for automatic play
global directory, phraseFile                #pathnames
global firstSeed, lastSeed                    #&random remembered
global totalGames, totalAces, totalWins        #ace pile statistics


#    u h e l p
# Provide command summary for user, plus statistics to date, if any.
procedure uhelp ()
local row, info
static helpInfo
initial    {
    helpInfo := [
        ["A", "Automatic", " mode -- finish out this game on automatic pilot"],
        ["B", "Boss", " key for when you-know-who visits"],
        ["C","Continuous"," mode -- play games continuously until interrupted"],
        ["F", "Find", " (next) useful move to do"],
        ["H,?", "Help", ", this help screen"],
        ["M", "Move", " card (or stack) from Deck/Stack to Stack/Ace pile"],
        ["Q", "Quit", " this game"],
        ["S", "Suggest", " (another) possible move"],
        ["T", "Thumb", " through the deck"],
        ["U", "Undo", " -- back up one move"],
        ["Z", "Debug", ""],
        ["^L", "re-draw", " screen"],
        ["ESC", "Escape", " -- abort current command"]
    ]
}
    output (VclearAll, Vnormal)
    output ("Klondike version 3.01  910330 NHA\t\t", &version)
    outputAt (4, 4, "The following commands are available:")
    row := 6
    every info := !helpInfo  do
        if (\debugging)  |  (info[1] ~== "Z")  then  {
            outputAt (row,  8, Vbold, info[1])
            outputAt (row, 16, info[2], Vnormal, info[3])
            row +:= 1
        }

    if 0 < totalGames  then
        writeAt (21, 1, "totalGames = ", totalGames,
                "   totalWins = ", totalWins,
                "   totalAces = ", totalAces,
                "   average = ",
                left (string(real(totalAces) / real(totalGames)), 6) )
    outputAt (24, 20, Vblink, "Press any key to resume game", Vnormal)
    (getch() == "\0")  &  getch()            #wait for a keystroke & swallow it
    refreshScreen ()
    return
end                                            #uhelp


#    f i n d 1
# Find the best move, thumbing as necessary to achieve it.
# Return the operation string for that move.
# Fails if there is nothing useful left to do.
# When Thumbing, fails upon second occurrence of *deckDown = 0.
# This is an internal routine but it does keep the user informed.
# Note that if automaticAce is set, any Ace uncovered whilst thumbing
# will be automatically moved and the search will continue.
procedure find1 ()
local emptySeen, s
    repeat  {
        /emptySeen  :=  (*deckDown = 0)
        (s := suggest())  &  return (s || "0")        #good move found
        ((*deckUp + *deckDown) = 0)  &  fail        #no cards to thumb through
        writeInfo (Vbold || "T" || Vnormal || "humb")
        push (ops, thumb())
        (\emptySeen)  &  (*deckDown = 0)  &  fail    #no point Thumbing forever
    }
end                                            #find1


#    u f i n d
# Thumb as necessary until a reasonable move appears, then stop and suggest it.
# When nothing is left to do, suggest "Quit".
# When invoked twice in a row, again will be non-null and we should take the
# previous suggestion and find the next.
# Returns success to request termination.
# Note that the suggestion is not necessarily the "best" suggestion.
# Note that if automaticAce is set, an uncovered Ace will be automatically
# moved and the search will continue.  It does not count as a move.
procedure ufind (again)
static lastOp
local s
    if \again  then
        if lastOp == "Q"  then  {            #pretend he typed "Q" instead of "F"
            output (VbackSpace, Vbold, "Q", Vnormal)
            return  uterminate ()            #Th.th.th.that's all, folks!
        } else  {
            writes ("ind")
            writeInfo ("")                                #clear prevs suggestion
            s := expandOp (lastOp)                        #build suggestion
            # show previous suggestion as current command
            outputAt (17, 65, "> ", left (s, 14 + countControls(s)))
            push (ops, move1(lastOp))  |  runerr (500, lastOp)        #execute it
            outputAt (17, 65, VclearEOL,Vnormal, "> F")    #go find next suggestion
        }
    writes ("ind")
    writeInfo (  expandOp (lastOp := (find1() | "Q") ) )    #suggest (next) move
    fail                                    #do NOT request a new game
end                                            #ufind


#    u s u g g e s t
# Suggest a (reasonable) possible move in this situation.
# Repeated invocations produce successive possibilities, until the
# only thing left to do is Thumb.
# "another" is non-null when this command was also the previous command.
# Suggestions are given in essentially random order, and thumbing is
# suggested only as a last resort.
procedure usuggest (another)
static suggestions, i
    writes ("uggest")
    if /another  then  {                    #prev command was NOT Suggest
        suggestions := []                    #generate a new list of suggestions
        every put ( suggestions, suggest() )
        i := 0
    }
    return  writeInfo (   expandOp (suggestions[i+:=1] | "T")   )
end                                            #usuggest


#    a u t o m a t i c
# Run the game, as far as possible, untouched by human hands
# This is an internal routine but it keeps the user informed.
# Returns total ace cards promoted when there is nothing useful left to do.
# Returns with failure when the user interrupts the proceedings.
procedure automatic ()
local op
    repeat  {
        userInterrupt()  &  fail                                #interrupted
        (!pile < 13)  |  return 52                                #victory
        if  not writeInfo (  expandOp ( op := findBest() )  )  then
            return (pile[1] + pile[2] + pile[3] + pile[4])        #no moves left
        push (ops, move1 (op))  |  runerr (500, op)
    }
end                                            #automatic


#    u a u t o m a t i c
# Play this hand automatically, untouched by human hands.
# This is the command fuction that interacts with the user.
procedure uautomatic ()
    writes ("utomatic")
    writeInfo (if automatic()  then  ""  else  "Interrupted")
    return
end                                            #uautomatic


#    u c o n t i n u o u s
# Plays automatic games -- forever (or until user interrupts)
procedure ucontinuous()
    writes ("ontinuous")
    repeat  {
        writeCursor (16, 65)                #between Info line and Command line
        writes (center ((string(totalGames) || "   " || string(totalAces)), 16))
        (totalAces +:= automatic())  |  (writeInfo ("Interrupted"),  break)
        totalGames +:= 1
        (!pile < 13)  |  (totalWins +:= 1)
        lastSeed := newGame()
        writeAt (17, 65, "> Continuous")
    }
    return
end                                            #ucontinuous


#    u m o v e
# Move a card from deck to stack, or from stack to ace pile,
# or move a stack to another stack.
# Parameter is the source [1-7 or D]; else &null to indicate that "M" was used
# and therefore source should be gathered from the keyboard.
# Fails if indicated move is not possible
# This is the routine that interacts with the user.
procedure umove (src)
local dst, c, op, moved, col
    if \src  then
        output (VbackSpace, "Move ", Vbold, src)
    else {
        output ("ove ", Vbold);
        until (src := getCmdChar ())
        (src == ESC)  &  return
    }
    col := 73
    if src == "D"  then  {
        (*deckUp = 0)  &  fail
        output (Vnormal, "eck")
        col +:= 3
    } else {
        any ('1234567', src)  |  fail
        (*stackUp[src] = 0)  &  fail
        writeStackNumber (src, Vblink)
        writeCursor (17, col)
    }

    output (Vnormal, " to ", Vbold)
    until (dst := getCmdChar ())
    col +:= 5
    if src ~== "D"  then  {
        writeStackNumber (src, Vnormal)
        writeCursor (17, col)
    }
    (dst == ESC)  &  return
    any ('A1234567', dst)  |  fail
    (dst == src)  &  fail
    (dst == "A")  &  (src ~== "D")  &  output (Vnormal, "ce")

    return  push (ops, move1("M" || src || dst || "0"))
end                                            #umove


#    u u n d o
# backup one move, including any automatic ace moves
procedure uundo ()
    writes ("ndo")
    undo()
    return
end                                            #uundo


#    u d e b u g
# Additional commands to support the implementer.
procedure udebug ()
local s, d, name
    (\debugging)  |  return complain()
    output (VbackSpace, "Debug ")
    until (s := getCmdChar ())
    case s  of  {
        ESC        :    fail                    #debug command aborted
        "A"        :    {                        #play this game again
                    writes ("gain")
                    &random := lastSeed
                    outputAt (22, 1, Vbold,
                                "&random set.  Quit to play this game again.",
                                Vnormal, VclearEOL)
                }
        "D"        :    display()                #dump ICON state
        "H"|"?"    :    {
                    output (if s == "?" then (VbackSpace || "help") else  "elp")
                    outputAt (22, 1, Vbold,
                     "Again, Dump, Options, Move, Peek{1-7UD}, Restore, Save, Toggle{AQT}.",
                     Vnormal, VclearEOL)
                }
        "M"        :    {                        #move, without legality checking
                    writes ("ove ")
                    until (s := getCmdChar ())    #Source
                    (s == ESC)  &  fail
                    (s == "A")  &  fail
                    until (d := getCmdChar ())    #Destination
                    (d == ESC)  &  fail
                    (d == s)  &  fail
                    any('1234567', d)  |  fail
                    if s == "D"  then  {
                        (*deckUp = 0)  &  fail
                        put (stackUp[d], get(deckUp))
                        writeDeckUp ()
                        writeStack (d)
                        push (ops, "MD" || d || "0")
                    } else {
                        moveStack (s, d)
                        push (ops, "M" || s || d || "123456789abcdef"[*stackUp[s]])
                    }
                }
        "O"        :    {                        #show command-line options
                    writes ("ptions")
                    outputAt (22, 1, Vbold,
                        if \automaticAce  then  "AutomaticAce  "  else  "",
                        if 0 < *directory then  ("-D"||directory||"  ") else "",
                        if \phraseFile  then  ("-P"||phraseFile||"  ") else  "",
                        if \isQuiet  then  "Quiet  "  else  "",
                        ("-S" || strategy),  Vnormal, VclearEOL)
                    outputAt (23, 1, Vbold, "&trace=", &trace,
                         "  firstSeed=", firstSeed, "  lastSeed=", lastSeed,
                         Vnormal, VclearEOL)
                }
        "P"        :    {                        #look at hidden cards
                    writes ("eek ")
                    until (s := getCmdChar ())
                    (s == ESC)  &  fail
                    outputAt (22, 1, VclearEOL, Vnormal)
                    if any('1234567', s)  then  showList (stackDown[s])
                    else if s == "D"      then  showList (deckDown)
                    else if s == "U"      then  showList (deckUp)
                    else complain ()
                }
        "R"        :    {                        #restore current state from a file
                    writes ("estore")
                    until (s := getCmdChar ())
                    (s == ESC)  &  fail
                    name := "klondike.sv" || s
                    if (d := restoreState(name))  then  {
                        refreshScreen()
                        outputAt (22, 1, Vbold, "Restored position from file ",
                                directory || name, " of ", d, Vnormal,VclearEOL)
                    } else {
                        outputAt (22, 1, Vblink, "Can't restore from file ",
                                directory || name, Vnormal, VclearEOL)
                    }
                }
        "S"        :    {                        #save current state to a file
                    writes ("ave ")
                    until (s := getCmdChar ())
                    (s == ESC)  &  fail
                    name := "klondike.sv" || s
                    writeCursor (22, 1)
                    if saveState (name)  then
                        output (Vbold, "Position saved in file ",
                                directory || name, Vnormal, VclearEOL)
                    else
                        output (Vblink, "Can't save in file ",
                                directory || name, Vnormal, VclearEOL)
                }
        "T"        :    {                        #toggle a command-line flag
                    writes ("oggle ")
                    until (s := getCmdChar ())
                    (s == ESC)  &  fail
                    case s  of  {
                        "A"        : automaticAce := if \automaticAce then &null
                                                                          else 1
                        "Q"        : isQuiet      := if \isQuiet then &null  else 1
                        "T"        : &trace       := if &trace = 0  then -1  else 0
                        default    : complain ()
                    }                                    #case for Toggle
                }
        default    :    complain ()
    }                                            #case for Debug command
    return
end                                            #udebug


#    u b o s s
# Cheese it, the Fuzz.
# Quick -- clear the screen and save the position in a file.
procedure uboss ()
    writes ("oss")                # "consistency is the hobgoblin of small minds"
    terminateScreen ()                        #put screen in the correct state
    writes ("C>")                            #look innocent
    saveState ("klondike.sav")
    exit ()
end                                            #uboss


#    w r i t e S t a t i s t i c s
# Using the global counter variables, compute & write out some elementary stats.
# These are written to stderr so as not to mess up any batch file which might
# be collecting statistics whilst running klondike in -Batch mode.
# Note that write() is kosher here since this should only be called after
# terminate() has been called to restore the screen to its original state.
procedure writeStatistics ()
    if 1 < totalGames  then  {
        write (&errout, "In ", totalGames, " games you put ", totalAces,
                " cards on the ace piles.")
        if 0 < totalAces  then
            write (&errout,
                    "Average ", real(totalAces) / real(totalGames),
                    " cards on the ace piles per game.")
        if 0 < totalWins  then
            write (&errout,
                    "You won ", totalWins, " (",
                    left((totalWins * 100.) / totalGames, 4),
                    "%) of those games.")
        write (&errout,
                "Average ", real(&time) / totalGames / 1000,
                " seconds per game.")
    } else {
        write (&errout,
                "In 1 game you put ", totalAces, " cards on the ace piles.")
        write (&errout, "Total time was ", real(&time) / 1000, " seconds.")
    }
    write (&errout, "Initial random seed was ", firstSeed)
    return
end                                            #writeStatistics


#    u t e r m i n a t e
# Returns success to quit this game and start another.
# Returns failure to just continue this game.
# If program termination is wished, that is done right here.
procedure uterminate ()
local s
    if (!pile < 13)  then
        writes ("uit")
    else
        outputAt (12, 22, Vbold, Vblink, "Congratulations -- You've WON !!!",
                    Vnormal)
    writeInfo (Vbold || "Another game? ")
    until (s := getCmdChar ())
    case s  of  {
        ESC        :    fail                #didn't really want to quit after all
        "Y"        :    return                #please start a new game
        "N"        :    {                    #program termination requested
                    totalGames +:= 1
                    every totalAces +:= !pile
                    (!pile < 13)  |  (totalWins +:= 1)
                    terminateScreen ()
                    writeStatistics ()
                    exit ()
        }
        default    :    {complain(); fail}    #continue playing this game
    }
    runerr (500, s)
end                                            #uterminate


#    d o B a t c h
# Plays the requested number of games in batch mode.
# Returns three-element list of results.
# If the number of games to play is 0 or negative, then plays until interrupted.
procedure doBatch (gamesToPlay)
local games, wins, aces
    games := wins := aces := 0
    repeat  {
        newGame ()
        if aces +:= automatic()  then  {
            (!pile < 13)  |  (wins +:= 1)
            ((games +:= 1) = gamesToPlay)  &  break
        } else
            break                            #interrupted from keyboard
    }
    return  [games, wins, aces]
end                                            #doBatch


#    u b a t c h
# Plays the requested number of games (0 => infinity) in batch mode.
# Results are reported after every interval (0 => only at end) games.
# Statistics are output when done or interrupted, whichever comes first.
procedure ubatch (gamesToPlay, interval)
local veryFirstSeed, stat
    isQuiet := invisible := 1
    veryFirstSeed := &random                #remember the initial random seed
    (interval = 0)  &  (interval := gamesToPlay)
    repeat  {
        (0 < gamesToPlay)  &  (interval >:= gamesToPlay)
        firstSeed := &random                #random seed for first game this set
        stat := doBatch (interval)
        write (firstSeed, "\t", stat[1], "\t", stat[2], "\t", stat[3])
        totalGames +:= stat[1]
        totalWins  +:= stat[2]
        totalAces  +:= stat[3]
        (stat[1] ~= interval)  &  break        #interrupted by user
        (0 = (gamesToPlay -:= interval))  &  break
    }
    firstSeed := veryFirstSeed                #required for writeStatistics()
    writeStatistics ()
    exit ()
end                                            #ubatch


#    m a i n
procedure main (av)
local s, prevsCmd, batchMode, reportInterval, again, termtype

    # initialize
    isDOS := find("MS-DOS", &host)            #probably a reasonable assumption
    isPC  := isDOS                            #really a pretty poor assumption
    totalGames:=totalAces:=totalWins := 0    #statistics

    # set defaults
    findBest("")                            # set global variable strategy
    automaticAce    := 1                    # automatic ace handling
    debugging        := &null                # no debugging allowed
    directory        := ""                    # use current directory
    invisible        := &null                # let's see the action
    batchMode        := &null                # interactive mode
    reportInterval    := 0                    # report only at end of batch mode
    phraseFile        := &null                # use all built-in phrases
    isQuiet            := &null                # make clicks & beeps if possible
    termtype        := if \isPC then "pc" else "mono"
    &random            := map (&clock, ":", "7")        # randomize the seed

    # deal with command-line parameters
    reverse(getenv("KLONDIKE")) ?             #pre-pend env var words to cmd line
        while tab(upto(~" \t\v\f\r\n"))  do
            push (av, reverse(tab(many(~" \t\v\f\r\n"))))
    while s := get (av)  do
        case s[1:3]  of  {
            "-A" | "-a"    :    automaticAce    :=if \automaticAce then &null else 1
            "-B" | "-b"    :    batchMode        :=    (integer(s[3:0])  |  0)
            "-D" | "-d"    :    directory        :=    if *s < 3  then
                                                    getenv ("HOME" | "ROOTDIR")
                                                else
                                                    s[3:0]
            "-I" | "-i"    :    reportInterval    :=    (integer(s[3:0])  |  1)
            "-P" | "-p"    :    phraseFile        :=    s[3:0]
            "-Q" | "-q"    :    isQuiet            :=    if \isQuiet then  &null  else  1
            "-R" | "-r"    :    &random         :=    integer (s[3:0])
            "-S" | "-s"    :    findBest (s[3:0])            #check & store strategy
            "-T" | "-t"    :    termtype        :=    s[3:0]
            "-Z" | "-z"    :    debugging        :=    if \debugging then  &null else 1
            default        :    {
                            # screen mode not yet initialized, so write() is OK
                            write ("klondike  [-AQZ]  [-B[count]]  [-D[dir]]  [-I[interval]]")
                            write ("          [-P[file]]  [-Rseed]  [-Sstrategy]  [-T[term]]")
                            # screen mode not yet initialized, so stop() is OK
                            stop ("klondike: bogus option  ", s)
            }
        }

    # initializations which use command-line parameters
    (map(termtype, &lcase, &ucase) == "PC")  &  isPC := 1
    initConstants (termtype)                #need updated termtype from cmdline
    initVariables ()                        #establish all the lists and such

    # when defined, batchMode is the number of games to play; 0 => infinity.
    ubatch (\batchMode, reportInterval)        #conditional call of no return

    # Establish the directory for file I/O; with a trailing "/" if non-empty.
    # It is only used directly in the open() and remove() calls.
    (0 < *directory)  &  (directory := trim(directory, '/\\')  ||  "/")

    # If last game was terminated via the Boss key then restore it now,
    # otherwise start up a new game.
    if restoreState ("klondike.sav")  then  {
        refreshScreen ()
        writeInfo ("Game restored")
        remove (directory || "klondike.sav")
    } else {
        firstSeed := &random                    #random seed for first game
        lastSeed := newGame ()                    #start a new game, stashing seed
    }


    repeat  {                                    #game loop
        prevsCmd := "-none-"
        repeat  {                                    #command loop
            outputAt (17, 65, VclearEOL, Vnormal, "> ")        #clear command line
            until (s := getCmdChar ())
            again := (if s == prevsCmd  then  s  else  &null)
            writeInfo ("")                                    #clear info line
            writeCursor (17, 68)                            #just after cmd char
            case  s  of  {
                "?"|"H"    :    uhelp()
                "1"|"2"|"3"|"4"|"5"|"6"|"7"|"D"    :            #short-cut for Move
                            umove (s)  |  complain ()
                "A"        :    uautomatic()                    #look Ma, no hands!
                "B"        :    uboss()                            #bail out quick
                "C"        :    ucontinuous()                    #no hands, forever
                "F"        :    ufind (again)  &  break            #new game
                "M"        :    umove (&null)  |  complain ()
                "Q"        :    uterminate ()  &  break            #new game
                "S"        :    usuggest (again)
                "T"        :    { writes("humb");  push(ops, thumb()) }
                "U"        :    uundo()
                "Z"        :    udebug()
                "\^L"    :    refreshScreen()
                ESC        :    s                                #do nothing here
                default    :    complain()
            }                                #case
            prevsCmd := s
            (!pile < 13)  |  (uterminate ()  &  break)        # VICTORY!
        }                                    #repeat command
        totalGames +:= 1
        every totalAces +:= !pile
        (!pile < 13)  |  (totalWins +:= 1)
        lastSeed := newGame ()
    }                                        #repeat game
end                                            #main
SHAR_EOF
if test 19820 -ne "`wc -c < 'klondike.icn'`"
then
    echo shar: error transmitting "'klondike.icn'" '(should have been 19820 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0
--
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]

From [e-mail]  Sun Apr 21 20:11:07 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 21 Apr 91 20:11:07 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA17560; Sun, 21 Apr 91 20:11:02 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sun, 21 Apr
 1991 20:10 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA04085; Sun, 21 Apr 91
 19:53:24 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sun, 21 Apr 1991 20:10 MST
Date: 21 Apr 91 14:09:12 GMT
From: eru!hagbard!sunic!mcsun!cernvax!chx400!chx400!hslrswi![e-mail]
 (Norman H. Azadian)
Subject: Klondike solitaire, v3.01, part 6/6
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Hasler AG


#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#    iolib.icn
# This archive created: Sun Apr 21 15:04:45 1991
# By:    Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'iolib.icn'" '(17272 characters)'
if test -f 'iolib.icn'
then
    echo shar: will not over-write existing file "'iolib.icn'"
else
cat << \SHAR_EOF > 'iolib.icn'
########################################################################
#
#    Name:    iolib.icn
#
#    Title:    Icon termlib-type tools for MS-DOS and UNIX
#
#    Author:    Richard L. Goerwitz (with help from Norman Azadian)
#
#    Version: 1.9
#
#########################################################################
#
#  The authors place this and future versions of iolib in the public
#  domain.
#
#########################################################################
#
#  The following library represents a series of rough functional
#  equivalents to the standard Unix low-level termcap routines.  It is
#  not meant as an exact termlib clone.  Nor is it enhanced to take
#  care of magic cookie terminals, terminals that use \D in their
#  termcap entries, or archaic terminals that require padding.  This
#  library is geared mainly for use with ANSI and VT-100 devices.
#  Note that this file may, in most instances, be used in place of the
#  older UNIX-only itlib.icn file.  It essentially replaces the DOS-
#  only itlibdos routines.  For DOS users not familiar with the whole
#  notion of generalized screen I/O, I've included extra documentation
#  below.  Please read it.
#
#  The sole disadvantage of this over the old itlib routines is that
#  iolib.icn cannot deal with archaic or arcane UNIX terminals and/or
#  odd system file arrangements.  Note that because these routines
#  ignore padding, they can (unlike itlib.icn) be run on the NeXT and
#  other systems which fail to implement the -g option of the stty
#  command.  Iolib.icn is also simpler and faster than itlib.icn.
#
#  I want to thank Norman Azadian for suggesting the whole idea of
#  combining itlib.icn and itlibdos.icn into one distribution, for
#  suggesting things like letting drive specifications appear in DOS
#  TERMCAP environment variables, and for finding several bugs (e.g.
#  the lack of support for %2 and %3 in cm).  Although he is loathe
#  to accept this credit, I think he deserves it.
#
#########################################################################
#
#  Contents:
#
#  setname(term)
#    Use only if you wish to initialize itermlib for a terminal
#  other than what your current environment specifies.  "Term" is the
#  name of the termcap entry to use.  Normally this initialization is
#  done automatically, and need not concern the user.
#
#  getval(id)
#    Works something like tgetnum, tgetflag, and tgetstr.  In the
#  spirit of Icon, all three have been collapsed into one routine.
#  Integer valued caps are returned as integers, strings as strings,
#  and flags as records (if a flag is set, then type(flag) will return
#  "true").  Absence of a given capability is signalled by procedure
#  failure.
#
#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
#    Analogous to tgoto.  "Cm" is the cursor movement command for
#  the current terminal, as obtained via getval("cm").  Igoto()
#  returns a string which, when output via iputs, will cause the
#  cursor to move to column "destcol" and line "destline."  Column and
#  line are always calculated using a *one* offset.  This is far more
#  Iconish than the normal zero offset used by tgoto.  If you want to
#  go to the first square on your screen, then include in your program
#  "iputs(igoto(getval("cm"),1,1))."
#
#  iputs(cp,affcnt)
#    Equivalent to tputs.  "Cp" is a string obtained via getval(),
#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
#  count of affected lines.  It is completely irrelevant for most
#  modern terminals, and is supplied here merely for the sake of
#  backward compatibility with itlib, a UNIX-only version of these
#  routines (one which handles padding on archaic terminals).
#
##########################################################################
#
#  Notes for MS-DOS users:
#
#    There are two basic reasons for using the I/O routines
#  contained in this package.  First, by using a set of generalized
#  routines, your code will become much more readable.  Secondly, by
#  using a high level interface, you can avoid the cardinal
#  programming error of hard coding things like screen length and
#  escape codes into your programs.
#
#    To use this collection of programs, you must do two things.
#  First, you must add the line "device=ansi.sys" (or the name of some
#  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
#  nansi.sys]) to your config.sys file.  Secondly, you must add two
#  lines to your autoexec.bat file: 1) "set TERM=ansi-mono" and 2)
#  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
#  variable is to tell this program what driver you are using.  If you
#  have a color system, you could use "ansi-color" instead of
#  "ansi-mono," although for compatibility with a broader range of
#  users, it would perhaps be better to stick with mono.  The purpose
#  of setting TERMCAP is to make it possible to determine where the
#  termcap database file is located.  The termcap file (which should
#  have been packed with this library as termcap.dos) is a short
#  database of all the escape sequences used by the various terminal
#  drivers.  Set TERMCAP so that it reflects the location of this file
#  (which should be renamed as termcap, for the sake of consistency
#  across UNIX and MS-DOS spectra).  If desired, you can also try
#  using termcap2.dos.  Certain games work a lot better using this
#  alternate file.  To try it out, rename it to termcap, and set
#  the environment variable TERMCAP to its location.
#
#    Although the authors make no pretense of providing here a
#  complete introduction to the format of the termcap database file,
#  it will be useful, we believe, to explain a few basic facts about
#  how to use this program in conjunction with it.  If, say, you want
#  to clear the screen, add the line,
#
#    iputs(getval("cl"))
#
#  to your program.  The function iputs() outputs screen control
#  sequences.  Getval retrieves a specific sequence from the termcap
#  file.  The string "cl" is the symbol used in the termcap file to
#  mark the code used to clear the screen.  By executing the
#  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
#  (clear) code in the termcap database entry for your terminal, and
#  the 2) outputting that sequence to the screen.
#
#    Some other useful termcap symbols are "ce" (clear to end of
#  line), "ho" (go to the top left square on the screen), "so" (begin
#  standout mode), and "se" (end standout mode).  To output a
#  boldfaced string, str, to the screen, you would write -
#
#    iputs(getval("so"))
#    writes(str)
#    iputs(getval("se"))
#
#  You can also write "writes(getval("so") || str || getval("se")),
#  but this would make reimplementation for UNIX terminals that
#  require padding rather difficult.
#
#    It is also heartily to be recommended that MS-DOS programmers
#  try not to assume that everyone will be using a 25-line screen.
#  Most terminals are 24-line.  Some 43.  Some have variable window
#  sizes.  If you want to put a status line on, say, the 2nd-to-last
#  line of the screen, then determine what that line is by executing
#  "getval("li")."  The termcap database holds not only string-valued
#  sequences, but numeric ones as well.  The value of "li" tells you
#  how many lines the terminal has (compare "co," which will tell you
#  how many columns).  To go to the beginning of the second-to-last
#  line on the screen, type in:
#
#    iputs(igoto(getval("cm"), 1, getval("li")-1))
#
#  The "cm" capability is a special capability, and needs to be output
#  via igoto(cm,x,y), where cm is the sequence telling your computer
#  to move the cursor to a specified spot, x is the column, and y is
#  the row.  The expression "getval("li")-1" will return the number of
#  the second-to-last line on your screen.
#
##########################################################################
#
#  Requires: UNIX or MS-DOS, co-expressions
#
#  See also: itlib.icn, iscreen.icn
#
##########################################################################


global tc_table, isDOS
record true()


procedure check_features()

    initial {

    if find("UNIX",&features) then
        isDOS := &null
    else if find("MS-DOS", &features) then
        isDOS := 1
    else stop("check_features:  OS not (yet?) supported.")

    find("expressi",&features) |
        er("check_features","co-expressions not implemented - &$#!",1)
    }

    return

end



procedure setname(name)

    # Sets current terminal type to "name" and builds a new termcap
    # capability database (residing in tc_table).  Fails if unable to
    # find a termcap entry for terminal type "name."  If you want it
    # to terminate with an error message under these circumstances,
    # comment out "| fail" below, and uncomment the er() line.

    #tc_table is global

    check_features()

    tc_table := table()
    tc_table := maketc_table(getentry(name)) | fail
    # er("setname","no termcap entry found for "||name,3)
    return "successfully reset for terminal " || name

end



procedure getname()

    # Getname() first checks to be sure we're running under DOS or
    # UNIX, and, if so, tries to figure out what the current terminal
    # type is, checking successively the value of the environment
    # variable TERM, and then (under UNIX) the output of "tset -".
    # Terminates with an error message if the terminal type cannot be
    # ascertained.  DOS defaults to "mono."

    local term, tset_output

    check_features()

    if \isDOS then {
        term := getenv("TERM") | "mono"
    }
    else {
    if not (term := getenv("TERM")) then {
        tset_output := open("/bin/tset -","pr") |
        er("getname","can't find tset command",1)
        term := !tset_output
        close(tset_output)
    }
    }

    return \term |
    er("getname","can't seem to determine your terminal type",1)

end



procedure er(func,msg,errnum)

    # short error processing utility
    write(&errout,func,":  ",msg)
    exit(errnum)

end



procedure getentry(name, termcap_string)

    # "Name" designates the current terminal type.  Getentry() scans
    # the current environment for the variable TERMCAP.  If the
    # TERMCAP string represents a termcap entry for a terminal of type
    # "name," then getentry() returns the TERMCAP string.  Otherwise,
    # getentry() will check to see if TERMCAP is a file name.  If so,
    # getentry() will scan that file for an entry corresponding to
    # "name."  If the TERMCAP string does not designate a filename,
    # getentry() will scan the termcap file for the correct entry.
    # Whatever the input file, if an entry for terminal "name" is
    # found, getentry() returns that entry.  Otherwise, getentry()
    # fails.

    local isFILE, f, getline, line, nm, ent1, ent2
    static slash, termcap_names
    initial {
    if \isDOS then {
        slash := "\\"
        termcap_names := ["termcap","termcap.dos","termcap2.dos"]
    }
    else {
        slash := "/"
        termcap_names := ["/etc/termcap"]
    }
    }


    # You can force getentry() to use a specific termcap file by cal-
    # ling it with a second argument - the name of the termcap file
    # to use instead of the regular one, or the one specified in the
    # termcap environment variable.
    /termcap_string := getenv("TERMCAP")

    if \isDOS then {
    if \termcap_string then {
        if termcap_string ? (
         not ((tab(any(&letters)), match(":")) | match(slash)),
         pos(1) | tab(find("|")+1), =name)
        then return termcap_string
        else isFILE := 1
    }
    }
    else {
    if \termcap_string then {
        if termcap_string ? (
            not match(slash), pos(1) | tab(find("|")+1), =name)
        then return termcap_string
        else isFILE := 1
    }
    }

    # The logic here probably isn't clear.  The idea is to try to use
    # the termcap environment variable successively as 1) a termcap en-
    # try and then 2) as a termcap file.  If neither works, 3) go to
    # the /etc/termcap file.  The else clause here does 2 and, if ne-
    # cessary, 3.  The "\termcap_string ? (not match..." expression
    # handles 1.

    if \isFILE            # if find(slash, \termcap_string)
    then f := open(termcap_string)
    /f := open(!termcap_names) |
    er("getentry","I can't access your termcap file.  Read iolib.icn.",1)

    getline := create read_file(f)

    while line := @getline do {
    if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
        entry := ""
        while (\line | @getline) ? {
        if entry ||:= 1(tab(find(":")+1), pos(0))
        then {
            close(f)
            # if entry ends in tc= then add in the named tc entry
            entry ?:= tab(find("tc=")) ||
            # recursively fetch the new termcap entry
            (move(3), getentry(tab(find(":"))) ?
             # remove the name field from the new entry
             (tab(find(":")+1), tab(0)))
            return entry
        }
        else {
            \line := &null # must precede the next line
            entry ||:= trim(trim(tab(0),'\\'),':')
        }
        }
    }
    }

    close(f)
    er("getentry","can't find and/or process your termcap entry",3)

end



procedure read_file(f)

    # Suspends all non #-initial lines in the file f.
    # Removes leading tabs and spaces from lines before suspending
    # them.

    local line

    \f | er("read_tcap_file","no valid termcap file found",3)
    while line := read(f) do {
    match("#",line) & next
    line ?:= (tab(many('\t ')) | &null, tab(0))
    suspend line
    }

    fail

end



procedure maketc_table(entry)

    # Maketc_table(s) (where s is a valid termcap entry for some
    # terminal-type): Returns a table in which the keys are termcap
    # capability designators, and the values are the entries in
    # "entry" for those designators.

    local k, v

    /entry & er("maketc_table","no entry given",8)
    if entry[-1] ~== ":" then entry ||:= ":"

    /tc_table := table()

    entry ? {

    tab(find(":")+1)    # tab past initial (name) field

    while tab((find(":")+1) \ 1) ? {
        &subject == "" & next
        if k := 1(move(2), ="=") then {
        # Get rid of null padding information.  Iolib can't
        # handle it (unlike itlib.icn).  Leave star in.  It
        # indicates a real dinosaur terminal, and will later
        # prompt an abort.
        str := ="*" | ""; tab(many(&digits))
        tc_table[k] := Decode(str || tab(find(":")))
        }
        else if k := 1(move(2), ="#")
        then tc_table[k] := integer(tab(find(":")))
        else if k := 1(tab(find(":")), pos(-1))
        then tc_table[k] := true()
        else er("maketc_table", "your termcap file has a bad entry",3)
    }
    }

    return tc_table

end



procedure getval(id)

    /tc_table := maketc_table(getentry(getname())) |
    er("getval","can't make a table for your terminal",4)

    return \tc_table[id] | fail
    # er("getval","the current terminal doesn't support "||id,7)

end



procedure Decode(s)

    # Does things like turn ^ plus a letter into a genuine control
    # character.

    new_s := ""

    s ? {

    while new_s ||:= tab(upto('\\^')) do {
        chr := move(1)
        if chr == "\\" then {
        new_s ||:= {
            case chr2 := move(1) of {
            "\\" : "\\"
            "^"  : "^"
            "E"  : "\e"
            "b"  : "\b"
            "f"  : "\f"
            "n"  : "\n"
            "r"  : "\r"
            "t"  : "\t"
            default : {
                if any(&digits,chr2) then {
                char(integer("8r"||chr2||move(2 to 0 by -1))) |
                    er("Decode","bad termcap entry",3)
                }
               else chr2
            }
            }
        }
        }
        else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
    }
    new_s ||:= tab(0)
    }

    return new_s

end



procedure igoto(cm,col,line)

    local colline, range, increment, padding, str, outstr, chr, x, y

    if col > (tc_table["co"]) | line > (tc_table["li"]) then {
    colline := string(\col) || "," || string(\line) | string(\col|line)
    range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
    er("igoto",colline || " out of range " || (\range|""),9)
    }

    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
    increment := -1
    outstr := ""

    cm ? {
    while outstr ||:= tab(find("%")) do {
        tab(match("%"))
        if padding := integer(tab(any('23')))
        then chr := (="d" | "d")
        else chr := move(1)
        if case \chr of {
        "." :  outstr ||:= char(line + increment)
        "+" :  outstr ||:= char(line + ord(move(1)) + increment)
        "d" :  {
            str := string(line + increment)
            outstr ||:= right(str, \padding, "0") | str
        }
        }
        then line :=: col
        else {
        case chr of {
            "n" :  line := ixor(line,96) & col := ixor(col,96)
            "i" :  increment := 0
            "r" :  line :=: col
            "%" :  outstr ||:= "%"
            "B" :  line := ior(ishift(line / 10, 4), line % 10)
            ">" :  {
            x := move(1); y := move(1)
            line > ord(x) & line +:= ord(y)
            &null
            }
        } | er("goto","bad termcap entry",5)
        }
    }
    return outstr || tab(0)
    }

end



procedure iputs(cp, affcnt)

    # Writes cp to the screen.  Use this instead of writes() for
    # compatibility with itlib (a UNIX-only version which can handle
    # albeit inelegantly) terminals that need padding.

    static num_chars
    initial num_chars := &digits ++ '.'

    type(cp) == "string" |
    er("iputs","you can't iputs() a non-string value!",10)

    cp ? {
    if tab(many(num_chars)) & ="*" then
        stop("iputs:  iolib can't use terminals that require padding.")
    writes(tab(0))
    }

    return

end
SHAR_EOF
if test 17272 -ne "`wc -c < 'iolib.icn'`"
then
    echo shar: error transmitting "'iolib.icn'" '(should have been 17272 characters)'
fi
fi # end of overwriting check
#    End of shell archive
exit 0
--
PAPER:  Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET:  [e-mail]
UUCP:   ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE:  [phone]            BITNET: [e-mail]

From [e-mail]  Mon Apr 22 01:53:37 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 22 Apr 91 01:53:37 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA26295; Mon, 22 Apr 91 01:53:34 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 22 Apr
 1991 01:53 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA11154; Mon, 22 Apr 91
 01:50:41 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 22 Apr 1991 01:53 MST
Date: 22 Apr 91 06:53:31 GMT
From: agate!stanford.edu!unixhub!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: UNIX diffs, klondike
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago


These are a some fairly minor patches which I applied to klondike
in order to get it to run on my local system here.  Since the vast,
vast majority of UNIX systems out there don't use the PC character
set, I've changed the defaults around so that klondike doesn't as-
sume a PC character set if \isPC and \isDOS are not defined.  I did
a few other things here and there to get klondike to run on a vt100
terminal at my home using my (poor) system termcap file.  Really,
though, I didn't do much.

I don't believe I've ever seen such a nice piece of software posted
on this newsgroup.  (N.A., why not cross-post to comp.sources.games
when we've all had our fun with it?)  What's especially interesting
about klondike is that the author - who used to claim novice-hood at
Icon - clearly has come into full mastery of his medium, and has
gone to great lengths to write clean and readable code.  It'll be a
pleasure to stick this in my source tree!

-Richard


P.S. Unix users:  Apply these using patch -p < patchfilename.

----------------------- diffs for klondike -------------------------

*** kloncon.icn~    Sun Apr 21 22:30:15 1991
--- kloncon.icn    Mon Apr 22 01:27:44 1991
***************
*** 32,48 ****
  # For DOS, we simply look to see if any keystroke is waiting, discarding
  # it/them.  Your system may be different.
  procedure userInterrupt ()
! static keyWaiting
! initial    {
!     keyWaiting  :=  if \type(kbhit)  then  "kbhit"
! }
      if \isDOS  then
!         while keyWaiting()  do  {
              (getch() == "\0")  &  getch()    #eat interrupting keystroke
              return                            #success means "interrupt requested"
          }
      else
!         (\keyWaiting)  &  keyWaiting()  &  getch()  &  return
      fail                                    #failure = "interrupt NOT requested"
  end                                            #userInterrupt

--- 32,45 ----
  # For DOS, we simply look to see if any keystroke is waiting, discarding
  # it/them.  Your system may be different.
  procedure userInterrupt ()
!
      if \isDOS  then
!         while kbhit()  do  {
              (getch() == "\0")  &  getch()    #eat interrupting keystroke
              return                            #success means "interrupt requested"
          }
      else
!         (\kbhit)()  &  getch()  &  return
      fail                                    #failure = "interrupt NOT requested"
  end                                            #userInterrupt

***************
*** 58,69 ****
  static outstr
  local s
  initial    {
!     outstr := table("Oops!")
      outstr[VclearAll]    := getval("cl")     |  (getval("ho") || getval("cd"))
      outstr[VclearEOL]    := getval("ce")
!     outstr[Vnormal]        := getval("me") || getval("ue")
      outstr[Vbold]        := getval("md" | "us")
!     outstr[Vblink]        := getval("mb")
      outstr[Vreverse]    := getval("mr" | "so")
      outstr[VbackSpace]    := if getval("bs")  then  "\b"  else  getval("le")
      if \isQuiet  then
--- 55,66 ----
  static outstr
  local s
  initial    {
!     outstr := table(getval("me" | "se") || getval("ue"))
      outstr[VclearAll]    := getval("cl")     |  (getval("ho") || getval("cd"))
      outstr[VclearEOL]    := getval("ce")
!     outstr[Vnormal]        := getval("me" | "se") || (getval("ue") | "")
      outstr[Vbold]        := getval("md" | "us")
!     outstr[Vblink]        := getval("mb" | "us" | "md")
      outstr[Vreverse]    := getval("mr" | "so")
      outstr[VbackSpace]    := if getval("bs")  then  "\b"  else  getval("le")
      if \isQuiet  then
***************
*** 107,118 ****
  local Vred, Vblack                            #suit color strings

      lineCount := 25                            #assume the best
!     case  (map(termtype, &lcase, &ucase))  of  {
          "PC"    :    { getANSItype ();            isANSI := 1        }
          "MONO"    :    { isMonochrome := 1;        isANSI := 1     }
          "COLOR"    :    { isMonochrome := &null;    isANSI := 1        }
          default    :    { isMonochrome := 1;        isANSI := &null
!                         (0 < *termtype)  &  setname (termtype)
                          lineCount := getval("li")
          }
      }
--- 104,116 ----
  local Vred, Vblack                            #suit color strings

      lineCount := 25                            #assume the best
!     termtype := (map(\termtype, &lcase, &ucase))
!     case  termtype  of  {
          "PC"    :    { getANSItype ();            isANSI := 1        }
          "MONO"    :    { isMonochrome := 1;        isANSI := 1     }
          "COLOR"    :    { isMonochrome := &null;    isANSI := 1        }
          default    :    { isMonochrome := 1;        isANSI := &null
!                         setname (map("" ~== \termtype))
                          lineCount := getval("li")
          }
      }
***************
*** 202,218 ****
  #    t e r m i n a t e S c r e e n
  # Put the screen in the correct state prior to program termination.
  procedure terminateScreen ()
- static resetCooked
- initial    {
-     resetCooked  :=  if \type(reset_tty)  then  "reset_tty"
- }
      if /invisible  then
!         if \isANSI  then
              write ("\e[=7h", VclearAll, Vnormal)    #set cursor wrap mode
!         else {
!             output (VclearAll, Vnormal, getval("te"))
!             (/isDOS)  &  (\resetCooked)  &  resetCooked ()
          }
      return
  end                                            #terminateScreen

--- 200,215 ----
  #    t e r m i n a t e S c r e e n
  # Put the screen in the correct state prior to program termination.
  procedure terminateScreen ()
      if /invisible  then
!         if \isANSI  then {
              write ("\e[=7h", VclearAll, Vnormal)    #set cursor wrap mode
!             (\reset_tty) ()
          }
+         else {
+             output (VclearAll, Vnormal)
+             iputs (getval("te"))
+             (\reset_tty) ()        # will be nonnull only if getchlib
+         }                        # is linked
      return
  end                                            #terminateScreen

*** klondike.icn~    Sun Apr 21 22:30:14 1991
--- klondike.icn    Mon Apr 22 00:42:25 1991
***************
*** 44,50 ****
      helpInfo := [
          ["A", "Automatic", " mode -- finish out this game on automatic pilot"],
          ["B", "Boss", " key for when you-know-who visits"],
!         ["C","Continuous"," mode -- play games continuously until interrupted"],
          ["F", "Find", " (next) useful move to do"],
          ["H,?", "Help", ", this help screen"],
          ["M", "Move", " card (or stack) from Deck/Stack to Stack/Ace pile"],
--- 44,50 ----
      helpInfo := [
          ["A", "Automatic", " mode -- finish out this game on automatic pilot"],
          ["B", "Boss", " key for when you-know-who visits"],
!         ["C","Continuous"," mode -- play until interrupted (not UNIX)"],
          ["F", "Find", " (next) useful move to do"],
          ["H,?", "Help", ", this help screen"],
          ["M", "Move", " card (or stack) from Deck/Stack to Stack/Ace pile"],
***************
*** 365,371 ****
  procedure uboss ()
      writes ("oss")                # "consistency is the hobgoblin of small minds"
      terminateScreen ()                        #put screen in the correct state
-     writes ("C>")                            #look innocent
      saveState ("klondike.sav")
      exit ()
  end                                            #uboss
--- 365,370 ----
***************
*** 457,464 ****
  # Results are reported after every interval (0 => only at end) games.
  # Statistics are output when done or interrupted, whichever comes first.
  procedure ubatch (gamesToPlay, interval)
! local veryFirstSeed, stat
!     isQuiet := invisible := 1
      veryFirstSeed := &random                #remember the initial random seed
      (interval = 0)  &  (interval := gamesToPlay)
      repeat  {
--- 456,463 ----
  # Results are reported after every interval (0 => only at end) games.
  # Statistics are output when done or interrupted, whichever comes first.
  procedure ubatch (gamesToPlay, interval)
!     local veryFirstSeed, stat
!     isQuiet := invisible := 1
      veryFirstSeed := &random                #remember the initial random seed
      (interval = 0)  &  (interval := gamesToPlay)
      repeat  {
***************
*** 472,479 ****
          (stat[1] ~= interval)  &  break        #interrupted by user
          (0 = (gamesToPlay -:= interval))  &  break
      }
!     firstSeed := veryFirstSeed                #required for writeStatistics()
!     writeStatistics ()
      exit ()
  end                                            #ubatch

--- 471,479 ----
          (stat[1] ~= interval)  &  break        #interrupted by user
          (0 = (gamesToPlay -:= interval))  &  break
      }
!     firstSeed := veryFirstSeed                #required for writeStatistics()
!     (\reset_tty)()
!     writeStatistics ()
      exit ()
  end                                            #ubatch

***************
*** 483,490 ****
  local s, prevsCmd, batchMode, reportInterval, again, termtype

      # initialize
!     isDOS := find("MS-DOS", &host)            #probably a reasonable assumption
!     isPC  := isDOS                            #really a pretty poor assumption
      totalGames:=totalAces:=totalWins := 0    #statistics

      # set defaults
--- 483,491 ----
  local s, prevsCmd, batchMode, reportInterval, again, termtype

      # initialize
!     if isDOS := find("MS-DOS",
!                      &host|&features)        #probably a reasonable assumption
!     then isPC  := isDOS                        #really a pretty poor assumption
      totalGames:=totalAces:=totalWins := 0    #statistics

      # set defaults
***************
*** 497,503 ****
      reportInterval    := 0                    # report only at end of batch mode
      phraseFile        := &null                # use all built-in phrases
      isQuiet            := &null                # make clicks & beeps if possible
!     termtype        := if \isPC then "pc" else "mono"
      &random            := map (&clock, ":", "7")        # randomize the seed

      # deal with command-line parameters
--- 498,504 ----
      reportInterval    := 0                    # report only at end of batch mode
      phraseFile        := &null                # use all built-in phrases
      isQuiet            := &null                # make clicks & beeps if possible
!     termtype        := if \isPC then "pc"    # default term type for PCs
      &random            := map (&clock, ":", "7")        # randomize the seed

      # deal with command-line parameters
***************
*** 518,523 ****
--- 519,525 ----
              "-R" | "-r"    :    &random         :=    integer (s[3:0])
              "-S" | "-s"    :    findBest (s[3:0])            #check & store strategy
              "-T" | "-t"    :    termtype        :=    s[3:0]
+
              "-Z" | "-z"    :    debugging        :=    if \debugging then  &null else 1
              default        :    {
                              # screen mode not yet initialized, so write() is OK
***************
*** 529,535 ****
          }

      # initializations which use command-line parameters
!     (map(termtype, &lcase, &ucase) == "PC")  &  isPC := 1
      initConstants (termtype)                #need updated termtype from cmdline
      initVariables ()                        #establish all the lists and such

--- 531,537 ----
          }

      # initializations which use command-line parameters
!     (map(\termtype, &lcase, &ucase) == "PC")  &  isPC := 1
      initConstants (termtype)                #need updated termtype from cmdline
      initVariables ()                        #establish all the lists and such

***************
*** 566,572 ****
                              umove (s)  |  complain ()
                  "A"        :    uautomatic()                    #look Ma, no hands!
                  "B"        :    uboss()                            #bail out quick
!                 "C"        :    ucontinuous()                    #no hands, forever
                  "F"        :    ufind (again)  &  break            #new game
                  "M"        :    umove (&null)  |  complain ()
                  "Q"        :    uterminate ()  &  break            #new game
--- 568,574 ----
                              umove (s)  |  complain ()
                  "A"        :    uautomatic()                    #look Ma, no hands!
                  "B"        :    uboss()                            #bail out quick
!                 "C"        :    \isDOS & ucontinuous()                    #no hands, forever
                  "F"        :    ufind (again)  &  break            #new game
                  "M"        :    umove (&null)  |  complain ()
                  "Q"        :    uterminate ()  &  break            #new game
*** makefile.unx~    Sun Apr 21 22:30:12 1991
--- makefile.unx    Mon Apr 22 00:45:46 1991
***************
*** 1,18 ****
  #makefile.unx    910322    NHA
! #An unix makefile for klondike
  #
! #Assumes that iolib.u? and getchlib.u? are already available somewhere
! #along $IPATH.
! #Note that only getchlib is linked on the command line.  Everything else
! #is linked in the program.

! .SUFFIXES:    .u1  .icn

  .icn.u1:
      icont -c  $?

! klondike:    klondike.icn  kloncon.u1  klonstr.u1  klonsub.u1  getchlib.u1
!     icont -u -Si1000 -Sn2000  klondike  getchlib.u1

  clean:
      rm  -f  *.u?  klondike
--- 1,19 ----
  #makefile.unx    910322    NHA
! #Unix makefile for klondike
  #
! #Note that only getchlib and iolib are explicitly linked on the command
! #line; other auxiliary files are loaded by link directives withing klon-
! #dike.icn.

! .SUFFIXES: .u1  .icn

  .icn.u1:
      icont -c  $?

! SHELL = /bin/sh
!
! klondike: klondike.icn  kloncon.u1  klonstr.u1  klonsub.u1 getchlib.u1 iolib.u1
!     icont -u -Si1000 -Sn2000  klondike  getchlib.u1 iolib.u1

  clean:
      rm  -f  *.u?  klondike
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Mon Apr 22 17:24:51 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 22 Apr 91 17:24:51 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA29076; Mon, 22 Apr 91 17:24:48 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 22 Apr
 1991 17:24 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA05600; Mon, 22 Apr 91
 17:11:33 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 22 Apr 1991 17:24 MST
Date: 22 Apr 91 23:07:34 GMT
From: swrinde!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE: UNIX diffs, klondike
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

Just a note - an IMPORTANT one - to tack onto the preceding:  Please
read through the getchlib docs if you are on a system that does not
implement the -g option for stty.  Also if your stty command can't
write its output to a pipe (what a sorry world this is), check the
getchlib.icn file as well.  OTHERWISE YOUR TERMINAL ENDS UP IN RAW
MODE!

People with regular System V stty commands or older BSD ones (or some
newer BSD ones -it apparently works here on our Sun3) should have no-
thing to worry about.

I'm sorry I didn't mention this sooner.

-Richard
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From @um.cc.umich.edu:[e-mail]  Mon Apr 22 19:26:15 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 22 Apr 91 19:26:15 MST
Received: from umich.edu by optima.cs.arizona.edu (4.1/15)
    id AA02566; Mon, 22 Apr 91 19:26:13 MST
Received: from um.cc.umich.edu by umich.edu (5.61/1123-1.0)
    id AA17068; Mon, 22 Apr 91 22:26:09 -0400
Received: from MTS.cc.Wayne.edu by um.cc.umich.edu via MTS-Net; Mon, 22 Apr 91 22:21:45 EDT
Date: Mon, 22 Apr 91 22:21:50 EDT
From: [e-mail]
To: [e-mail]
Message-Id: <[e-mail]>
Subject: Evaluation rules for !set


I'm puzzled by the behavior of the following tiny program:

procedure main()
    x := set([1,2,3])
    every writes(e := !x, " ") do insert(x, e+10)
end

In MS-DOS Icon V8 it prints:

  1 2 3 11 12 21

The question is: what happens when you iterate over a set and modify
it at the same time?  I would have expected either just "1 2 3" (if the
value of x is saved) or an infinite sequence (if x is continually modified.)
I don't understand what accounts for the result I got.  Is there an
explanation of this somewhere in the (new) Icon book?

Paul Abrahams

From ralph  Mon Apr 22 19:31:43 1991
Date: Mon, 22 Apr 91 19:31:43 MST
From: "Ralph Griswold" <ralph>
Message-Id: <[e-mail]>
Received: by cheltenham.cs.arizona.edu; Mon, 22 Apr 91 19:31:43 MST
To: [e-mail], [e-mail]
Subject: Re:  Evaluation rules for !set

It's bad policy to iterate over a aggregate that has no defined
order while modifying that aggregate.  That's basically asking
for trouble.

We've taken some pains to make sure you don't get garbage or get
in a loop, but beyond that what you get is implementation dependent.

  Ralph Griswold / Dept of Computer Science / Univ of Arizona / Tucson, AZ 85721
  [phone]   [e-mail]  uunet!arizona!ralph

From [e-mail]  Thu Apr 25 04:18:45 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 25 Apr 91 04:18:45 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA21780; Thu, 25 Apr 91 04:18:42 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 25 Apr
 1991 04:18 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA05315; Thu, 25 Apr 91
 04:12:45 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 25 Apr 1991 04:18 MST
Date: 25 Apr 91 11:01:24 GMT
From: eru!hagbard!sunic!news.funet.fi!hydra!cc.helsinki.fi![e-mail]
Subject: Icon Version 8 fot Acorn Archimedes needed!
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Helsinki

ICON VERSION 8 FOR ACORN ACHIMEDES NEEDED

I have sources off poring library of Icon version 8 for hierarchical filing
systems. I have however considerable difficulty off adapting the language to
extensionless filing system names of British/Italian Acorn Archimedes. I have
conditionally compiled hierarchical name references of the icon source #include
statements, but language itself needs to refer to files and that part I have
not fixed (yet). If somebody has allready done the work, I don't want to tackle
the project myself. Also after seeing article about coroutines in latest
Archive magazine, I would like an icon with coroutines implemented. My
C-compiler is however is old Arthur version ( I think ver. 1.54, is there any
way to link programs to shared C library with it? ), so the routine is not
suitable for my own use. If you do have done the conversion, I hope you
send it to Newcastle ([e-mail])
and Oulu, Finland ( tolsun.oulu.fi, directory incoming/acorn) or
of course mail it to me.

Tony Veijalainen
[e-mail]

From gudeman  Mon Apr 29 12:16:59 1991
Received: from orator.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 29 Apr 91 12:16:59 MST
Date: Mon, 29 Apr 91 12:16:57 MST
From: "David Gudeman" <gudeman>
Message-Id: <[e-mail]>
Received: by orator.cs.arizona.edu; Mon, 29 Apr 91 12:16:57 MST
To: icon-group
Subject: augmented assignment

Someone in another newsgroup suggested that C should have the
augmented assignment "a ->= b" which means "a = a->b".  In Icon this
would translate to "a .:= b" which means "a := a.b".  It seems to me
that this could be useful in Icon even though it might be a little
hard to parse.  (It wouldn't be quite as useful as in C, where you
write code like "p = p->next" all the time.)

From [e-mail]  Mon Apr 29 12:41:44 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 29 Apr 91 12:41:44 MST
Received: from judy.cs.iastate.edu by optima.cs.arizona.edu (4.1/15)
    id AA22268; Mon, 29 Apr 91 12:41:34 MST
Received: from kickapoo.cs.iastate.edu.noname by judy.cs.iastate.edu (4.1) id AA15244; Mon, 29 Apr 91 14:40:09 CDT
Received: by kickapoo.cs.iastate.edu.noname (4.1/SMI-4.1)
    id AA07045; Mon, 29 Apr 91 14:40:43 CDT
Date: Mon, 29 Apr 91 14:40:43 CDT
From: [e-mail] (Kelvin Don Nilsen)
Message-Id: <[e-mail]>
To: [e-mail]
Cc: [e-mail]
In-Reply-To: "David Gudeman"'s message of Mon, 29 Apr 91 12:16:57 MST <[e-mail]>
Subject: augmented assignment


Here's a minor point to consider regarding the proposal of adding ".:="
  as another augmented assignment operator:

    If this operation were added to the language, it would represent
    a "special case" in that the right hand subexpression argument is
    really not an arbitrary expression, but must represent a record field
    name.

On the other hand, many users likely view its omission as a special case.
  I did, until I started to consider implementation concerns.


Kelvin Nilsen/Dept. of Computer Science/Iowa State University/Ames, IA  50011
 [phone]   [e-mail]  uunet!atanasoff!kelvin


From [e-mail]  Tue May 14 10:16:02 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 14 May 91 10:16:02 MST
Received: from netcom.netcom.com ([192.100.81.100]) by optima.cs.arizona.edu (4.1/15)
    id AA24070; Tue, 14 May 91 10:15:57 MST
Received: by netcom.netcom.com (/\==/\ Smail3.1.20.1 #20.6)
    id <[e-mail]>; Tue, 14 May 91 09:47 PDT
Message-Id: <[e-mail]>
Date: Tue, 14 May 91 10:15 PDT
From: [e-mail] (Phil Bewig)
X-Mailer: Mail User's Shell (7.2.0 10/31/90)
To: [e-mail]

Shown below is a superset of the c language printf family of functions
for icon.  I am new enough to icon that most of the procedures can
doubtless be rewritten; see float2str for a particularly bad example.


############################################################################
#
#       Name:   printf.icn
#
#       Title:  print formatted output
#
#       Author: Philip L. Bewig
#
#       Date:   May 13, 1991
#
############################################################################
#
#  The printf procedures provide general formatted output.  They share a
#  common syntax, differing only in the place where output is sent:
#
#      printf(fmt, expr, expr ...)      - send output to stdout
#      sprintf(fmt, expr, expr ...)     - return output as value of function
#      fprintf(fd, fmt, expr, expr ...) - send output to file fd
#
#  Essentially, the printf functions work by copying the format string to
#  the output.  Regular characters are copied unchanged.  Escape sequences
#  are converted to their corresponding string values; the same escape
#  sequences recognized by the icon language are recognized by printf.  The
#  only real processing performed is to interpret conversion specifications
#  which begin with the "%" character; each conversion specification trans-
#  forms the next expression in the procedure call to the desired form.
#
#  Conversion specifications have the form
#
#      %[-|=][w][.p]c
#
#  where
#
#      -   left justifies the field
#      =   centers the field
#      w   is the minimum field width
#      p   is the precision
#      c   is the conversion character
#
#  By default, the field is right justified in a field of width w, which
#  has a default value of zero; the "-" and "=" specifiers override the
#  default.  In a string, the precision is the maximum number of characters
#  to be printed; in a floating point number, the precision is the number
#  of digits to be printed to the right of the decimal point and has a
#  default value of six.  If "w" or "p" is "*" (star), the minimum field
#  width or precision will be the value of the next expr in the function
#  call.  For a numeric field, if "w" begins with zero the field will be
#  padded to the left with zeros instead of blank spaces; this implemen-
#  tation faithfully reproduces a bug in many printf functions which causes
#  sprintf("%05d", -2) to produce the string "000-2".
#
#  The conversion character c is one of the following:
#
#      a   positive integer, using letters as digits; the integers
#              1 through 256 are counted a, b, ..., z, aa, ab, ...
#              az, ba, bb, ..., iv (same as Lotus 1-2-3 columns)
#      A   same as a, but print upper-case letters
#      b   unsigned binary integer
#      c   single character of an integer value
#      d   decimal integer
#      e   floating point (scientific notation)
#      E   same as e, but print upper-case "E"
#      f   floating point
#      g   the shorter of e and f (suppresses non-significant zeros)
#      G   same as g, but print upper-case "E"
#      o   unsigned octal integer
#      r   integer in range 1 to 3999, converted to roman numerals
#      R   same as r, but print upper-case letters
#      s   string
#      S   string, with all letters converted to upper-case
#      u   unsigned decimal integer
#      w   integer with absolute value less than one billion, converted
#              to english words
#      W   same as x, but print letters as upper-case
#      x   unsigned hexadecimal integer
#      X   same as x, but print hex digit letters as upper-case
#      $   similar to f, but with a "$" prepended to the output;
#              negative numbers are parenthesized, and an extra
#              print position is allowed to the right of positive
#              numbers
#      %   literal percent sign; no expr is consumed
#
#  There may be any number of expressions following the format string;
#  extra expressions are ignored, but missing expressions cause a run-time
#  error.
#
#  This printf function is a strict superset of the features provided by
#  the standard c or awk printf function; any format specification which
#  they provide is provided identically here.
#
#  There are several local functions which provide a single type of con-
#  version which may be more useful than a general-purpose formatter in
#  some situations.  They are float2str(num, prec), float2sci(num, prec),
#  float2dollar(num, prec), int2alpha(num), int2roman(num), int2words(num),
#  unsigned2hex(num), unsigned2dec(num), unsigned2oct(num), and
#  unsigned2bin(num).  All of these functions return lower-case letters
#  where appropriate which may be converted to upper-case by the function
#  map(...,&lcase,&ucase).
#
############################################################################
#
#  test driver
#  procedure main()
#      repeat {
#          writes("enter a format specification (null to quit):  ")
#          fmt := read()
#          if *fmt = 0 then break
#          exprlist := []
#          repeat {
#              writes("enter an expression (null to print):  ")
#              temp := read()
#              if *temp = 0 then break
#              put(exprlist, temp)
#          }
#          write("the output is |" || sprintf(fmt, exprlist) || "|")
#          write()
#      }
#  end
#
############################################################################

# sprintf - return formatted string
procedure sprintf(fmt, exprlist)
    local out, just, wid, prec, conv, pad, val, v1, v2, i, s
    out := ""
    fmt ? repeat {
        (out ||:= tab(upto('%\\'))) | (out ||:= tab(0) & break)
        case move(1) of {
        "%": { # format specification
            # initialize
            just := right
            wid := prec := conv := pad := val := &null
            # parse the format specification
            tab(match("-")) & just := left
            tab(match("=")) & just := center
            wid := (tab(many(&digits)) | tab(match("*")))
            (\wid)[1] == "*" & wid := get(exprlist)
            tab(match(".")) & (prec := (tab(many(&digits)) | tab(match("*"))))
            (\prec)[1] == "*" & prec := get(exprlist)
            conv := move(1)
            # perform the specified conversion
            val := get(exprlist)
            case map(conv) of {
            "a": { if not(val := int2alpha(val)) then val := &null }
            "b": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2bin(val)) then val := &null }
            "c": { val := char(val) }
            "d": { (\wid)[1] == "0" & pad := "0"; val := integer(val) }
            "e": { (\wid)[1] == "0" & pad := "0"; val := float2sci(val, prec) }
            "f": { (\wid)[1] == "0" & pad := "0"; val := float2str(val, prec) }
            "g": { (\wid)[1] == "0" & pad := "0"
                    v1 := float2sci(val, prec)
                    v2 := float2str(val, prec)
                    val := (if *v1 < *v2 then v1 else v2) }
            "o": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2oct(val)) then val := &null }
            "r": { if not(val := int2roman(val)) then val := &null }
            "s": { if \prec then val := left(val, prec) }
            "u": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2dec(val)) then val := &null }
            "w": { if not(val := int2words(val)) then val := &null }
            "x": { (\wid)[1] == "0" & pad := "0"
                    if not(val := unsigned2hex(val)) then val := &null }
            "$": { (\wid)[1] == "0" & pad := "0"
                    val := float2dollar(val, prec) }
            "%": { push(exprlist, val); val := "%" }
            default: { out := &null; break }
            }
            if conv ~== map(conv) then val := map(val, &lcase, &ucase)
            if \wid & *val < wid then val := just(val, wid, pad)
            out ||:= val
        }
        "\\": { # escape sequence
            # escape handler derived from an ipl proc by William H. Mitchell
            out ||:= case c := map(move(1)) of {
            "b": "\b"
            "d": "\d"
            "e": "\e"
            "f": "\f"
            "l": "\l"
            "n": "\n"
            "r": "\r"
            "t": "\t"
            "v": "\v"
            "'": "'"
            "\"": "\""
            "x": {
                move(i := 2 | 1) ? s := tab(upto(~'0123456789ABCDEFabcdef') | 0)
                move(*s - i)
                char("16r" || s)
            }
            "^": char(iand(ord(move(1)), 16r1f))
            !"01234567": {
                move(-1)
                move(i := 3 | 2 | 1) ? s := tab(upto(~'01234567') | 0)
                move(*s - i)
                if s > 377 then {
                    s := s[1:3]
                    move(-1)
                }
                char("8r" || s)
            }
            default: c
            }
        }
        }
    }
    return out
end

# printf - print formatted string
procedure printf(fmt, exprlist)
    writes(sprintf(fmt, exprlist))
    return
end

# fprintf - write formatted string to file
procedure fprintf(fd, fmt, exprlist)
    writes(fd, sprintf(fmt, exprlist))
    return
end

# float2str - convert floating point number to string format
# this procedure looks more like pascal than icon
procedure float2str(num, ndigs)
    local out, nbefore, i, digit
    nbefore := 1; /ndigs := 6 # initialize, set default
    if num < 0 then { out := "-"; num *:= -1 } else { out := "" }
    num +:= 0.5 / 10.0 ^ ndigs # round to desired precision
    while num >= 10.0 do { num /:= 10.0; nbefore +:= 1 } # normalize
    every i := 1 to (nbefore + ndigs) do {
        if i = nbefore + 1 then out ||:= "."
        digit := integer(num)
        out ||:= char(digit + 48)
        num := 10.0 * (num - digit)
    }
    return out
end

# float2sci - convert floating point number to string in scientific format
procedure float2sci(num, ndigs)
    local frac, expo
    frac := num; expo := 0
    if abs(frac) >= 10.0 then {
        until abs(frac) < 10.0 do {
            frac /:= 10.0; expo +:= 1
        }
    } else if abs(frac) < 1.0 & frac ~= 0.0 then {
        until abs(frac) > 1.0 do {
            frac *:= 10.0; expo -:= 1
        }
    }
    return float2str(frac, ndigs) || "e" || string(expo)
end

# float2dollar - convert floating point number to string, prepend dollar sign
procedure float2dollar(num, prec)
    if num >= 0 then
        return "$" || float2str(num, prec) || " "
    else
        return "($" || float2str(-num, prec) || ")"
end

# unsigned2hex - convert unsigned int to hex string
procedure unsigned2hex(num)
    local out, nonzero, digit
    static hexdigit
    initial { hexdigit := "0123456789abcdef" }
    if num ~= integer(num) then fail
    if num > 2147483647 then fail
    if num < -2147483648 then fail
    out := ""; nonzero := &null
    every i := 28 to 0 by -4 do {
        digit := hexdigit[iand(ishift(num,-i),15)+1]
        if digit == "0" & /nonzero then next
        nonzero := ""; out ||:= digit
    }
    return out
end

# unsigned2oct - convert unsigned int to octal string
procedure unsigned2oct(num)
    local out, nonzero, digit
    if num ~= integer(num) then fail
    if num > 2147483647 then fail
    if num < -2147483648 then fail
    out := ""; nonzero := &null
    every i := 30 to 0 by -3 do {
        digit := string(iand(ishift(num,-i),7))
        if digit == "0" & /nonzero then next
        nonzero := ""; out ||:= digit
    }
    return out
end

# unsigned2bin - convert unsigned int to binary string
procedure unsigned2bin(num)
    local out, nonzero, digit
    if num ~= integer(num) then fail
    if num > 2147483647 then fail
    if num < -2147483648 then fail
    out := ""; nonzero := &null
    every i := 31 to 0 by -1 do {
        digit := string(iand(ishift(num,-i),1))
        if digit == "0" & /nonzero then next
        nonzero := ""; out ||:= digit
    }
    return out
end

# unsigned2dec - convert unsigned int to decimal string
procedure unsigned2dec(num)
    if num ~= integer(num) then fail
    else if num > 2147483647 then fail
    else if num < -2147483648 then fail
    else if num >= 0 then return string(num)
    else return string(4294967296 - -num)
end

# int2alpha - convert integer to alpha string
procedure int2alpha(num)
    local out
    static alpha
    initial alpha := string(&lcase)
    if num ~= integer(num) then fail
    if num <= 0 then fail
    num -:= 1
    out := alpha[num % 26 + 1]
    while (num := num / 26 - 1) >= 0 do
        out ||:= alpha[num % 26 + 1]
    return reverse(out)
end

# int2roman - convert integer to roman numerals
# this procedure derived from a program by Ralph E. Griswold
procedure int2roman(num)
    local arabic, result
    static equiv
    initial equiv := ["","i","ii","iii","iv","v","vi","vii","viii","ix"]
    integer(num) > 0 | fail
    result := ""
    every arabic := !num do
        result := map(result,"ivxlcdm","xlcdm**") || equiv[arabic+1]
    if find("*",result) then fail else return result
end

# int2words - convert integer to english words
procedure int2words(num)
    local out
    static tens, nums
    initial {
        nums := ["one", "two", "three", "four", "five", "six", "seven",
                "eight", "nine", "ten", "eleven", "twelve", "thirteen",
                "fourteen", "fifteen", "sixteen", "seventeen",
                "eighteen", "nineteen"]
        tens := ["ten", "twenty", "thirty", "forty", "fifty", "sixty",
                "seventy", "eighty", "ninety"]
    }
    if num ~= integer(num) then fail
    if num < 0 then
        return "negative " || int2words(-num)
    if num >= 1000000000 then {
        fail
    } else if num >= 1000000 then {
        out := int2words(num/1000000) || " million"
        if num%1000000 ~= 0 then out ||:= " " || int2words(num%1000000)
    } else if num >= 1000 then {
        out := int2words(num/1000) || " thousand"
        if num%1000 ~= 0 then out ||:= " " || int2words(num%1000)
    } else if num >= 100 then {
        out := int2words(num/100) || " hundred"
        if num%100 ~= 0 then out ||:= " " || int2words(num%100)
    } else if num >= 20 then {
        out := tens[integer(num/10)]
        if num%10 ~= 0 then out ||:= " " || int2words(num%10)
    } else if num > 0 then {
        out := nums[num]
    } else out := "zero"
    return out
end

From [e-mail]  Tue May 14 15:25:46 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 14 May 91 15:25:46 MST
Received: from netcom.netcom.com ([192.100.81.100]) by optima.cs.arizona.edu (4.1/15)
    id AA08666; Tue, 14 May 91 15:25:42 MST
Received: by netcom.netcom.com (/\==/\ Smail3.1.20.1 #20.6)
    id <[e-mail]>; Tue, 14 May 91 15:25 PDT
Message-Id: <[e-mail]>
Date: Tue, 14 May 91 15:25 PDT
From: [e-mail] (Phil Bewig)
X-Mailer: Mail User's Shell (7.2.0 10/31/90)
To: [e-mail]

Hello,

Here's another little procedure for formatted output.  Enjoy! !


############################################################################
#
#       Name:   prdate.icn
#
#       Title:  print formatted dates
#
#       Author: Philip L. Bewig
#
#       Date:   May 13, 1991
#
############################################################################
#
# The prdate family of procedures provide formatted date output.  They
# share a common syntax, differing only in the place where output is sent:
#
#     prdate(fmt, date)      - send output to stdout
#     sprdate(fmt, date)     - return output as value of function
#     fprdate(fd, fmt, date) - send output to file fd
#
# Essentially, the prdate functions work by copying the format string to
# the output.  Regular characters are copied unchanged.  Escape sequences
# are converted to their corresponding string values; the same escape
# sequences recognized by the icon language are recognized by prdate.  The
# only real processing performed is to interpret conversion specifications
# which begin with the "%" character.
#
# Conversion specifications have the form
#
#     %xx
#
# where xx may be any of the following:
#
#     m1 - month number in range 1 to 12
#     m2 - month number in range 01 to 12
#     m3 - month name in range Jan to Dec
#     M3 - month name in range JAN to DEC
#     m4 - month name in range January to December
#     M4 - month name in range JANUARY to DECEMBER
#
#     d1 - day number in range 1 to 31
#     d2 - day number in range 01 to 31
#
#     y1 - year number in range 0 to 99
#     y2 - year number in range 00 to 99
#     y3 - year number in range 0 to 9999
#     y4 - year number in range 0000 to 9999
#
#     n1 - day name in range Sun to Sat
#     N1 - day name in range SUN to SAT
#     n2 - day name in range Sunday to Saturday
#     N2 - day name in range SUNDAY to SATURDAY
#
# A percent sign may be input literally by "%%".
#
# The date may be specified in one of two formats.  An eight-digit number
# is assumed to be a date of the form "CCYYMMDD".  A smaller number is
# assumed to be a julian number representing a date, calculated using the
# jdate.icn code posted to icon-group by Cary Coutant.  Dates preceeding
# the christian era are not supported.
#
# For example, the function call sprdate("n2, m4 d1, y3", 17760704)
# returns the string "Thursday, July 4, 1776" and the function call
# sprdate("m2/d2/y4", 17760704) returns the string "07/04/1776".
#
############################################################################
#
# links:  julian.icn - Cary Coutant's julian date routines
#             (gregorian, julian, datestring, dayofweek,
#             tomdy, and floor procedures)
#
############################################################################
#
# test driver
# procedure main()
#     repeat {
#         writes("enter a format specification (null to quit):  ")
#         fmt := read()
#         if *fmt = 0 then break
#         writes("enter a date in CCYYMMDD or julian number form:  ")
#         expr := read()
#         write("the output is |" || sprdate(fmt, expr) || "|")
#         write()
#     }
# end
#
############################################################################

link julian

# sprdate - return formatted date string
procedure sprdate(fmt, expr)
    local out, i, s, g, m, d, y, dow, val
    static months
    initial {
        months := ["January", "February", "March", "April",
                   "May", "June", "July", "August", "September",
                   "October", "November", "December"]
    }

    if *expr >= 8 then {
        m := integer(expr[5:7])
        d := integer(expr[7:9])
        y := integer(expr[1:5])
        dow := dayofweek(gregorian(m,d,y))
    } else {
        mdy := tomdy(expr)
        m := mdy[1]; d := mdy[2]; y := mdy[3]
        dow := dayofweek(expr)
    }
    out := ""
    fmt ? repeat {
        (out ||:= tab(upto('%\\'))) | (out ||:= tab(0) & break)
        case move(1) of {
        "%": { # format specification
            if match('%') then {
                out ||:= "%"
                move(1)
            } else {
                conv := move(2)
                case conv of {
                "m1": { val := m }
                "m2": { val := right(m, 2, "0") }
                "m3": { val := left(months[m], 3) }
                "M3": { val := map(left(months[m], 3), &lcase, &ucase) }
                "m4": { val := months[m] }
                "M4": { val := map(months[m], &lcase, &ucase) }
                "d1": { val := d }
                "d2": { val := right(d, 2, "0") }
                "y1": { val := y % 100 }
                "y2": { val := right(y % 100, 2, "0") }
                "y3": { val := y }
                "y4": { val := right(y, 4, "0") }
                "n1": { val := left(dow, 3) }
                "N1": { val := map(left(dow, 3), &lcase, &ucase) }
                "n2": { val := dow }
                "N2": { val := map(dow, &lcase, &ucase) }
                default: { val := &null; break }
                }
                out ||:= val
            }
        }
        "\\": { # escape sequence
            # escape handler derived from an ipl proc by William H. Mitchell
            out ||:= case c := map(move(1)) of {
            "b": "\b"
            "d": "\d"
            "e": "\e"
            "f": "\f"
            "l": "\l"
            "n": "\n"
            "r": "\r"
            "t": "\t"
            "v": "\v"
            "'": "'"
            "\"": "\""
            "x": {
                move(i := 2 | 1) ? s := tab(upto(~'0123456789ABCDEFabcdef') | 0)
                move(*s - i)
                char("16r" || s)
            }
            "^": char(iand(ord(move(1)), 16r1f))
            !"01234567": {
                move(-1)
                move(i := 3 | 2 | 1) ? s := tab(upto(~'01234567') | 0)
                move(*s - i)
                if s > 377 then {
                    s := s[1:3]
                    move(-1)
                }
                char("8r" || s)
            }
            default: c
            }
        }
        }
    }
    return out
end

# prdate - write date to standard output
procedure prdate(fmt, expr)
    writes(sprdate(fmt, expr))
    return
end

# fprdate - write date to file
procedure fprdate(fd, fmt, expr)
    writes(fd, sprdate(fmt, expr))
    return
end

From [e-mail]  Tue May 14 16:03:38 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 14 May 91 16:03:38 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA10944; Tue, 14 May 91 16:03:36 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Tue, 14 May
 1991 16:03 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA19587; Tue, 14 May 91
 15:52:26 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Tue, 14 May 1991 16:03 MST
Date: 14 May 91 22:26:51 GMT
From: midway!ellis.uchicago.edu![e-mail] (Richard L. Goerwitz)
Subject: Algol->Icon & Pascal
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago

I've always wondered why Icon uses the brace notation (rather than
begin ... end;) for most groupings, but yet for procedures, a kind
of mixed procedure name(vars)...end notation is used.  I'm also a
bit curious why the notion of functions and procedures was collap-
sed into procedures, and yet with retention of the notion that a
procedure is a value (i.e. like what we normally associate with fun-
ctions).

Just curious.

--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From gudeman  Tue May 14 16:13:39 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 14 May 91 16:13:39 MST
Resent-From: "David Gudeman" <gudeman>
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA11319; Tue, 14 May 91 16:13:37 MST
Received: from optima.cs.arizona.edu by Arizona.edu with PMDF#10282; Tue, 14
 May 1991 16:13 MST
Received: from orator.cs.arizona.edu by optima.cs.arizona.edu (4.1/15) id
 AA11267; Tue, 14 May 91 16:13:01 MST
Received: by orator.cs.arizona.edu; Tue, 14 May 91 16:12:59 MST
Resent-Date: Tue, 14 May 1991 16:13 MST
Date: Tue, 14 May 91 16:12:59 MST
From: David Gudeman <[e-mail]>
Subject: Algol->Icon & Pascal
In-Reply-To: Richard L. Goerwitz's message of 14 May 91 22:26:51 GMT
 <[e-mail]>
Resent-To: [e-mail]
To: midway!ellis.uchicago.edu![e-mail]
Cc: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: midway!ellis.uchicago.edu![e-mail]
X-Vms-Cc: [e-mail]

>From: Richard L. Goerwitz

>...  I'm also a
>bit curious why the notion of functions and procedures was collap-
>sed into procedures, and yet with retention of the notion that a
>procedure is a value (i.e. like what we normally associate with fun-
>ctions).

I assume you are talking about the Pascal distinction that functions
are expression (things that return values) and procedures are
statements (things that change variables but don't return values).
But Icon doesn't have statements --only expressions-- so there is no
such distinction to make.

As to procedures being values, there is nothing unlikely about
procedures-as-values even for Pascal-style procedures.  It's just not
traditional for Pascal-like languages to have procedures or functions
as first-class values.

From [e-mail]  Thu May 16 01:06:48 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 16 May 91 01:06:48 MST
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA23169; Thu, 16 May 91 01:06:45 MST
Received: from UKACRL.BITNET (MAILER@UKACRL) by Arizona.edu with PMDF#10282;
 Thu, 16 May 1991 01:06 MST
Received: from RL.IB by UKACRL.BITNET (Mailer R2.07) with BSMTP id 2380; Thu,
 16 May 91 09:02:59 BST
Received: from RL.IB by UK.AC.RL.IB (Mailer R2.07) with BSMTP id 5317; Thu, 16
 May 91 09:00:21 BST
Date: 16 May 91  08:57:28 bst
From: [e-mail]
Subject: Language 'tutors'
To: [e-mail]
Message-Id: <16 May 91  08:57:28 bst  060957@EMAS-A>
X-Envelope-To: [e-mail]
Via:        UK.AC.ED.EMAS-A; 16 MAY 91  9:00:19 BST

Has anyone used Icon to develop 'tutors' for learning foreign languages
in any way - for example, vocabulary drills, simple phrase translation,
etc.?

If yes, are such programs available?

Thanks.

Roger Hare.

From [e-mail]  Thu May 16 04:25:57 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 16 May 91 04:25:57 MST
Received: from HYLKA.HELSINKI.FI by optima.cs.arizona.edu (4.1/15)
    id AA02858; Thu, 16 May 91 04:25:45 MST
Date: Thu, 16 May 1991 14:25 EET
From: [e-mail]
Subject: A word/line procedure
To: [e-mail]
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: IN%"[e-mail]"


Dear iconists,

I have a following, obviosly simple problem. I have made a nice
Icon procedure, which divides a text file one word/line. It is much easier,
simpler and faster than the one given in Icon book. It goes like this
(the original idea is, I believe, from some Unix-procedure, and it is the same
thing you would do with any editor or text processing program, if you had to
use them for the work):


    procedure main()
           while line:=read() do write(map(line," ","\l"))
    end


It works fine and fast, but it produces also empty lines which I cannot get rid
off in the same procedure, although I try to filter them out with something
like


    if *line > 0 then write(line)


But if I make the first procedure to write the stuff in a file and then process
that file with the procedure


    procedure main()
          while line:=read() do if *line > 0 then write(line)
    end



I get rid off the empty lines. It is easy to make a .bat or .com or whatever
from these two procedures, and the whole thing still works at least as fast or
even faster than the procedure in the Icon book. But
I would still like to know, how I actually could make it work in one shot. I
have tried different solutions, but they do not work. Can anybody
explain it?



Greetings,

Kimmo Kettunen
[e-mail]















From isidev![e-mail]  Thu May 16 07:53:49 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 16 May 91 07:53:49 MST
Received: from relay1.UU.NET by optima.cs.arizona.edu (4.1/15)
    id AA06729; Thu, 16 May 91 07:53:46 MST
Received: from isidev.UUCP (LOCALHOST.UU.NET) by relay1.UU.NET with SMTP
    (5.61/UUNET-internet-primary) id AA23636; Thu, 16 May 91 10:53:42 -0400
Date: Thu, 16 May 91 10:53:42 -0400
From: isidev![e-mail]
Message-Id: <[e-mail]>
To: uunet!cs.arizona.edu![e-mail]
Subject: Re: word/line procedure

 > From Kimmo Kettunen
 >
 > I have a following, obviosly simple problem. I have made a nice Icon
 > procedure, which divides a text file one word/line.  It is much easier,
 > ...
 >     procedure main()
 >            while line:=read() do write(map(line," ","\l"))
 >     end
 >
 > It works fine and fast, but it produces also empty lines which I cannot get
 > rid off in the same procedure, although I try to filter them out with
 > something like
 >
 >     if *line > 0 then write(line)

First you have to remember that in Icon you're working on strings, NOT
lines.  The result of the map() is not a series of lines but the same basic
string with spaces changed to newlines.  The length of the string hasn't
changed.  Testing the length of the string to discard empty lines won't do
any good at this point.

 > But if I make the first procedure to write the stuff in a file and then
 > process that file with the procedure
 >
 >     procedure main()
 >           while line:=read() do if *line > 0 then write(line)
 >     end

The reason testing the length works on the second pass is that now you're
reading in the original string in little pieces, one line at a time.  If
some of these pieces are empty lines they now exhibit zero length and can
be discarded.

 > ...
 > I would still like to know, how I actually could make it work in one shot.
 > I have tried different solutions, but they do not work. Can anybody
 > explain it?

I diddled your basic design, which is a neat idea by the way, and instead
of writing out the entire mapped string I write it out in pieces that are
delimited by the newlines that were mapped into the string.  This allows
the program to skip over consecutive bunches of newlines and thereby
discard the "blank lines" in one pass.  You'll have to test its speed.  It
may not be that fast now.

    procedure main()

        # convert input spaces to newlines and scan the result
        while line := map(read()," ","\l") do line ?  {

            # skip initial newlines
            tab(many('\l'))

            # write out substrings delimited by newlines
            while write(tab(upto('\l'))) do

                # skip newlines
                tab(many('\l'))

            # write out the last substring
            if not pos(0) then write(tab(0))
        }

    end

I'd assign the newline cset to a variable since it's used several places
now and maybe change the map to handle more "white space" characters than
just the space.  The tab comes to mind.  It's a good program idea.


  --- ---
   | S | Iconic Software, Inc.  -  Jerry Nowlin  -  uunet!isidev!nowlin
  --- ---


From [e-mail]  Thu May 16 08:34:24 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 16 May 91 08:34:24 MST
Received: from timbuk (timbuk.cray.com) by optima.cs.arizona.edu (4.1/15)
    id AA07941; Thu, 16 May 91 08:34:19 MST
Received: from cherry04.cray.com by timbuk (4.1/CRI-MX 1.6d)
    id AA17236; Thu, 16 May 91 10:34:07 CDT
Received: by cherry04.cray.com
    id AA23758; 4.1/CRI-5.6; Thu, 16 May 91 10:34:04 CDT
Date: Thu, 16 May 91 10:34:04 CDT
From: [e-mail] (David S. Cargo)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: input pushbacks

I'm writing a program that is simplified by having a mechanism for
"unreading" a line (or group of lines).  I'm looking a various
implementations for doing that.  Some use an input list that checked
for size before reading from a file.  Others use more elaborate
structures.

I'm curious about possible solutions the problem and whether other
people have found a need for such mechanisms themselves.
                         o       o
[e-mail]   \_____/
[phone]            /-o-o-\     _______
DDDD      SSSS   CCCC    /   ^   \   /\\\\\\\\
D   D    S      C        \ \___/ /  /\   ___  \
D   D     SSS   C         \_   _/  /\   /\\\\  \
D   D        S  C           \  \__/\   /\ @_/  /
DDDDavid SSSS.   CCCCargo    \____\____\______/

From [e-mail]  Thu May 16 12:27:50 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 16 May 91 12:27:50 MST
Received: from eos.arc.nasa.gov by optima.cs.arizona.edu (4.1/15)
    id AA16754; Thu, 16 May 91 12:27:48 MST
Received: Thu, 16 May 91 12:27:44 -0700 by eos.arc.nasa.gov (5.65/1.2)
Date: Thu, 16 May 91 12:27:44 -0700
From: Michael Shafto <[e-mail]>
Message-Id: <[e-mail]>
To: [e-mail], [e-mail]
Subject: Re:  input pushbacks
Cc: [e-mail]

Have you looked at the routine in Gimpel's
_Algorithms in SNOBOL4_, pp. 167ff.?

Mike

From [e-mail]  Thu May 16 13:43:26 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 16 May 91 13:43:26 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA20127; Thu, 16 May 91 13:43:23 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 16 May
 1991 13:42 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA27814; Thu, 16 May 91
 10:12:27 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 16 May 1991 13:43 MST
Date: 16 May 91 15:30:40 GMT
From: usc!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE: A word/line procedure
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

In article <[e-mail]> [e-mail] writes:
>
>I have a following, obviously simple problem. I have made a nice
>Icon procedure, which divides a text file one word/line....:
>
>    procedure main()
>           while line:=read() do write(map(line," ","\l"))
>    end
>
>It works fine and fast, but it produces also empty lines which I cannot get rid
>off in the same procedure, although I try to filter them out with something
>like
>
>    if *line > 0 then write(line)

I don't see how you can eliminate blank lines that are due to adjacent
spaces.  If all words are guaranteed to be separated by one space, and
no more, then naturally you could say

    ... do write("" ~== map(line, " ", "\l"))

This would eliminate lines with no words on them.  If, though, your files
distance words from each other using more than one blank space, you will
surely need to scan the lines by hand.  I don't know what was in the Icon
book, but I'd probably just use:

procedure main(a)

    separators := \a[1] | ',":<>,._+-=)(*&^%$#!@~`\'?/|\\][} {\t;'

    while read(&input) ? {
        tab(many(separators))
    if not pos(0) then {
            while write(tab(upto(separators))) do
            tab(many(separators))
        }
    pos(0) | write(tab(0))
    }

end

If you add in control characters to your separator list, and add a test
for length, you'll have something like the UNIX strings command.

Quiz time:

    Why must the line "pos(0) | write(tab(0))" stand after the if..then
    expression?

If you are stumped, here is a hint (don't peek):






    Notice how I called "if...then" an "expression."  That means it pro-
    duces a result.  What is that result?

If you are still stumped, here is the (or rather one) answer:





    The read(&input) ? { if...then; junk } expression always succeeds,
    because "junk" (i.e. "pos(0) | write(tab(0))") always succeeds.  If
    junk were not present, then we'd have read(&input) ? { if...then }.
    If the if-condition fails, the if...then expression fails.  More-
    over, if it succeeds, the then { expression } is evaluated.  Since
    "expression" is a while loop, it will eventually fail, causing the
    entire if...then expression to fail.  When it fails, the read(&input)
    ? { etc. } expression will fail, which will cause termination of the
    while construct it is part of, and ultimately termination of the
    program.  The upshot is that junk must be present, and must always
    succeed.

I probably should have tested the above program, but I have to run.  If
there are any errors, then I apologize (though I really don't see where
any could be [famous last words]).

--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Fri May 17 05:31:08 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 17 May 91 05:31:08 MST
Received: from pbinfo.uni-paderborn.de by optima.cs.arizona.edu (4.1/15)
    id AA23185; Fri, 17 May 91 05:30:35 MST
Received: from [131.234.128.175] by pbinfo.uni-paderborn.de with SMTP
    (5.65+/PB-3.85+yp+master) id AA03987; Fri, 17 May 91 14:32:00 +0200
Received: by alpha.uni-paderborn.de
    (5.61++/PB-3.41) id AA00712; Fri, 17 May 91 14:29:08 -0100
Date: Fri, 17 May 91 14:29:08 -0100
From: Fevzi Belli <[e-mail]>
Message-Id: <[e-mail]>
To: [e-mail]
Subject: Call for Papers IEA/AIE-92

We would like to inform you about our conference and would be
appreciated if you could also inform your colleagues about the
IEA/AIE-92. Please forward the Call for Papers to anyone who
is interested in the scope of the conference. Thank you very
much.

Bernhard Hoppe-Biermeyer
Univ. Paderborn
Arrangements & Publicity-Chair
phone: [phone]
fax  : [phone]/3238
email: [e-mail]

-----------------------------------------------------------------------
                 C A L L     F O R     P A P E R S
-----------------------------------------------------------------------

   THE FIFTH INTERNATIONAL CONFERENCE ON INDUSTRIAL AND ENGINEERING
APPLICATIONS OF ARTIFICIAL INTELLIGENCE AND EXPERT SYSTEMS (IEA/AIE-92)

June 9-12, 1992                    The University of Paderborn, Germany


Sponsored by:

Daimler-Benz AG
Dornier Deutsche Aerospace
Siemens Nixdorf Informationssysteme AG
The University of Tennessee Space Institute
Universitaet-Gesamthochschule Paderborn

In Cooperation with:

American Association for Artificial Intelligence
Association for Computing Machinery/SIGART
Canadian Society for Computational Studies of Intelligence
European Coordinating Committee for AI
Gesellschaft fuer Informatik e.V. (Germany)
IEEE Computer Society
International Society of Applied Intelligence
International Association of Knowledge Engineers
International Neural Network Society
Japanese Society of Artificial Intelligence

This conference continues its tradition of emphasizing applications of
artificial intelligence and expert/knowledge-based systems to engineering
and industrial problems. One of the specialities of the IEA/AIE-92 will
be the Industrial Program. Topics of interest include but are not
limited to:

Pattern Recognition                        Knowledge Representation
Neural Networks                            Knowledge Acquisition
Machine Learning                           Robotics
Model-Based & Qualitative Reasoning        Machine Vision
Computer Aided Manufacturing               Natural Language Processing
Computer Aided Design                      Reasoning Under Uncertainty
Expert & Diagnostic Systems                Distributed AI Architectures
Intelligent Databases                      Planning/Scheduling
Intelligent Interfaces                     Sensor Fusion
AI In Administration & Government          Intelligent Tutoring
Verifaction, Validation,                   Software Engineering & AI/ES
Dependability & AI/ES

Please indicate the area of submission as shwon above, and submit by
November 1, 1991 six copies of your paper (single spaced, minimum length
of 6 and maximum length of 10 pages) to the Program Chair. Authors will
be notified of the status of their manuscript by February 11, 1992. Final
copies of papers will be due for inclusion in the conference proceedings
by March 16, 1992.

Program Chair                            General Chair
Dr. Fevzi Belli                          Dr. Moonis Ali
Universitaet-GH Paderborn                Computer Science Department
Postfach 1621                            Univ. of Tennessee Space Inst.
4790 Paderborn                           Tullahoma, TN 37388
Germany                                  USA
Tel. [phone]                  Tel. [phone]
E-mail: [e-mail]       E-mail: [e-mail]
Fax: [phone]                  Fax: [phone]

General information and registration materials may be obtained from:

Alireza Azem                                   Ms. Sandy Shankle
Univ.-GH Paderborn, FB 14                      UTSI
4790 Paderborn                                 Tullahoma, TN 37388-8897
Germany                                        USA

The proceedings will be available at the conference. Proceedings of
earlier conferences are available -- contact: Ms. Nancy Wise at
([phone], ext. 236.

Program Co-Chairs:

Graham Forsyth, DSTO Aeronautical/Melbourne
Edward Grant, Univ. of Strathclyde
Franz-Josef Radermacher, FAW Ulm

Program Committee

Olaf Abeln, ASEA Brown-Bov./Mannheim
J. H. Andreae, Univ. of Canterbury
W. Bibel, TH Darmstadt
Gautam Biswas, Vanderbilt Univ./Nashville
Hinrich Bonin, Polytechnic Lueneburg
Ivan Bratko, Univ. of Ljubljana
Luigia Carlucci Aiello, Univ. di Roma
Thomas Christaller, GMD/St. Augustin
Paul Chung, University of Edingburgh
A. G. Cohn, University of Leeds
Alain Costes, LAAS-CNRS/Toulouse
Thore Danielsen, Norw. Telecom/Tromso
R. Freedman, Polytechnic Univ./New York
Toshio Fukuda, Nagoya University
Oliver Guenther, FAW Ulm
Uwe L. Haass, FORWISS/Erlangen
Georg Hartmann, Univ. Paderborn
K. M. van Hee, Eindhoven Univ. of Techn.
Alexander Herold/ECRC Munich
P. Jedrzejowicz, Merch. Mar. Acad./Gdynia
M. Klein, HEC GSM, Jouy-en-Josas
Jay Liebowitz, G. Washington Univ./Washington
Ramon Lopez de Mantaras, CSIC/Blanes
Bernard Moulin, Universite Laval/Quebec
Lee Naish, Univ. Melbourne
Bernd Neumann, LKI Hamburg
Setsuo Ohsuga, University of Tokyo
Dick Peacocke, BNR/Ottawa
Ivan Plander, ITCSAC/Bratislava
M. M. Richter, Univ. Kaiserslautern
Enrique Ruspini, SRI Internat./Menlo Park
Erik Sandewall, Linkoeping University
Jonathan Shapiro, The Turing Inst./Glasgow
Peter Sydenham, Univ. of South Australia
Ludger Thomas, Siemens Nixdorf/Paderborn
M. Trivedi, Univ. of Tennessee/Knoxville
Ian Witten, University of Calgary
T. Yamakawa, Kyushu Inst. of Technology

Ex-Officio
Jim Bezdek, Univ. of W. Florida/Pensacola
M. Matthews, Univ. of s. Carolina/Columbia

Proceedings Editors                 Tutorial Chair
F. Belli & Alfred Schmidt           Oliver Guenther, FAW Ulm
Univ. Paderborn

Arrangements & Publicity Chair      Industrial Program & Exhibits Chair
Bernhard Hoppe-Biermeyer            Stefan Omlor, Telenorma Frankfurt
Univ. Paderborn

Registration Chair                  Administration Chair
Sandy Shankle, UTSI Tullahoma       Alireza Azem, Univ. Paderborn
-----------------------------------------------------------------------

From [e-mail]  Sat May 18 07:10:11 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sat, 18 May 91 07:10:11 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA24544; Sat, 18 May 91 07:10:07 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sat, 18 May
 1991 07:09 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA26823; Sat, 18 May 91
 06:57:43 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sat, 18 May 1991 07:09 MST
Date: 17 May 91 18:36:46 GMT
From: agate!bionet!ucselx!usc!cs.utexas.edu!sdd.hp.com!spool.mu.edu!cs.umn.edu!msi.umn.edu!noc.MR.NET!ns!ns![e-mail] (Dean C.
 Gahlon)
Subject: RE: Language 'tutors'
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Network Systems Corporation
References: <16.May.91..08:57:28.bst..060957@EMAS-A>

In article <16.May.91..08:57:28.bst..060957@EMAS-A> [e-mail] writes:
>Has anyone used Icon to develop 'tutors' for learning foreign languages
>in any way - for example, vocabulary drills, simple phrase translation,
>etc.?
>
>If yes, are such programs available?
>
>Thanks.
>
>Roger Hare.

Yes, as a matter of fact. I have a couple of Japanese tutoring programs
written in Icon. They're not very fancy (and in fact don't use an incredible
number of the more advanced features of the language (i.e., I suspect that
they could be written to be better)), but they work.  If I remember, I will
try to upload them to this machine and then post them on the network
sometime soon.

                        Dean C. Gahlon
                        [e-mail]

From [e-mail]  Thu May 23 08:00:37 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 23 May 91 08:00:37 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA28264; Thu, 23 May 91 08:00:34 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 23 May
 1991 08:00 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA11969; Thu, 23 May 91
 07:54:41 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 23 May 1991 08:00 MST
Date: 23 May 91 00:31:56 GMT
From: mvb.saic.com!unogate!unocal!genisco!arcturus!felix![e-mail]
 (Kenneth Almquist)
Subject: RE: Algol->Icon & Pascal
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: FileNet Corp., Costa Mesa, CA
References: <[e-mail]>

[e-mail] (Richard L. Goerwitz) writes:
> I've always wondered why Icon uses the brace notation (rather than
> begin ... end;) for most groupings, but yet for procedures, a kind
> of mixed procedure name(vars)...end notation is used.

My guess is that this produces better diagnostics when braces are
omitted.  If you omit an open brace in C, the compiler will eventually
encounter a closing brace in the middle of the procedure which appears
to match the start of the procedure.  None of the C compilers that I
have seen are capable of recognizing this situation and determining
that the procedure hasn't actually ended.  Instead, they treat the
procedure as ended and squawk about every line from the closing brace
until the actual end of the procedure.  Using something other than a
closing brace to mark the end of a procedure avoids this problem.

> I'm also a bit curious why the notion of functions and procedures
> was collapsed into procedures, and yet with retention of the notion
> that a procedure is a value (i.e. like what we normally associate
> with functions).

I'm not sure what you mean by a procedure being a value.  Calling ICON
procedures "functions" would be a mistake because the term "function"
is defined by mathematicians to be something that returns exactly one
value.  In contrast, "procedure" is defined by usage within the compu-
ter science community.  In Algol and Pascal, a procedure can return
values by setting parameters, but not by returning a value using the
syntax for returning a value from a function.  In PL/1 (which is more
widely used than either Algol or Pascal) this restriction was lifted
and a procedure can return a value using a "return" statement.  So
ICON's use of the term "procedure" to refer to something that can
return zero or more values is a natural extension of prior practice.
                Kenneth Almquist

From [e-mail]  Thu May 23 23:16:13 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 23 May 91 23:16:13 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA08193; Thu, 23 May 91 23:16:10 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 23 May
 1991 23:15 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA09418; Thu, 23 May 91
 23:08:59 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 23 May 1991 23:15 MST
Date: 24 May 91 05:12:31 GMT
From: mips!news.cs.indiana.edu!ux1.cso.uiuc.edu!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: icont .el files
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago

I recall seeing something like a describe-icon-function.el file
some months ago.  I guess I'm wondering just what has been done
in the way of Emacs utility files for Icon programmers (aside from
the icon.el file that comes with the standard distribution).  If
anyone could point me in the right direction (or send some code),
I'd appreciate it very much.

Naturally, I'll summarize if there's interest.

--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From uunet!men2a!aquin!luvthang!talmage  Fri May 24 12:18:29 1991
Received: from univers.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 24 May 91 12:18:29 MST
Received: from uunet.UUCP by univers.cs.arizona.edu; Fri, 24 May 91 12:18:27 MST
Received: from men2a.UUCP (localhost.UU.NET) by relay1.UU.NET with SMTP
    (5.61/UUNET-internet-primary) id AA14737; Fri, 24 May 91 15:03:36 -0400
Received: by men2a.ori-cal.com (smail2.5)
    id AA10279; 24 May 91 15:08:22 EDT (Fri)
Received: by aquin.ORI-CAL.COM (smail2.5)
    id AA07256; 24 May 91 14:56:30 EDT (Fri)
Received: by luvthang.UUCP (1.05D/Amiga)
    id AA02127; Fri, 24 May 91 13:25:29 EST
Date: Fri, 24 May 91 13:25:29 EST
Message-Id: <[e-mail]>
From: uunet!luvthang!talmage (David W. Talmage)
To: uunet!icon-group
Subject: Icon debugging tools? -REPOST-

On or about 4 May, I asked about Icon tools.  I've had major mailer
problems since then, so I have no idea if my note made it out to the
icon-group or if anyone replied to it.  Because I'm still
interested, I post again:

>What tools do you use to debug your Icon programs?  I have a poor
>man's profiler which I use on occasion.  What I'd really like is a
>symbolic debugger that works like Sun's dbxtool or like Digital's
>run-time debugger.  It would be a win for me if said tools can run on
>my Amiga.

In my original posting, I included an Icon implementation of pmp, Dan
Berenstein's Poor Man's Profiler.  If anyone wants it, please drop me
a line.  If more than 10 people ask for it, I'll post it.

-----------------------------------------------------------------------------
David W. Talmage ([e-mail])
"I need fifty dollars to make you hollar.  I get paid to run this luvthang."

From [e-mail]  Sat May 25 03:32:43 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sat, 25 May 91 03:32:43 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA08320; Sat, 25 May 91 03:32:39 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sat, 25 May
 1991 03:32 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA21070; Sat, 25 May 91
 03:14:33 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sat, 25 May 1991 03:32 MST
Date: 25 May 91 09:57:43 GMT
From: munnari.oz.au!deakin.OZ.AU!rand![e-mail] (Rodney Brown)
Subject: MS-DOS ICON binaries
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: Co-Cam Computer Group, Melbourne, OZ

I have a MS-DOS Icon binary dating from 1985 distributed through PC-Blue.
Is there a more recent version available? 8086 or 80386 extended mode binaries?
I checked SIMTEL a while back & every mention of ICON seemed to be aimed
at MS Windows & GUIs.

Rodney Brown, Co-Cam Computer Group,    ACSNet: [e-mail]

From [e-mail]  Sat May 25 23:23:29 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sat, 25 May 91 23:23:29 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA09375; Sat, 25 May 91 23:23:27 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Sat, 25 May
 1991 23:22 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA17485; Sat, 25 May 91
 23:18:38 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Sat, 25 May 1991 23:23 MST
Date: 26 May 91 06:10:00 GMT
From: [e-mail] (Andrei V. Zaitsev)
Subject: Comments in ICON
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: U of Arizona CS Dept, Tucson

Here is an extremely simple question : how
to put a comment into a ICON program ?
(I tried /**/,(**),REM and * , none of them works).

From isidev![e-mail]  Sun May 26 10:55:10 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 26 May 91 10:55:10 MST
Received: from relay1.UU.NET by optima.cs.arizona.edu (4.1/15)
    id AA25285; Sun, 26 May 91 10:55:08 MST
Received: from isidev.UUCP (LOCALHOST.UU.NET) by relay1.UU.NET with SMTP
    (5.61/UUNET-internet-primary) id AA07484; Sun, 26 May 91 13:55:06 -0400
Date: Sun, 26 May 91 13:55:06 -0400
From: isidev![e-mail]
Message-Id: <[e-mail]>
To: uunet!cs.arizona.edu![e-mail]
Subject: Re: icon comments

 > Date: 26 May 91 06:10:00 GMT
 > From: uunet!arizona!arizona.edu!andrew (Andrei V. Zaitsev)
 >
 > Here is an extremely simple question : how
 > to put a comment into a ICON program ?
 > (I tried /**/,(**),REM and * , none of them works).

You must be young since you still have stars in your eyes.  Think pound
signs instead.  Examples follow:

    procedure main()
        write(&clock)    # print the current time

        write(&date)    # print the current date

        # print more information on the time and date
        write(&dateline)
    end

At least you're thinking about comments!

  --- ---
   | S | Iconic Software, Inc.  -  Jerry Nowlin  -  uunet!isidev!nowlin
  --- ---


From [e-mail]  Tue May 28 06:42:52 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 28 May 91 06:42:52 MST
Received: from MIS1.MIS.MCW.EDU by optima.cs.arizona.edu (4.1/15)
    id AA02919; Tue, 28 May 91 06:42:46 MST
Received: from mis.mcw.edu (MCWMI3) by MIS1.MIS.MCW.EDU with PMDF#10477; Tue,
 28 May 1991 08:42 CST
Date: Tue, 28 May 1991 08:42 CST
From: Chris Tenaglia - 257-8765 <[e-mail]>
Subject: Holiday TidBit
To: [e-mail]
Message-Id: <[e-mail]>
X-Organization: Medical College of Wisconsin MIS Department (Milwaukee, WI)
X-Vms-To: IN%"[e-mail]"


Another holiday has passed, and with it came another icon game. This is
Yahtzee, the poker dice game. I use ICON 8 under VMS 5.4-1, but I tried
to avoid system specific stuff. I'll probably get flamed again for my
screen management methods (I tried a little something different.) It's
written for VT100,2XX,3XX,4XX and compatible terminals, since that's all
I have at this site. Bye the way, this version allows for multiple players.
I've played it several times with my daughter and it seems pretty solid.

Game design involves many tricky decisions. The two in this implementation
were..
          o Not to repaint dice if the value stayed the same
            This is seen in procedure depict(). I use a list
            'od' to remember former values. Then when choosen
            dice are shaken, the unshaken ones stay put. But,
            so do the ones that come up the same. Oh well.
          o To give the player the feel of the three shakes,
            I provide a prompt saying whose turn it is, and
            asking them to press <RETURN>. These lines can be
            found at the beginning of procedure play(name).
            I also ask them to press return after their turn
            is over in order to allow some time to read their
            scorecard and think about future strategy.

So here's the code. Enjoy!

Chris Tenaglia (System Manager) | Medical College of Wisconsin
8701 W. Watertown Plank Rd.     | Milwaukee, WI 53226
[phone]                   | [e-mail], mcwmis!tenaglia

#
# YAHT.ICN          5/27/91          BY TENAGLIA
#
# YAHTZEE GAME
#
global players,slot,team,d,od,dice,round
procedure main(param)
  paint()
  assign_players()
  every round := 1 to 13 do
    every play(!team)
  summarize()
  end

#
# DISPLAYS THE HEADER AND SEPARATOR LINE AT BEGINNING OF GAME
#
procedure paint()
  write(cls(),high(uhalf("             Y A H T Z E E              ")))
  write(high(lhalf("             Y A H T Z E E              ")))
  write(at(1,10),graf(repl("q",75)))
  end

#
# DISPLAYS THE FINAL SCORE OF ALL THE PLAYERS
#
procedure summarize()
  write(at(1,11),blink(high(inverse(chop("Final Score Summary")))))
  every player := key(players) do
    {
    card := players[player]
    top  := 0 ; every i := 1 to 6 do top +:= card[i]
    if top > 62 then top +:= 35
    bottom := 0 ; every i := 7 to 13 do bottom +:= card[i]
    write("Player ",high(left(player,14))," Top = ",right(top,5),
                                       " Bottom = ",right(bottom,5),
                                       "  Total = ",right(top+bottom,5))
    }
  input("<press return>")
  end

#
# SETUP AND INITIALIZATION OF YAHTZEE ENVIRONMENT
#
procedure assign_players()
  n := 1 ; team := [] ; slot := [] ; d := list(6,"") ; od := list(5,0)
  &random := map(&clock,":","9")
  players := table("n/a")
  repeat
    {
    (player := input(("Name of player #" || n || ":"))) | stop("Game called off.")
    if player == "" then break
    n +:= 1
    put(team,player)
    players[player] := list(13,"*")
    }
  if n = 1 then stop("Nobody wants to play!")

  put(slot,"Ones")   ; put(slot,"Twos")  ; put(slot,"Threes")
  put(slot,"Fours")  ; put(slot,"Fives") ; put(slot,"Sixes")
  put(slot,"3oK")    ; put(slot,"4oK")   ; put(slot,"FullH")
  put(slot,"SmStr")  ; put(slot,"LgStr") ; put(slot,"Yahtzee")
  put(slot,"Chance")

  d[1] := "lqqqqqkx     xx  `  xx     xmqqqqqj"
  d[2] := "lqqqqqkx     xx ` ` xx     xmqqqqqj"
  d[3] := "lqqqqqkx`    xx  `  xx    `xmqqqqqj"
  d[4] := "lqqqqqkx`   `xx     xx`   `xmqqqqqj"
  d[5] := "lqqqqqkx`   `xx  `  xx`   `xmqqqqqj"
  d[6] := "lqqqqqkx` ` `xx     xx` ` `xmqqqqqj"
  end

#
# THIS ROUTINE LETS A PLAYER TAKE THEIR TURN
#
procedure play(name)
  writes(at(1,11),"It's ",high(name),"'s turn",chop())
  writes(at(1,12),high(name)) ; input(", Please press <RETURN> to begin.")
  score(name)
  dice := [] ; every 1 to 5 do put(dice,?6)
  depict()
  shake := obtain("Shake which ones :")
  (shake === []) | (every dice[!shake] := ?6)
  depict()
  shake := obtain("(Last Chance) Shake which ones :")
  (shake === []) | (every dice[!shake] := ?6)
  depict()
  repeat
    {
    select := input(at(1,22) || clip("Tally to which category (1 -> 13) :"))
    numeric(select)                | next
    (1 <= select <= 13)            | next
    (players[name][select] == "*") | next
    break
    }
  tally(name,select)
  score(name)
  input(at(1,22) || clip("Press <RETURN>"))
  end

#
# THIS ROUTINE DRAWS THE DICE
#
procedure depict()
  every i := 1 to 5 do
    {
    if od[i] = dice[i] then next
    x := 1
    writes(at(i*10+4,3),inverse(i))
#    writes(at(i*10+4,9),inverse(dice[i]))
    every j := 4 to 8 do
      {
      writes(at(i*10,j),graf(d[dice[i]][x:x+7]))
      x +:= 7
      }
    od[i] := dice[i]
    }
  end

#
# THIS ROUTINE LETS THE PLAYER DECIDE WHAT TO APPLY THE SHAKES TO
#
procedure tally(name,area)
  case integer(area) of
    {
    1 : {                        # ones
        sum := 0 ; every unit := !dice do if unit = 1 then sum +:= 1
        players[name][1] := sum
        }
    2 : {                        # twos
        sum := 0 ; every unit := !dice do if unit = 2 then sum +:= 2
        players[name][2] := sum
        }
    3 : {                        # threes
        sum := 0 ; every unit := !dice do if unit = 3 then sum +:= 3
        players[name][3] := sum
        }
    4 : {                        # fours
        sum := 0 ; every unit := !dice do if unit = 4 then sum +:= 4
        players[name][4] := sum
        }
    5 : {                        # fives
        sum := 0 ; every unit := !dice do if unit = 5 then sum +:= 5
        players[name][5] := sum
        }
    6 : {                        # sixes
        sum := 0 ; every unit := !dice do if unit = 6 then sum +:= 6
        players[name][6] := sum
        }
    7 : {                        # 3 of a kind
        sum := 0 ; flag := 0
        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
        every piece := key(tmp) do
          if tmp[piece] >= 3 then flag := 1
        if flag = 1 then every sum +:= !dice
        players[name][7] := sum
        }
    8 : {                        # four of a kind
        sum := 0 ; flag := 0
        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
        every piece := key(tmp) do
          if tmp[piece] >= 4 then flag := 1
        if flag = 1 then every sum +:= !dice
        players[name][8] := sum
        }
    9 : {                        # full house
        sum := 0 ; flag := 0
        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
        every piece := key(tmp) do
          {
          if tmp[piece] = 3 then flag +:= 1
          if tmp[piece] = 2 then flag +:= 1
          }
        if flag = 2 then sum := 25
        players[name][9] := sum
        }
   10 : {                        # small straight
        sum  := 0 ; flag := 0
        hold := set() ; every insert(hold,!dice)
        tmp  := sort(hold)
        if tmp[1]+1 = tmp[2] &
           tmp[2]+1 = tmp[3] &
           tmp[3]+1 = tmp[4] then flag := 1
        if tmp[2]+1 = tmp[3] &
           tmp[3]+1 = tmp[4] &
           tmp[4]+1 = tmp[5] then flag := 1
        if flag = 1 then sum := 30
        players[name][10] := sum
        }
   11 : {                        # large straight
        sum := 0 ; flag := 0
        tmp := sort(dice)
        if tmp[1]+1 = tmp[2] &
           tmp[2]+1 = tmp[3] &
           tmp[3]+1 = tmp[4] &
           tmp[4]+1 = tmp[5] then flag := 1
        if flag = 1 then sum := 40
        players[name][11] := sum
        }
   12 : {                        # yahtzee
        sum := 0 ; flag := 0
        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
        every piece := key(tmp) do
          if tmp[piece] = 5 then flag := 1
        if flag = 1 then sum := 50
        players[name][12] := sum
        }
   13 : {                        # chance
        sum := 0 ; every sum +:= !dice
        players[name][13] := sum
        }
    }
  end

#
# THIS ROUTINE OBTAINS A VALID SHAKER REQUEST
#
procedure obtain(prompt)
  repeat
    {
    writes(at(1,22),prompt)
    (line := read()) | next
    if match("q",map(line)) then stop("Game Quit")
    if trim(line) == "" then return []
    units := parse(line,', \t')
    every unit := !units do
      (1 <= unit <= 5) | next
    break
    }
  return units
  end

#
# THIS ROUTINE PAINTS THE SCORECARD FOR A GIVEN PLAYER
#
procedure score(name)
  writes(at(1,11),chop(),at(25,11),under(),"Player = ",name,"     Round = ",under(round))
  writes(at(10,12)," 1 : Ones    = ",players[name][1])
  writes(at(10,13)," 2 : Twos    = ",players[name][2])
  writes(at(10,14)," 3 : Threes  = ",players[name][3])
  writes(at(10,15)," 4 : Fours   = ",players[name][4])
  writes(at(10,16)," 5 : Fives   = ",players[name][5])
  writes(at(10,17)," 6 : Sixes   = ",players[name][6])
  writes(at(40,12)," 7 : 3oK     = ",players[name][7])
  writes(at(40,13)," 8 : 4oK     = ",players[name][8])
  writes(at(40,14)," 9 : FullH   = ",players[name][9])
  writes(at(40,15),"10 : SmStr   = ",players[name][10])
  writes(at(40,16),"11 : LgStr   = ",players[name][11])
  writes(at(40,17),"12 : Yahtzee = ",players[name][12])
  writes(at(40,18),"13 : Chance  = ",players[name][13])
  st1 := 0 ; every i := 1 to 6 do st1 +:= numeric(players[name][i])
  if st1 > 62 then bonus := 35 else bonus := 0
  st2 := 0 ; every i := 7 to 13 do st2 +:= numeric(players[name][i])
  writes(at(10,19),"Bonus = ",clip(bonus))
  writes(at(10,20),"Subtotal = ",st1+bonus)
  writes(at(40,20),"Subtotal = ",st2)
  writes(at(37,21),"Grand Total = ",st1+st2+bonus)
  end

#
# VIDEO ROUTINE CLEARS SCREEN
#
procedure cls(str)
  /str := ""
  return "\e[2J\e[H" || str
  end

#
# VIDEO ROUTINE ERASES REST OF SCREEN
#
procedure chop(str)
  /str := ""
  return "\e[J" || str
  end

#
# VIDEO ROUTINE OUTPUTS UPPER HALF OF DOUBLE SIZE MESSAGES
#
procedure uhalf(str)
  /str := ""
  if str == "" then return "\e#3"
  return "\e#3" || str
  end

#
# VIDEO ROUTINE OUTPUTS BOTTOM HALF OF DOUBLE SIZE MESSAGES
#
procedure lhalf(str)
  /str := ""
  if str == "" then return "\e#4"
  return "\e#4" || str
  end

#
# VIDEO ROUTINE OUTPUTS STRING AND CLEARS TO EOL
#
procedure clip(str)
  /str := ""
  if str == "" then return "\e[K "
  return str ||:= "\e[K"
  end

#
# VIDEO ROUTINE OUTPUTS HIGHLIGHTED STRINGS
#
procedure high(str)
  /str := ""
  if str == "" then return "\e[1m"
  str := "\e[1m" || str
  if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
    then return str
    else return str || "\e[m"
  end

#
# VIDEO ROUTINE OUTPUTS INVERSE VIDEO STRINGS
#
procedure inverse(str)
  /str := ""
  if str == "" then return "\e[7m"
  str := "\e[7m" || str
  if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
    then return str
    else return str || "\e[m"
  end

#
# VIDEO ROUTINE OUTPUTS UNDERLINED STRINGS
#
procedure under(str)
  /str := ""
  if str == "" then return "\e[4m"
  str := "\e[4m" || str
  if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
    then return str
    else return str || "\e[m"
  end

#
# VIDEO ROUTINE OUTPUTS BLINKING STRINGS
#
procedure blink(str)
  /str := ""
  if str == "" then return "\e[5m"
  str := "\e[5m" || str
  if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
    then return str
    else return str || "\e[m"
  end

#
# VIDEO ROUTINE SETS NORMAL VIDEO MODE
#
procedure norm(str)
  /str := ""
  if str == "" then return "\e[m"
  str := "\e[m" || str
  return str
  end

#
# VIDEO ROUTINE TURNS ON VT GRAPHICS CHARACTERS
#
procedure graf(str)
  /str := ""
  if str == "" then return "\e(0"
  str := "\e(0" || str
  if (str[-3:0] == "\e(B")
    then return str
    else return str || "\e(B"
  end

#
# VIDEO ROUTINE TURNS OFF VT GRAPHICS CHARACTERS
#
procedure nograf(str)
  /str := ""
  if str == "" then return "\e(B"
  str := "\e(B" || str
  return str
  end

#
# VIDEO ROUTINE SETS CURSOR TO GIVEN X,Y COORDINATES
#
procedure at(x,y)
  return "\e[" || y || ";" || x || "f"
  end

#
# PARSES A STRING INTO A LIST WITH RESPECT TO A GIVEN DELIMITER
#
procedure parse(line,delims)
  static chars
  chars  := &cset -- delims
  tokens := []
  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  return tokens
  end

#
# TAKE AN INPUT STRING VIA GIVEN PROMPT
#
procedure input(prompt)
  writes(prompt)
  return read()
  end
#
# DISCLAIMER
#
#########################################################################
#                                                                       #
#  Copyright (c) 1991, Chris D. Tenaglia # 12p                          #
#                                                                       #
#  This software is intended for free and unrestricted distribution.    #
#  I place only two conditions on its use:  1) That you clearly mark    #
#  any additions or changes you make to the source code, and 2) that    #
#  you do not delete this message therefrom.  In order to protect       #
#  myself from spurious litigation, it must also be stated here that,   #
#  because this is free software, I, Chris tenaglia, make no claim      #
#  about the applicability or fitness of this software for any          #
#  purpose, and expressly disclaim any responsibility for any damages   #
#  that might be incurred in conjunction with its use.                  #
#                                                                       #
#########################################################################


From [e-mail]  Tue May 28 07:35:18 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 28 May 91 07:35:18 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA04097; Tue, 28 May 91 07:35:15 MST
Received: from ucbvax.Berkeley.EDU (128.32.133.1) by Arizona.edu with
 PMDF#10282; Tue, 28 May 1991 03:48 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA13404; Tue, 28 May 91
 03:22:47 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Tue, 28 May 1991 03:48 MST
Date: 28 May 91 07:46:01 GMT
From: cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: list scanning routines
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago


############################################################################
#
#    Name:    lscan.icn
#
#    Title:    Quasi ? scanning routines for lists.
#
#    Author:    Richard L. Goerwitz
#
#    Version: 1.20
#
############################################################################
#
#  PURPOSE: String scanning is terrific, but often I am forced to
#  tokenize and work with lists.  So as to make operations on these
#  lists as close to corresponding string operations as possible, I've
#  implemented a series of list analogues to any(), bal(), find(),
#  many(), match(), move(), pos(), tab(), and upto().  Their names are
#  just like corresponding string functions, except with a prepended
#  "l_" (e.g. l_any()).  Functionally, the list routines parallel the
#  string ones closely, except that in place of strings, l_find and
#  l_match accept lists as their first argument.  L_any(), l_many(),
#  and l_upto() all take either sets of lists or lists of lists (e.g.
#  l_tab(l_upto([["a"],["b"],["j","u","n","k"]])).  Note that l_bal(),
#  unlike the builtin bal(), has no defaults for the first four
#  arguments.  This just seemed appropriate, given that no precise
#  list analogue to &cset, etc. occurs.
#
#  The default subject for list scans (analogous to &subject) is
#  l_SUBJ.  The equivalent of &pos is l_POS.  Naturally, these
#  variables are both global.  They are used pretty much like &subject
#  and &pos, except that they are null until a list scanning
#  expression has been encountered containing a call to l_Bscan() (on
#  which, see below).
#
#  Note that environments cannot be maintained quite as elegantly as
#  they can be for the builtin string-scanning functions.  One must
#  use instead a set of nested procedure calls, as explained in the
#  _Icon Analyst_ 1:6 (June, 1991), p. 1-2.  In particular, one cannot
#  suspend, return, or otherwise break out of the nested procedure
#  calls.  They can only be exited via failure.  The names of these
#  procedures, at least in this implementation, are l_Escan and
#  l_Bscan.  Here is one example of how they might be invoked:
#
#      suspend l_Escan(l_Bscan(some_list_or_other), {
#          l_tab(10 to *l_SUBJ) & {
#              if l_any(l1) | l_match(l2) then
#                  old_l_POS + (l_POS-1)
#          }
#      })
#
#  Note that you cannot do this:
#
#      l_Escan(l_Bscan(some_list_or_other), {
#          l_tab(10 to *l_SUBJ) & {
#              if l_any(l1) | l_match(l2) then
#                  suspend old_l_POS + (l_POS-1)
#          }
#      })
#
#  Remember, it's no fair to use suspend within the list scanning
#  expression.  l_Escan must do all the suspending.  It is perfectly OK,
#  though, to nest well-behaved list scanning expressions.  And they can
#  be reliably used to generate a series of results as well.
#
############################################################################
#
#  Here's another simple example of how one might invoke the l_scan
#  routines:
#
#  procedure main()
#
#      l := ["h","e","l","l","o"," ","t","t","t","h","e","r","e"]
#
#      l_Escan(l_Bscan(l), {
#          hello_list := l_tab(l_match(["h","e","l","l","o"]))
#          every writes(!hello_list)
#          write()
#
#          # Note the nested list-scanning expressions.
#       l_Escan(l_Bscan(l_tab(0)), {
#           l_tab(l_many([[" "],["t"]]) - 1)
#              every writes(!l_tab(0))
#           write()
#          })
#      })
#
#  end
#
#  The above program simply writes "hello" and "there" on successive
#  lines to the standard output.
#
############################################################################
#
#  PITFALLS: In general, note that we are comparing lists here instead
#  of strings, so l_find("h", l), for instance, will yield an error
#  message (use l_find(["h"], l) instead).  The point at which I
#  expect this nuance will be most confusing will be in cases where
#  one is looking for lists within lists.  Suppose we have a list,
#
#      l1 := ["junk",[["hello"]," ",["there"]],"!","m","o","r","e","junk"]
#
#  and suppose, moreover, that we wish to find the position in l1 at
#  which the list
#
#      [["hello"]," ",["there"]]
#
#  occurs.  If, say, we assign [["hello"]," ",["there"]] to the
#  variable l2, then our l_find() expression will need to look like
#
#      l_find([l2],l1)
#
############################################################################
#
#  Extending scanning to lists is really very difficult.  What I think
#  (at least tonight) is that scanning should never have been
#  restricted to strings.  It should have been designed to operate on
#  all homogenous one-dimensional arrays (vectors, for you LISPers).
#  You should be able, in other words, to scan vectors of ints, longs,
#  characters - any data type that seems useful.  The only question in
#  my mind is how to represent vectors as literals.  Extending scanning
#  to lists goes beyond the bounds of scanning per-se.  This library is
#  therefore something of a stab in the dark.
#
############################################################################


global l_POS
global l_SUBJ
record l_ScanEnvir(subject,pos)

procedure l_Bscan(e1)

    #
    # Prototype list scan initializer.  Based on code published in
    # the _Icon Analyst_ 1:6 (June, 1991), p. 1-2.
    #
    local l_OuterEnvir
    initial {
    l_SUBJ := []
    l_POS := 1
    }

    #
    # Save outer scanning environment.
    #
    l_OuterEnvir := l_ScanEnvir(l_SUBJ, l_POS)

    #
    # Set current scanning environment to subject e1 (arg 1).  Pos
    # defaults to 1.  Suspend the saved environment.  Later on, the
    # l_Escan procedure will need this in case the scanning expres-
    # sion as a whole sends a result back to the outer environment,
    # and the outer environment changes l_SUBJ and l_POS.
    #
    l_SUBJ := e1
    l_POS  := 1
    suspend l_OuterEnvir

    #
    # Restore the saved environment (plus any changes that might have
    # been made to it as noted in the previous run of comments).
    #
    l_SUBJ := l_OuterEnvir.subject
    l_POS := l_OuterEnvir.pos

    #
    # Signal failure of the scanning expression (we're done producing
    # results if we get to here).
    #
    fail

end



procedure l_Escan(l_OuterEnvir, e2)

    local l_InnerEnvir

    #
    # Set the inner scanning environment to the values assigned to it
    # by l_Bscan.  Remember that l_SUBJ and l_POS are global.  They
    # don't need to be passed as parameters from l_Bscan.  What
    # l_Bscan() needs to pass on is the l_OuterEnvir record,
    # containing the values of l_SUBJ and l_POS before l_Bscan() was
    # called.  l_Escan receives this "outer environment" as its first
    # argument, l_OuterEnvir.
    #
    l_InnerEnvir := l_ScanEnvir(l_SUBJ, l_POS)

    #
    # Whatever expression produced e2 has passed us a result.  Now we
    # restore l_SUBJ and l_POS, and send that result back to the outer
    # environment.
    #
    l_SUBJ := l_OuterEnvir.subject
    l_POS := l_OuterEnvir.pos
    suspend e2

    #
    # Okay, we've resumed to (attempt to) produce another result.  Re-
    # store the inner scanning environment (the one we're using in the
    # current scanning expression).  Remember?  It was saved in l_Inner-
    # Envir just above.
    #
    l_SUBJ := l_InnerEnvir.subject
    l_POS := l_InnerEnvir.pos

    #
    # Fail so that the second argument (the one that produced e2) gets
    # resumed.  If it fails to produce another result, then the first
    # argument is resumed, which is l_Bscan().  If l_Bscan is resumed, it
    # will restore the outer environment and fail, causing the entire
    # scanning expression to fail.
    #
    fail

end



procedure l_move(i)

    /i & stop("l_move:  Null argument.")
    if /l_POS | /l_SUBJ then
    stop("l_move:  Call l_Bscan() first.")

    #
    # Sets l_POS to l_POS+i; suspends that portion of l_SUBJ extending
    # from the old l_POS to the new one.  Resets l_POS if resumed,
    # just the way matching procedures are supposed to.  Fails if l_POS
    # plus i is larger than l_SUBJ+1 or if l_POS+i is less than 1.
    #
    suspend l_SUBJ[.l_POS:l_POS <- (0 < (*l_SUBJ+1 >= l_POS+i))]

end



procedure l_tab(i)

    /i & stop("l_tab:  Null argument.")
    if /l_POS | /l_SUBJ then
    stop("l_tab:  Call l_Bscan() first.")

    if i <= 0
    then suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i)]
    else suspend l_SUBJ[.l_POS:l_POS <- 0 < (*l_SUBJ+1 >= i)]

end



procedure l_any(l1,l2,i,j)

    #
    # Like any(c,s2,i,j) except that the string & cset arguments are
    # replaced by list arguments.  l1 must be a list of one-element
    # lists, while l2 can be any list (l_SUBJ by default).
    #

    local sub_l

    /l1 & stop("l_any:  Null first argument!")
    if type(l1) == "set" then l1 := sort(l1)

    /l2 := l_SUBJ
    if \i then {
    if i < 1 then
        i := *l2 + (i+1)
    }
    else i := \l_POS | 1
    if \j then {
    if j < 1 then
        j := *l2 + (j+1)
    }
    else j := *l_SUBJ+1

    (i+1) > j & i :=: j
    every sub_l := !l1 do {
    if not (type(sub_l) == "list", *sub_l = 1) then
        stop("l_any:  Elements of l1 must be lists of length 1.")
    # Let l_match check to see if i+1 is out of range.
    if x := l_match(sub_l,l2,i,i+1) then
        return x
    }

end



procedure l_match(l1,l2,i,j)

    #
    # Analogous to match(s1,s2,i,j), except that s1 and s2 are lists,
    # and l_match returns the next position in l2 after that portion
    # (if any) which is structurally identical to l1.  If a match is not
    # found, l_match fails.
    #

    if /l1
    then stop("l_match:  Null first argument!")
    if type(l1) ~== "list"
    then stop("l_match:  Call me with a list as the first arg.")

    /l2 := l_SUBJ
    if \i then {
    if i < 1 then
        i := *l2 + (i+1)
    }
    else i := \l_POS | 1

    if \j then {
    if j < 1 then
        j := *l2 + (j+1)
    }
    else j := *l_SUBJ+1

    i + *l1 > j & i :=: j
    i + *l1 > j & fail
    if l_comp(l1,l2[i+:*l1]) then
    return i + *l1

end



procedure l_comp(l1,l2)

    #
    # List comparison routine basically taken from Griswold & Griswold
    # (1st ed.), p. 174.
    #

    local i

    /l1 | /l2 & stop("l_comp:  Null argument!")
    l1 === l2 & (return l2)

    if type(l1) == type(l2) == "list" then {
    *l1 ~= *l2 & fail
    every i := 1 to *l1
    do l_comp(l1[i],l2[i]) | fail
    return l2
    }

end



procedure l_find(l1,l2,i,j)

    #
    # Like the builtin find(s1,s2,i,j), but for lists.
    #

    local x

    /l1 & stop("l_find:  Null first argument!")

    /l2 := l_SUBJ
    if \i then {
    if i < 1 then
        i := *l2 + (i+1)
    }
    else i := \l_POS | 1
    if \j then {
    if j < 1 then
        j := *l2 + (j+1)
    }
    else j := *l_SUBJ+1

    #
    # See l_upto() below for a discussion of why things have to be done
    # in this manner.
    #
    old_l_POS := l_POS

    suspend l_Escan(l_Bscan(l2[i:j]), {
    l_tab(1 to *l_SUBJ) & {
        if l_match(l1) then
        old_l_POS + (l_POS-1)
    }
    })

end



procedure l_upto(l1,l2,i,j)

    #
    # See l_any() above.  This procedure just moves through l2, calling
    # l_any() for each member of l2[i:j].
    #

    local old_l_POS

    /l1 & stop("l_upto:  Null first argument!")
    if type(l1) == "set" then l1 := sort(l1)

    /l2 := l_SUBJ
    if \i then {
    if i < 1 then
        i := *l2 + (i+1)
    }
    else i := \l_POS | 1
    if \j then {
    if j < 1 then
        j := *l2 + (j+1)
    }
    else j := *l_SUBJ+1

    #
    # Save the old pos, then try arb()ing through the list to see if we
    # can do an l_any(l1) at any position.
    #
    old_l_POS := l_POS

    suspend l_Escan(l_Bscan(l2[i:j]), {
    l_tab(1 to *l_SUBJ) & {
        if l_any(l1) then
        old_l_POS + (l_POS-1)
    }
    })

    #
    # Note that it WILL NOT WORK if you say:
    #
    # l_Escan(l_Bscan(l2[i:j]), {
    #     l_tab(1 to *l_SUBJ) & {
    #         if l_any(l1) then
    #             suspend old_l_POS + (l_POS-1)
    #     }
    # })
    #
    # If we are to suspend a result, l_Escan must suspend that result.
    # Otherwise scanning environments are not saved and/or restored
    # properly.
    #

end



procedure l_many(l1,l2,i,j)

    local x, old_l_POS

    /l1 & stop("l_many:  Null first argument!")
    if type(l1) == "set" then l1 := sort(l1)

    /l2 := l_SUBJ
    if \i then {
    if i < 1 then
        i := *l2 + (i+1)
    }
    else i := \l_POS | 1
    if \j then {
    if j < 1 then
        j := *l2 + (j+1)
    }
    else j := *l_SUBJ+1

    #
    # L_many(), like many(), is not a generator.  We can therefore
    # save one final result in x, and then later return (rather than
    # suspend) that result.
    #
    old_l_POS := l_POS
    l_Escan(l_Bscan(l2[i:j]), {
    while l_tab(l_any(l1))
    x := old_l_POS + (l_POS-1)
    })

    #
    # Fails if there was no positional change (i.e. l_any() did not
    # succeed even once).
    #
    return old_l_POS ~= x

end



procedure l_pos(i)

    local x

    if /l_POS | /l_SUBJ
    then stop("l_move:  Call l_Bscan() first.")

    if i <= 0
    then x := 0 < (*l_SUBJ+1 >= (*l_SUBJ+1)+i) | fail
    else x := 0 < (*l_SUBJ+1 >= i) | fail

    if x = l_POS
    then return x
    else fail

end



procedure l_bal(l1,l2,l3,l,i,j)

    local l2_count, l3_count, x, position

    /l1 & stop("l_bal:  Null first argument!")
    if type(l1) == "set" then l1 := sort(l1)  # convert to a list
    if type(l2) == "set" then l1 := sort(l2)
    if type(l3) == "set" then l1 := sort(l3)

    /l2 := l_SUBJ
    if \i then {
    if i < 1 then
        i := *l2 + (i+1)
    }
    else i := \l_POS | 1
    if \j then {
    if j < 1 then
        j := *l2 + (j+1)
    }
    else j := *l_SUBJ+1

    l2_count := l3_count := 0

    every x := i to j-1 do {

    if l_any(l2, l, x, x+1) then {
        l2_count +:= 1
    }
    if l_any(l3, l, x, x+1) then {
        l3_count +:= 1
    }
    if l2_count = l3_count then {
        if l_any(l1,l,x,x+1)
        then suspend x
    }
    }

end
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Tue May 28 10:03:39 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 28 May 91 10:03:39 MST
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA15448; Tue, 28 May 91 10:03:35 MST
Received: from UKACRL.BITNET (MAILER@UKACRL) by Arizona.edu with PMDF#10282;
 Tue, 28 May 1991 10:03 MST
Received: from RL.IB by UKACRL.BITNET (Mailer R2.07) with BSMTP id 5763; Tue,
 28 May 91 17:32:02 BST
Received: from RL.IB by UK.AC.RL.IB (Mailer R2.07) with BSMTP id 6741; Tue, 28
 May 91 17:32:02 BST
Date: 28 May 91  17:32:28 bst
From: [e-mail]
Subject: Records
To: [e-mail]
Message-Id: <28 May 91  17:32:28 bst  060196@EMAS-A>
X-Envelope-To: [e-mail]
Via:        UK.AC.ED.EMAS-A; 28 MAY 91 17:31:57 BST

I'm just about to start writing my first program which uses records.
Question, can I write a record straight to a file without separating the
fields - like this:

record line(a,b,c,d)
procedure(main)
  .
  .
output_line:=line(w,x,y,z)
write(file,output_line)
  .
  .

or do I have to do it a field at a time:

  .
every i := 1 to 4 do write(file,output_line[i])
  .

Any advice appreciated.

Thanks.

Roger Hare.

From ralph  Tue May 28 10:07:54 1991
Date: Tue, 28 May 91 10:07:54 MST
From: "Ralph Griswold" <ralph>
Message-Id: <[e-mail]>
Received: by cheltenham.cs.arizona.edu; Tue, 28 May 91 10:07:54 MST
To: [e-mail]
Subject: Re:  Records
Cc: icon-group

You have to write each field separatey.  However, you can generate the
fields of a record.  E.g., if x is a record,

    every write(!x)

writes all the fields of x, one per line.

  Ralph Griswold / Dept of Computer Science / Univ of Arizona / Tucson, AZ 85721
  [phone]   [e-mail]  uunet!arizona!ralph

From gmt  Tue May 28 10:27:02 1991
Received: from owl.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 28 May 91 10:27:02 MST
Date: Tue, 28 May 91 10:27:00 MST
From: "Gregg Townsend" <gmt>
Message-Id: <[e-mail]>
Received: by owl.cs.arizona.edu; Tue, 28 May 91 10:27:00 MST
To: icon-group
Subject: Re:  Records

To write the record as a single line I would do this:

    every writes (!output_line | "\n")

    Gregg Townsend / Computer Science Dept / Univ of Arizona / Tucson, AZ 85721
    [phone]     [e-mail]     110 57 16 W / 32 13 45 N / +758m

From [e-mail]  Tue May 28 21:12:26 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 28 May 91 21:12:26 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA04640; Tue, 28 May 91 21:12:24 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Tue, 28 May
 1991 21:11 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA25558; Tue, 28 May 91
 21:05:29 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Tue, 28 May 1991 21:12 MST
Date: 29 May 91 04:00:11 GMT
From: cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE: Holiday TidBit
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

If anyone wants a Unix version of Chris Tenaglia's yahtzee game (will
probably work for DOS, too), please let me know.  If I get more than
a few requests, I'll post it.

-Richard
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Wed May 29 08:14:10 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 29 May 91 08:14:10 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA24922; Wed, 29 May 91 08:14:04 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 29 May
 1991 08:12 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA09005; Wed, 29 May 91
 07:53:42 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 29 May 1991 08:13 MST
Date: 29 May 91 14:56:04 GMT
From: cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE: Holiday TidBit, part 1 of 3 of Unix port
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>,
 <[e-mail]>

I logged in this morning, and had six requests for the game.  I suspect
I'll get more, so let me just post the Unix (test!) port of Chris Tenaglia's
yahtzee game.  It's been tested by me alone, and this only on ansi terminals.
I believe it will work, though, on just about any non-cookie terminal that
has cd capability.  Part 1 follows.  Parts 2 & 3 come in separate mailings.
Please let me know about bugs.


---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 05/29/1991 05:23 UTC by [e-mail]
# Source directory /u/richard/Yahtz
#
# existing files will NOT be overwritten unless -c is specified
# This format requires very little intelligence at unshar time.
# "if test", "cat", "rm", "echo", "true", and "sed" may be needed.
#
# This is part 1 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#  15750 -r--r--r-- yahtz.icn
#  17272 -r--r--r-- iolib.icn
#   2391 -r--r--r-- termcap.dos
#    994 -rw-r--r-- Makefile.dist
#   1194 -rw-r--r-- README
#
if test -r _shar_seq_.tmp; then
    echo 'Must unpack archives in sequence!'
    echo Please unpack part `cat _shar_seq_.tmp` next
    exit 1
fi
# ============= yahtz.icn ==============
if test -f 'yahtz.icn' -a X"$1" != X"-c"; then
    echo 'x - skipping yahtz.icn (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting yahtz.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'yahtz.icn' &&
X############################################################################
X#
X#    Name:     yahtz.icn
X#
X#    Title:     yahtz (alias yahtzee, without a naming conflict)
X#
X#    Author:     Chris Tenaglia, modified by Richard Goerwitz
X#
X#    Version: 1.3 (beta!)
X#
X#########################################################################
X#
X#  Copyright (c) 1991, Chris D. Tenaglia # 12p
X#
X#  This software is intended for free and unrestricted distribution.
X#  I place only two conditions on its use:  1) That you clearly mark
X#  any additions or changes you make to the source code, and 2) that
X#  you do not delete this message therefrom.  In order to protect
X#  myself from spurious litigation, it must also be stated here that,
X#  because this is free software, I, Chris tenaglia, make no claim
X#  about the applicability or fitness of this software for any
X#  purpose, and expressly disclaim any responsibility for any damages
X#  that might be incurred in conjunction with its use.
X#
X#########################################################################
X#
X#  This hacked version will run under UNIX, and under DOS as well.  It
X#  should run out of the box on DOS as long as you stay in the current
X#  directory.  See the README file.
X#
X#  This is a test version!!  In accordance with the author's wishes,
X#  I'd like to make it clear that I've altered all the screen I/O
X#  routines, and have removed characters peculiar to VT terminals.
X#  I've tried to keep intact the author's indentation and brace style.
X#  Changes, where present, have been indicated by my initials.  The
X#  IPL-style header was added by me.  I also moved Chris's copyright
X#  notice to the top of the document.  It seems to me that such no-
X#  tices have to be prominently displayed in order to be considered
X#  valid.
X#
X#  -Richard Goerwitz.
X#
X############################################################################
X
X
Xglobal players,slot,team,d,od,dice,round
Xprocedure main(param)
X  paint()
X  assign_players()
X  every round := 1 to 13 do
X    every play(!team)
X  summarize()
X  end
X
X#
X# DISPLAYS THE HEADER AND SEPARATOR LINE AT BEGINNING OF GAME
X#
Xprocedure paint()
X  # Clear first, separately.  Screws up on some terminals of you don't.
X  writes(cls())
X  # Check to be sure the terminal is big enough, and won't leave magic
X  # cookies on the screen.  -RLG
X  if getval("ug"|"sg") > 0
X  then stop("abort:  Can't do magic cookie terminals!")
X  if getval("li") < 24 | getval("co") < 80 then
X    stop("abort:  Your terminal is too small!")
X  write(high(uhalf("             Y A H T Z E E              ")))
X  write(high(lhalf("             Y A H T Z E E              ")))
X  write(at(1,10),graf(repl("=",75)))
X  end
X
X#
X# DISPLAYS THE FINAL SCORE OF ALL THE PLAYERS
X#
Xprocedure summarize()
X  # blink, high, inverse was just too much for my terminal to handle -RLG
X  write(at(1,11), high(chop("Final Score Summary")))
X  every player := key(players) do
X    {
X    card := players[player]
X    top  := 0 ; every i := 1 to 6 do top +:= card[i]
X    if top > 62 then top +:= 35
X    bottom := 0 ; every i := 7 to 13 do bottom +:= card[i]
X    write("Player ",high(left(player,14))," Top = ",right(top,5),
X                                       " Bottom = ",right(bottom,5),
X                                       "  Total = ",right(top+bottom,5))
X    }
X  input("<press return>")
X  end
X
X#
X# SETUP AND INITIALIZATION OF YAHTZEE ENVIRONMENT
X#
Xprocedure assign_players()
X  n := 1 ; team := [] ; slot := [] ; d := list(6,"") ; od := list(5,0)
X  &random := map(&clock,":","9")
X  players := table("n/a")
X  repeat
X    {
X    (player := input(("Name of player #" || n || ": "))) |
X      stop("Game called off.")
X    if player == "" then break
X    n +:= 1
X    put(team,player)
X    players[player] := list(13,"*")
X    }
X  if n = 1 then stop("Nobody wants to play!")
X
X  put(slot,"Ones")   ; put(slot,"Twos")  ; put(slot,"Threes")
X  put(slot,"Fours")  ; put(slot,"Fives") ; put(slot,"Sixes")
X  put(slot,"3oK")    ; put(slot,"4oK")   ; put(slot,"FullH")
X  put(slot,"SmStr")  ; put(slot,"LgStr") ; put(slot,"Yahtzee")
X  put(slot,"Chance")
X
X  # VT-specific characters removed.  -RLG
X  d[1] := "+-----+|     ||  o  ||     |+-----+"
X  d[2] := "+-----+|     || o o ||     |+-----+"
X  d[3] := "+-----+|o    ||  o  ||    o|+-----+"
X  d[4] := "+-----+|o   o||     ||o   o|+-----+"
X  d[5] := "+-----+|o   o||  o  ||o   o|+-----+"
X  d[6] := "+-----+|o o o||     ||o o o|+-----+"
X  end
X
X#
X# THIS ROUTINE LETS A PLAYER TAKE THEIR TURN
X#
Xprocedure play(name)
X  writes(at(1,11),"It's ",high(name),"'s turn",chop())
X  writes(at(1,getval("li")-1),high(name))
X  input(", please press <RETURN> to begin.")
X  score(name)
X  dice := [] ; every 1 to 5 do put(dice,?6)
X  depict()
X  shake := obtain("Shake which ones : ")
X  (shake === []) | (every dice[!shake] := ?6)
X  depict()
X  shake := obtain("Shake which ones (last chance) : ")
X  (shake === []) | (every dice[!shake] := ?6)
X  depict()
X  repeat
X    {
X    select := input(at(1,22) || clip("Tally to which category (1-13) : "))
X    numeric(select)                | next
X    (1 <= select <= 13)            | next
X    (players[name][select] == "*") | next
X    break
X    }
X  tally(name,select)
X  score(name)
X  input(at(1,22) || clip("Press <RETURN>"))
X  end
X
X#
X# THIS ROUTINE DRAWS THE DICE
X#
Xprocedure depict()
X  every i := 1 to 5 do
X    {
X    if od[i] = dice[i] then next
X    x := 1
X    writes(at(i*10+3,3),inverse(i))
X#    writes(at(i*10+4,9),inverse(dice[i]))
X    every j := 4 to 8 do
X      {
X      writes(at(i*10,j),graf(d[dice[i]][x:x+7]))
X      x +:= 7
X      }
X    od[i] := dice[i]
X    }
X  end
X
X#
X# THIS ROUTINE LETS THE PLAYER DECIDE WHAT TO APPLY THE SHAKES TO
X#
Xprocedure tally(name,area)
X  case integer(area) of
X    {
X    1 : {                        # ones
X        sum := 0 ; every unit := !dice do if unit = 1 then sum +:= 1
X        players[name][1] := sum
X        }
X    2 : {                        # twos
X        sum := 0 ; every unit := !dice do if unit = 2 then sum +:= 2
X        players[name][2] := sum
X        }
X    3 : {                        # threes
X        sum := 0 ; every unit := !dice do if unit = 3 then sum +:= 3
X        players[name][3] := sum
X        }
X    4 : {                        # fours
X        sum := 0 ; every unit := !dice do if unit = 4 then sum +:= 4
X        players[name][4] := sum
X        }
X    5 : {                        # fives
X        sum := 0 ; every unit := !dice do if unit = 5 then sum +:= 5
X        players[name][5] := sum
X        }
X    6 : {                        # sixes
X        sum := 0 ; every unit := !dice do if unit = 6 then sum +:= 6
X        players[name][6] := sum
X        }
X    7 : {                        # 3 of a kind
X        sum := 0 ; flag := 0
X        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
X        every piece := key(tmp) do
X          if tmp[piece] >= 3 then flag := 1
X        if flag = 1 then every sum +:= !dice
X        players[name][7] := sum
X        }
X    8 : {                        # four of a kind
X        sum := 0 ; flag := 0
X        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
X        every piece := key(tmp) do
X          if tmp[piece] >= 4 then flag := 1
X        if flag = 1 then every sum +:= !dice
X        players[name][8] := sum
X        }
X    9 : {                        # full house
X        sum := 0 ; flag := 0
X        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
X        every piece := key(tmp) do
X          {
X          if tmp[piece] = 3 then flag +:= 1
X          if tmp[piece] = 2 then flag +:= 1
X          }
X        if flag = 2 then sum := 25
X        players[name][9] := sum
X        }
X   10 : {                        # small straight
X        sum  := 0 ; flag := 0
X        hold := set() ; every insert(hold,!dice)
X        tmp  := sort(hold)
X        if tmp[1]+1 = tmp[2] &
X           tmp[2]+1 = tmp[3] &
X           tmp[3]+1 = tmp[4] then flag := 1
X        if tmp[2]+1 = tmp[3] &
X           tmp[3]+1 = tmp[4] &
X           tmp[4]+1 = tmp[5] then flag := 1
X        if flag = 1 then sum := 30
X        players[name][10] := sum
X        }
X   11 : {                        # large straight
X        sum := 0 ; flag := 0
X        tmp := sort(dice)
X        if tmp[1]+1 = tmp[2] &
X           tmp[2]+1 = tmp[3] &
X           tmp[3]+1 = tmp[4] &
X           tmp[4]+1 = tmp[5] then flag := 1
X        if flag = 1 then sum := 40
X        players[name][11] := sum
X        }
X   12 : {                        # yahtzee
X        sum := 0 ; flag := 0
X        tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
X        every piece := key(tmp) do
X          if tmp[piece] = 5 then flag := 1
X        if flag = 1 then sum := 50
X        players[name][12] := sum
X        }
X   13 : {                        # chance
X        sum := 0 ; every sum +:= !dice
X        players[name][13] := sum
X        }
X    }
X  end
X
X#
X# THIS ROUTINE OBTAINS A VALID SHAKER REQUEST
X#
Xprocedure obtain(prompt)
X  repeat
X    {
X    writes(at(1,22),prompt)
X    (line := read()) | next
X    if match("q",map(line)) then stop("Game Quit")
X    if trim(line) == "" then return []
X    units := parse(line,', \t')
X    every unit := !units do
X      (1 <= unit <= 5) | next
X    break
X    }
X  return units
X  end
X
X#
X# THIS ROUTINE PAINTS THE SCORECARD FOR A GIVEN PLAYER
X#
Xprocedure score(name)
X  # Slight realignment.  -RLG
X  writes(at(1,11),chop(),at(18,11),under(),"Player = ",name,"     Round = ",under(round))
X  writes(at(10,12)," 1 : Ones    = ",players[name][1])
X  writes(at(10,13)," 2 : Twos    = ",players[name][2])
X  writes(at(10,14)," 3 : Threes  = ",players[name][3])
X  writes(at(10,15)," 4 : Fours   = ",players[name][4])
X  writes(at(10,16)," 5 : Fives   = ",players[name][5])
X  writes(at(10,17)," 6 : Sixes   = ",players[name][6])
X  writes(at(40,12)," 7 : 3oK     = ",players[name][7])
X  writes(at(40,13)," 8 : 4oK     = ",players[name][8])
X  writes(at(40,14)," 9 : FullH   = ",players[name][9])
X  writes(at(40,15),"10 : SmStr   = ",players[name][10])
X  writes(at(40,16),"11 : LgStr   = ",players[name][11])
X  writes(at(40,17),"12 : Yahtzee = ",players[name][12])
X  writes(at(40,18),"13 : Chance  = ",players[name][13])
X  st1 := 0 ; every i := 1 to 6 do st1 +:= numeric(players[name][i])
X  if st1 > 62 then bonus := 35 else bonus := 0
X  st2 := 0 ; every i := 7 to 13 do st2 +:= numeric(players[name][i])
X  writes(at(10,19),"Bonus = ",clip(bonus))
X  writes(at(10,20),"Subtotal = ",st1+bonus)
X  writes(at(40,20),"Subtotal = ",st2)
X  writes(at(37,21),"Grand Total = ",st1+st2+bonus)
X  end
X
X#
X# From here down, all CT's VT-specific I/O codes have been replaced
X# with calls to iolib/itlib routines.  The replacements were quite
X# easy to do because of the great modularity of the original program.
X# -RLG
X#
X
X#
X# VIDEO ROUTINE CLEARS SCREEN
X#
Xprocedure cls(str)
X  static clear_string
X  initial {
X    clear_string := getval("cl") |
X    (igoto(getval("cm"),1,1) || getval("cd")) |
X    stop("abort:  Your terminal can't clear screen!")
X    }
X  /str := ""
X  return clear_string || str
X  end
X
X#
X# VIDEO ROUTINE ERASES REST OF SCREEN
X#
Xprocedure chop(str)
X  static clear_rest
X  initial {
X    clear_rest := getval("cd") |
X    stop("abort:  Sorry, your terminal must have cd capability.")
X  }
X  /str := ""
X  return clear_rest || str
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS UPPER HALF OF DOUBLE SIZE MESSAGES
X#
Xprocedure uhalf(str)
X  # Disabled for non-VT{2,3,4}XX terminals.  I'd have left them in for
X  # vt100s, but there are so many vt100 terminal emulation programs out
X  # there that don't do the big characters that I thought better of it.
X  # -RLG
X  static isVT
X  initial
X    {
X    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
X    then isVT := 1
X    }
X  if \isVT then
X    {
X    /str := ""
X    if str == "" then return "\e#3"
X    return "\e#3" || str
X    }
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS BOTTOM HALF OF DOUBLE SIZE MESSAGES
X#
Xprocedure lhalf(str)
X  static isVT
X  initial
X    {
X    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
X    then isVT := 1
X    }
X  if \isVT then
X    {
X    /str := ""
X    if str == "" then return "\e#4"
X    return "\e#4" || str
X    }
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS STRING AND CLEARS TO EOL
X#
Xprocedure clip(str)
X  static clear_line
X  initial
X    {
X    clear_line := getval("ce") | "                "
X    }
X  /str := ""
X  if str == "" then return clear_line
X  return str ||:= clear_line
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS HIGHLIGHTED STRINGS
X#
Xprocedure high(str)
X  static bold_code, off_other_modes
X  initial
X    {
X    off_other_modes := ""
X    every off_other_modes ||:= getval("me"|"ue"|"se")
X    bold_code := off_other_modes || getval("md"|"us"|"so")
X    }
X  /str := ""
X  return bold_code || str || off_other_modes
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS INVERSE VIDEO STRINGS
X#
Xprocedure inverse(str)
X  static reverse_code, off_other_modes
X  initial
X    {
X    off_other_modes := ""
X    every off_other_modes ||:= getval("se"|"ue"|"me")
X    reverse_code := off_other_modes || getval("so"|"us"|"md")
X    }
X  /str := ""
X  return reverse_code || str || off_other_modes
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS UNDERLINED STRINGS
X#
Xprocedure under(str)
X  static underline_code, off_other_modes
X  initial
X    {
X    off_other_modes := ""
X    every off_other_modes ||:= getval("ue"|"me"|"se")
X    underline_code := off_other_modes || getval("us"|"md"|"so")
X    }
X  /str := ""
X  return underline_code || str || off_other_modes
X  end
X
X#
X# VIDEO ROUTINE OUTPUTS BLINKING STRINGS
X#
Xprocedure blink(str)
X  static blink_code, off_other_modes
X  initial
X    {
X    off_other_modes := ""
X    every off_other_modes ||:= getval("me"|"se"|"ue")
X    blink_code := off_other_modes || getval("mb"|"md"|"so"|"us")
X    }
X  /str := ""
X  return blink_code || str || off_other_modes
X  end
X
X#
X# VIDEO ROUTINE SETS NORMAL VIDEO MODE
X#
Xprocedure norm(str)
X  static off_modes
X  initial
X    {
X    off_modes := ""
X    every off_modes ||:= getval("me"|"se"|"ue")
X    }
X  /str := ""
X  return off_modes || str
X  end
X
X#
X# VIDEO ROUTINE TURNS ON VT GRAPHICS CHARACTERS
X#
Xprocedure graf(str)
X  # Again, disabled for non-VT{234}XX terminals.  -RLG
X  static isVT
X  initial
X    {
X    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
X    then isVT := 1
X    }
X  /str := ""
X  if \isVT then
X    {
X    if str == "" then return "\e(0"
X    str := "\e(0" || str
X    if (str[-3:0] == "\e(B")
X      then return str
X      else return str || "\e(B"
X    }
X  else return str
X  end
X
X#
X# VIDEO ROUTINE TURNS OFF VT GRAPHICS CHARACTERS
X#
Xprocedure nograf(str)
X  static isVT
X  initial
X    {
X    if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0)))
X    then isVT := 1
X    }
X  /str := ""
X  if \isVT then
X    {
X    if str == "" then return "\e(B"
X    str := "\e(B" || str
X    }
X  return str
X  end
X
X#
X# VIDEO ROUTINE SETS CURSOR TO GIVEN X,Y COORDINATES
X#
Xprocedure at(x,y)
X  return igoto(getval("cm"), x, y)
X  end
X
X#########  Here end the I/O routines I needed to alter.  -RLG
X
X#
X# PARSES A STRING INTO A LIST WITH RESPECT TO A GIVEN DELIMITER
X#
Xprocedure parse(line,delims)
X  local i, tokens
X  static chars
X  chars  := &cset -- delims
X  tokens := []
X  line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
X  #
X  # My first time playing, I didn't put spaces between the numbers
X  # for the dice.  When you think about it, though, why bother?
X  # They can't be any longer than one digit each, so there's no
X  # ambiguity.  This bit of code makes the game a bit more idiot-
X  # proof.  -RLG (one of the idiots)
X  #
X  if *!tokens > 1 then line ?
X    {
X    tokens := []
X    if tab(upto(&digits)) then
X      {
X      while put(tokens, move(1)) do
X        tab(upto(&digits)) | break
X      put(tokens, integer(tab(0)))
X      }
X    }
X  return tokens
X  end
X
X#
X# TAKE AN INPUT STRING VIA GIVEN PROMPT
X#
Xprocedure input(prompt)
X  writes(prompt)
X  return read()
X  end
SHAR_EOF
true || echo 'restore of yahtz.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= iolib.icn ==============
if test -f 'iolib.icn' -a X"$1" != X"-c"; then
    echo 'x - skipping iolib.icn (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting iolib.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'iolib.icn' &&
X########################################################################
X#
X#    Name:    iolib.icn
X#
X#    Title:    Icon termlib-type tools for MS-DOS and UNIX
X#
X#    Author:    Richard L. Goerwitz (with help from Norman Azadian)
X#
X#    Version: 1.9
X#
X#########################################################################
X#
X#  The authors place this and future versions of iolib in the public
X#  domain.
X#
X#########################################################################
X#
X#  The following library represents a series of rough functional
X#  equivalents to the standard Unix low-level termcap routines.  It is
X#  not meant as an exact termlib clone.  Nor is it enhanced to take
X#  care of magic cookie terminals, terminals that use \D in their
X#  termcap entries, or archaic terminals that require padding.  This
X#  library is geared mainly for use with ANSI and VT-100 devices.
X#  Note that this file may, in most instances, be used in place of the
X#  older UNIX-only itlib.icn file.  It essentially replaces the DOS-
X#  only itlibdos routines.  For DOS users not familiar with the whole
X#  notion of generalized screen I/O, I've included extra documentation
X#  below.  Please read it.
X#
X#  The sole disadvantage of this over the old itlib routines is that
X#  iolib.icn cannot deal with archaic or arcane UNIX terminals and/or
X#  odd system file arrangements.  Note that because these routines
X#  ignore padding, they can (unlike itlib.icn) be run on the NeXT and
X#  other systems which fail to implement the -g option of the stty
X#  command.  Iolib.icn is also simpler and faster than itlib.icn.
X#
X#  I want to thank Norman Azadian for suggesting the whole idea of
X#  combining itlib.icn and itlibdos.icn into one distribution, for
SHAR_EOF
true || echo 'restore of iolib.icn failed'
fi
echo 'End of  part 1'
echo 'File iolib.icn is continued in part 2'
echo 2 > _shar_seq_.tmp
exit 0
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Wed May 29 08:28:34 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 29 May 91 08:28:34 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA25313; Wed, 29 May 91 08:28:31 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 29 May
 1991 08:27 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA09529; Wed, 29 May 91
 08:14:33 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 29 May 1991 08:28 MST
Date: 29 May 91 14:57:12 GMT
From: cis.ohio-state.edu!zaphod.mps.ohio-state.edu!maverick.ksu.ksu.edu!ux1.cso.uiuc.edu!midway!ellis.uchicago.edu![e-mail]
 (Richard L. Goerwitz)
Subject: RE: Holiday TidBit, part 3 of 3
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>,
 <[e-mail]>


---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is yahtz.03 (part 3 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file Makefile.dist continued
#
if test ! -r _shar_seq_.tmp; then
    echo 'Please unpack part 1 first!'
    exit 1
fi
(read Scheck
 if test "$Scheck" != 3; then
    echo Please unpack part "$Scheck" next!
    exit 1
 else
    exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
    echo 'x - still skipping Makefile.dist'
else
echo 'x - continuing file Makefile.dist'
sed 's/^X//' << 'SHAR_EOF' >> 'Makefile.dist' &&
XPROGNAME = yahtz
X
X# You may need to change this.
XICONC = /usr/icon/v8/bin/icont
X
X# Don't change this, unless you happen to have a copy of itlib.icn
X# around, and know it works for your system.
XITLIB = iolib
X
X# Please edit these to reflect your local file structure & conventions.
XDESTDIR = /usr/local/games
XOWNER = root
XGROUP = root
X
X# Please don't change these.
XSRC = $(PROGNAME).icn $(ITLIB).icn
XSHELL = /bin/sh
X
X# I hope you won't have to use this.
X# DEBUGFLAG = -t
X
X$(PROGNAME): $(SRC)
X    $(ICONC) $(DEBUGFLAG) -o $(PROGNAME) $(SRC)
X
X# Pessimistic assumptions regarding the environment (in particular,
X# I don't assume you have the BSD "install" shell script).
Xinstall: $(PROGNAME)
X    test -d $(DESTDIR) || (mkdir $(DESTDIR) && chmod 755 $(DESTDIR))
X    cp $(PROGNAME) $(DESTDIR)/
X    chgrp $(GROUP) $(DESTDIR)/$(PROGNAME)
X    chown $(OWNER) $(DESTDIR)/$(PROGNAME)
X    @echo "\nInstallation done.\n"
X
Xclobber:
X    -rm -f *~ .u?
X    -rm -f $(PROGNAME)
SHAR_EOF
echo 'File Makefile.dist is complete' &&
true || echo 'restore of Makefile.dist failed'
rm -f _shar_wnt_.tmp
fi
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
    echo 'x - skipping README (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
XThis hacked version of Chris Tenaglia's yahtzee program will run under
XUNIX, and under DOS as well.  To run it under DOS, you need
Xnnansi.sys.  Sorry, but the old ansi driver doesn't cut it.  Check out
Xthe iolib.icn file for directions on how to set your environment
Xvariables so that iolib can find your termcap file regardless of what
Xdirectory it's in, and so that you can tell iolib that you aren't
Xusing the old ansi.sys driver.
X
XUnix users, type "make" and relax.  If you have root privileges, type
X"make install," and relax.  If you're worried, check the default vari-
Xables in the makefile.  Oh, be sure to cp Makefile.dist makefile before
Xtrying to make anything.
X
XThis is a test version!!  In accordance with the author's wishes, I'd
Xlike to make it clear that I've altered all the screen I/O routines,
Xand have removed characters peculiar to VT terminals.  I've tried to
Xkeep intact the author's indentation and brace style.  Changes, where
Xpresent, have been indicated by my initials.
X
XOne more thing: There are lots of yahtzee programs out there, so I had
Xto rename the program.  I've seen yahtzee, yahtzee2, and yaht.  I guess
Xyahtz was all that was left ;-).
X
X-Richard Goerwitz.
SHAR_EOF
true || echo 'restore of README failed'
rm -f _shar_wnt_.tmp
fi
rm -f _shar_seq_.tmp
echo You have unpacked the last part
exit 0
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Wed May 29 08:28:55 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 29 May 91 08:28:55 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA25328; Wed, 29 May 91 08:28:52 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Wed, 29 May
 1991 08:28 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA09522; Wed, 29 May 91
 08:14:21 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Wed, 29 May 1991 08:28 MST
Date: 29 May 91 14:56:34 GMT
From: cis.ohio-state.edu!zaphod.mps.ohio-state.edu!maverick.ksu.ksu.edu!ux1.cso.uiuc.edu!midway!ellis.uchicago.edu![e-mail]
 (Richard L. Goerwitz)
Subject: RE: Holiday TidBit, part 2 of 3
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>,
 <[e-mail]>


---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is yahtz.02 (part 2 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file iolib.icn continued
#
if test ! -r _shar_seq_.tmp; then
    echo 'Please unpack part 1 first!'
    exit 1
fi
(read Scheck
 if test "$Scheck" != 2; then
    echo Please unpack part "$Scheck" next!
    exit 1
 else
    exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
    echo 'x - still skipping iolib.icn'
else
echo 'x - continuing file iolib.icn'
sed 's/^X//' << 'SHAR_EOF' >> 'iolib.icn' &&
X#  suggesting things like letting drive specifications appear in DOS
X#  TERMCAP environment variables, and for finding several bugs (e.g.
X#  the lack of support for %2 and %3 in cm).  Although he is loathe
X#  to accept this credit, I think he deserves it.
X#
X#########################################################################
X#
X#  Contents:
X#
X#  setname(term)
X#    Use only if you wish to initialize itermlib for a terminal
X#  other than what your current environment specifies.  "Term" is the
X#  name of the termcap entry to use.  Normally this initialization is
X#  done automatically, and need not concern the user.
X#
X#  getval(id)
X#    Works something like tgetnum, tgetflag, and tgetstr.  In the
X#  spirit of Icon, all three have been collapsed into one routine.
X#  Integer valued caps are returned as integers, strings as strings,
X#  and flags as records (if a flag is set, then type(flag) will return
X#  "true").  Absence of a given capability is signalled by procedure
X#  failure.
X#
X#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
X#    Analogous to tgoto.  "Cm" is the cursor movement command for
X#  the current terminal, as obtained via getval("cm").  Igoto()
X#  returns a string which, when output via iputs, will cause the
X#  cursor to move to column "destcol" and line "destline."  Column and
X#  line are always calculated using a *one* offset.  This is far more
X#  Iconish than the normal zero offset used by tgoto.  If you want to
X#  go to the first square on your screen, then include in your program
X#  "iputs(igoto(getval("cm"),1,1))."
X#
X#  iputs(cp,affcnt)
X#    Equivalent to tputs.  "Cp" is a string obtained via getval(),
X#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
X#  count of affected lines.  It is completely irrelevant for most
X#  modern terminals, and is supplied here merely for the sake of
X#  backward compatibility with itlib, a UNIX-only version of these
X#  routines (one which handles padding on archaic terminals).
X#
X##########################################################################
X#
X#  Notes for MS-DOS users:
X#
X#    There are two basic reasons for using the I/O routines
X#  contained in this package.  First, by using a set of generalized
X#  routines, your code will become much more readable.  Secondly, by
X#  using a high level interface, you can avoid the cardinal
X#  programming error of hard coding things like screen length and
X#  escape codes into your programs.
X#
X#    To use this collection of programs, you must do two things.
X#  First, you must add the line "device=ansi.sys" (or the name of some
X#  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
X#  nansi.sys]) to your config.sys file.  Secondly, you must add two
X#  lines to your autoexec.bat file: 1) "set TERM=ansi-mono" and 2)
X#  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
X#  variable is to tell this program what driver you are using.  If you
X#  have a color system, you could use "ansi-color" instead of
X#  "ansi-mono," although for compatibility with a broader range of
X#  users, it would perhaps be better to stick with mono.  The purpose
X#  of setting TERMCAP is to make it possible to determine where the
X#  termcap database file is located.  The termcap file (which should
X#  have been packed with this library as termcap.dos) is a short
X#  database of all the escape sequences used by the various terminal
X#  drivers.  Set TERMCAP so that it reflects the location of this file
X#  (which should be renamed as termcap, for the sake of consistency
X#  across UNIX and MS-DOS spectra).  If desired, you can also try
X#  using termcap2.dos.  Certain games work a lot better using this
X#  alternate file.  To try it out, rename it to termcap, and set
X#  the environment variable TERMCAP to its location.
X#
X#    Although the authors make no pretense of providing here a
X#  complete introduction to the format of the termcap database file,
X#  it will be useful, we believe, to explain a few basic facts about
X#  how to use this program in conjunction with it.  If, say, you want
X#  to clear the screen, add the line,
X#
X#    iputs(getval("cl"))
X#
X#  to your program.  The function iputs() outputs screen control
X#  sequences.  Getval retrieves a specific sequence from the termcap
X#  file.  The string "cl" is the symbol used in the termcap file to
X#  mark the code used to clear the screen.  By executing the
X#  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
X#  (clear) code in the termcap database entry for your terminal, and
X#  the 2) outputting that sequence to the screen.
X#
X#    Some other useful termcap symbols are "ce" (clear to end of
X#  line), "ho" (go to the top left square on the screen), "so" (begin
X#  standout mode), and "se" (end standout mode).  To output a
X#  boldfaced string, str, to the screen, you would write -
X#
X#    iputs(getval("so"))
X#    writes(str)
X#    iputs(getval("se"))
X#
X#  You can also write "writes(getval("so") || str || getval("se")),
X#  but this would make reimplementation for UNIX terminals that
X#  require padding rather difficult.
X#
X#    It is also heartily to be recommended that MS-DOS programmers
X#  try not to assume that everyone will be using a 25-line screen.
X#  Most terminals are 24-line.  Some 43.  Some have variable window
X#  sizes.  If you want to put a status line on, say, the 2nd-to-last
X#  line of the screen, then determine what that line is by executing
X#  "getval("li")."  The termcap database holds not only string-valued
X#  sequences, but numeric ones as well.  The value of "li" tells you
X#  how many lines the terminal has (compare "co," which will tell you
X#  how many columns).  To go to the beginning of the second-to-last
X#  line on the screen, type in:
X#
X#    iputs(igoto(getval("cm"), 1, getval("li")-1))
X#
X#  The "cm" capability is a special capability, and needs to be output
X#  via igoto(cm,x,y), where cm is the sequence telling your computer
X#  to move the cursor to a specified spot, x is the column, and y is
X#  the row.  The expression "getval("li")-1" will return the number of
X#  the second-to-last line on your screen.
X#
X##########################################################################
X#
X#  Requires: UNIX or MS-DOS, co-expressions
X#
X#  See also: itlib.icn, iscreen.icn
X#
X##########################################################################
X
X
Xglobal tc_table, isDOS
Xrecord true()
X
X
Xprocedure check_features()
X
X    initial {
X
X    if find("UNIX",&features) then
X        isDOS := &null
X    else if find("MS-DOS", &features) then
X        isDOS := 1
X    else stop("check_features:  OS not (yet?) supported.")
X
X    find("expressi",&features) |
X        er("check_features","co-expressions not implemented - &$#!",1)
X    }
X
X    return
X
Xend
X
X
X
Xprocedure setname(name)
X
X    # Sets current terminal type to "name" and builds a new termcap
X    # capability database (residing in tc_table).  Fails if unable to
X    # find a termcap entry for terminal type "name."  If you want it
X    # to terminate with an error message under these circumstances,
X    # comment out "| fail" below, and uncomment the er() line.
X
X    #tc_table is global
X
X    check_features()
X
X    tc_table := table()
X    tc_table := maketc_table(getentry(name)) | fail
X    # er("setname","no termcap entry found for "||name,3)
X    return "successfully reset for terminal " || name
X
Xend
X
X
X
Xprocedure getname()
X
X    # Getname() first checks to be sure we're running under DOS or
X    # UNIX, and, if so, tries to figure out what the current terminal
X    # type is, checking successively the value of the environment
X    # variable TERM, and then (under UNIX) the output of "tset -".
X    # Terminates with an error message if the terminal type cannot be
X    # ascertained.  DOS defaults to "mono."
X
X    local term, tset_output
X
X    check_features()
X
X    if \isDOS then {
X        term := getenv("TERM") | "mono"
X    }
X    else {
X    if not (term := getenv("TERM")) then {
X        tset_output := open("/bin/tset -","pr") |
X        er("getname","can't find tset command",1)
X        term := !tset_output
X        close(tset_output)
X    }
X    }
X
X    return \term |
X    er("getname","can't seem to determine your terminal type",1)
X
Xend
X
X
X
Xprocedure er(func,msg,errnum)
X
X    # short error processing utility
X    write(&errout,func,":  ",msg)
X    exit(errnum)
X
Xend
X
X
X
Xprocedure getentry(name, termcap_string)
X
X    # "Name" designates the current terminal type.  Getentry() scans
X    # the current environment for the variable TERMCAP.  If the
X    # TERMCAP string represents a termcap entry for a terminal of type
X    # "name," then getentry() returns the TERMCAP string.  Otherwise,
X    # getentry() will check to see if TERMCAP is a file name.  If so,
X    # getentry() will scan that file for an entry corresponding to
X    # "name."  If the TERMCAP string does not designate a filename,
X    # getentry() will scan the termcap file for the correct entry.
X    # Whatever the input file, if an entry for terminal "name" is
X    # found, getentry() returns that entry.  Otherwise, getentry()
X    # fails.
X
X    local isFILE, f, getline, line, nm, ent1, ent2
X    static slash, termcap_names
X    initial {
X    if \isDOS then {
X        slash := "\\"
X        termcap_names := ["termcap","termcap.dos","termcap2.dos"]
X    }
X    else {
X        slash := "/"
X        termcap_names := ["/etc/termcap"]
X    }
X    }
X
X
X    # You can force getentry() to use a specific termcap file by cal-
X    # ling it with a second argument - the name of the termcap file
X    # to use instead of the regular one, or the one specified in the
X    # termcap environment variable.
X    /termcap_string := getenv("TERMCAP")
X
X    if \isDOS then {
X    if \termcap_string then {
X        if termcap_string ? (
X         not ((tab(any(&letters)), match(":")) | match(slash)),
X         pos(1) | tab(find("|")+1), =name)
X        then return termcap_string
X        else isFILE := 1
X    }
X    }
X    else {
X    if \termcap_string then {
X        if termcap_string ? (
X            not match(slash), pos(1) | tab(find("|")+1), =name)
X        then return termcap_string
X        else isFILE := 1
X    }
X    }
X
X    # The logic here probably isn't clear.  The idea is to try to use
X    # the termcap environment variable successively as 1) a termcap en-
X    # try and then 2) as a termcap file.  If neither works, 3) go to
X    # the /etc/termcap file.  The else clause here does 2 and, if ne-
X    # cessary, 3.  The "\termcap_string ? (not match..." expression
X    # handles 1.
X
X    if \isFILE            # if find(slash, \termcap_string)
X    then f := open(termcap_string)
X    /f := open(!termcap_names) |
X    er("getentry","I can't access your termcap file.  Read iolib.icn.",1)
X
X    getline := create read_file(f)
X
X    while line := @getline do {
X    if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
X        entry := ""
X        while (\line | @getline) ? {
X        if entry ||:= 1(tab(find(":")+1), pos(0))
X        then {
X            close(f)
X            # if entry ends in tc= then add in the named tc entry
X            entry ?:= tab(find("tc=")) ||
X            # recursively fetch the new termcap entry
X            (move(3), getentry(tab(find(":"))) ?
X             # remove the name field from the new entry
X             (tab(find(":")+1), tab(0)))
X            return entry
X        }
X        else {
X            \line := &null # must precede the next line
X            entry ||:= trim(trim(tab(0),'\\'),':')
X        }
X        }
X    }
X    }
X
X    close(f)
X    er("getentry","can't find and/or process your termcap entry",3)
X
Xend
X
X
X
Xprocedure read_file(f)
X
X    # Suspends all non #-initial lines in the file f.
X    # Removes leading tabs and spaces from lines before suspending
X    # them.
X
X    local line
X
X    \f | er("read_tcap_file","no valid termcap file found",3)
X    while line := read(f) do {
X    match("#",line) & next
X    line ?:= (tab(many('\t ')) | &null, tab(0))
X    suspend line
X    }
X
X    fail
X
Xend
X
X
X
Xprocedure maketc_table(entry)
X
X    # Maketc_table(s) (where s is a valid termcap entry for some
X    # terminal-type): Returns a table in which the keys are termcap
X    # capability designators, and the values are the entries in
X    # "entry" for those designators.
X
X    local k, v
X
X    /entry & er("maketc_table","no entry given",8)
X    if entry[-1] ~== ":" then entry ||:= ":"
X
X    /tc_table := table()
X
X    entry ? {
X
X    tab(find(":")+1)    # tab past initial (name) field
X
X    while tab((find(":")+1) \ 1) ? {
X        &subject == "" & next
X        if k := 1(move(2), ="=") then {
X        # Get rid of null padding information.  Iolib can't
X        # handle it (unlike itlib.icn).  Leave star in.  It
X        # indicates a real dinosaur terminal, and will later
X        # prompt an abort.
X        str := ="*" | ""; tab(many(&digits))
X        tc_table[k] := Decode(str || tab(find(":")))
X        }
X        else if k := 1(move(2), ="#")
X        then tc_table[k] := integer(tab(find(":")))
X        else if k := 1(tab(find(":")), pos(-1))
X        then tc_table[k] := true()
X        else er("maketc_table", "your termcap file has a bad entry",3)
X    }
X    }
X
X    return tc_table
X
Xend
X
X
X
Xprocedure getval(id)
X
X    /tc_table := maketc_table(getentry(getname())) |
X    er("getval","can't make a table for your terminal",4)
X
X    return \tc_table[id] | fail
X    # er("getval","the current terminal doesn't support "||id,7)
X
Xend
X
X
X
Xprocedure Decode(s)
X
X    # Does things like turn ^ plus a letter into a genuine control
X    # character.
X
X    new_s := ""
X
X    s ? {
X
X    while new_s ||:= tab(upto('\\^')) do {
X        chr := move(1)
X        if chr == "\\" then {
X        new_s ||:= {
X            case chr2 := move(1) of {
X            "\\" : "\\"
X            "^"  : "^"
X            "E"  : "\e"
X            "b"  : "\b"
X            "f"  : "\f"
X            "n"  : "\n"
X            "r"  : "\r"
X            "t"  : "\t"
X            default : {
X                if any(&digits,chr2) then {
X                char(integer("8r"||chr2||move(2 to 0 by -1))) |
X                    er("Decode","bad termcap entry",3)
X                }
X               else chr2
X            }
X            }
X        }
X        }
X        else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
X    }
X    new_s ||:= tab(0)
X    }
X
X    return new_s
X
Xend
X
X
X
Xprocedure igoto(cm,col,line)
X
X    local colline, range, increment, padding, str, outstr, chr, x, y
X
X    if col > (tc_table["co"]) | line > (tc_table["li"]) then {
X    colline := string(\col) || "," || string(\line) | string(\col|line)
X    range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
X    er("igoto",colline || " out of range " || (\range|""),9)
X    }
X
X    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
X    increment := -1
X    outstr := ""
X
X    cm ? {
X    while outstr ||:= tab(find("%")) do {
X        tab(match("%"))
X        if padding := integer(tab(any('23')))
X        then chr := (="d" | "d")
X        else chr := move(1)
X        if case \chr of {
X        "." :  outstr ||:= char(line + increment)
X        "+" :  outstr ||:= char(line + ord(move(1)) + increment)
X        "d" :  {
X            str := string(line + increment)
X            outstr ||:= right(str, \padding, "0") | str
X        }
X        }
X        then line :=: col
X        else {
X        case chr of {
X            "n" :  line := ixor(line,96) & col := ixor(col,96)
X            "i" :  increment := 0
X            "r" :  line :=: col
X            "%" :  outstr ||:= "%"
X            "B" :  line := ior(ishift(line / 10, 4), line % 10)
X            ">" :  {
X            x := move(1); y := move(1)
X            line > ord(x) & line +:= ord(y)
X            &null
X            }
X        } | er("goto","bad termcap entry",5)
X        }
X    }
X    return outstr || tab(0)
X    }
X
Xend
X
X
X
Xprocedure iputs(cp, affcnt)
X
X    # Writes cp to the screen.  Use this instead of writes() for
X    # compatibility with itlib (a UNIX-only version which can handle
X    # albeit inelegantly) terminals that need padding.
X
X    static num_chars
X    initial num_chars := &digits ++ '.'
X
X    type(cp) == "string" |
X    er("iputs","you can't iputs() a non-string value!",10)
X
X    cp ? {
X    if tab(many(num_chars)) & ="*" then
X        stop("iputs:  iolib can't use terminals that require padding.")
X    writes(tab(0))
X    }
X
X    return
X
Xend
SHAR_EOF
echo 'File iolib.icn is complete' &&
true || echo 'restore of iolib.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= termcap.dos ==============
if test -f 'termcap.dos' -a X"$1" != X"-c"; then
    echo 'x - skipping termcap.dos (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting termcap.dos (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'termcap.dos' &&
Xansi|color|ansi-color|ibm|ibmpc|ANSI.SYS color:\
X    :co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
X    :cl=\E[H\E[2J:ce=\E[K:\
X    :ho=\E[H:cm=\E[%i%d;%dH:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :ti=\E[0;44m:te=\E[0m:\
X    :so=\E[1;35;44m:se=\E[0;44m:\
X    :us=\E[1;31;44m:ue=\E[0;44m:\
X    :mb=\E[5m:md=\E[1m:me=\E[0;44m:
Xmono|ansi-mono|ANSI.SYS:\
X    :co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
X    :cl=\E[H\E[2J:ce=\E[K:\
X    :ho=\E[H:cm=\E[%i%d;%dH:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :so=\E[7m:se=\E[m:us=\E[4m:ue=\E[m:\
X    :mb=\E[5m:md=\E[1m:me=\E[m:
Xnnansi-mono|NNANSI.SYS:\
X    :co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
X    :cl=\E[2J:cd=\E[J:ce=\E[K:\
X    :ho=\E[H:cm=\E[%i%d;%dH:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :so=\E[7m:se=\E[2m:\
X    :us=\E[4m:ue=\E[24m:\
X    :mb=\E[5m:md=\E[1m:mh=\E[2m:mr=\E[7m:me=\E[m:\
X    :al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
Xnnansi|nnansi-color|NNANSI.SYS color:\
X    :co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
X    :cl=\E[2J:cd=\E[J:ce=\E[K:\
X    :ho=\E[H:cm=\E[%i%d;%dH:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :ti=\E[0;44m:te=\E[0m:\
X    :so=\E[1;35;44m:se=\E[2;37m:\
X    :us=\E[4m:ue=\E[24m:\
X    :mb=\E[5m:md=\E[1m:mh=\E[2m:mr=\E[7m:me=\E[0;44m:\
X    :al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
Xnansi-mono|zansi-mono|N/ZANSI.SYS:\
X    :co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
X    :cl=\E[2J:ce=\E[K:\
X    :ho=\E[H:cm=\E[%i%d;%dH:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :ti=\E[0m:te=\E[0m:\
X    :so=\E[7;35m:se=\E[0m:\
X    :us=\E[1;31m:ue=\E[0m:\
X    :mb=\E[5m:md=\E[1m:mr=\E[7m:me=\E[m:\
X    :al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
Xnansi|zansi|nansi-color|zansi-color|N/ZANSI.SYS color:\
X    :co#80:li#25:bs:pt:bl=^G:le=^H:do=^J:\
X    :cl=\E[2J:ce=\E[K:\
X    :ho=\E[H:cm=\E[%i%d;%dH:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :ti=\E[0;44m:te=\E[0m:\
X    :so=\E[1;35;44m:se=\E[0;44m:\
X    :us=\E[1;31;44m:ue=\E[0;44m:\
X    :mb=\E[5m:md=\E[1m:mr=\E[7m:me=\E[0;44m:\
X    :al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:
XAX|ANSI X3.64|full ANSI X3.64 (1977) standard:\
X    :co#80:li#25:bs:pt:am:mi:bl=^G:le=^H:\
X    :cl=\E[2J:ce=\E[K:cd=\E[J:\
X    :ho=\E[H:cm=\E[%i%d;%dH:cs=\E[%i%d;%dr:\
X    :up=\E[A:do=\E[B:le=\E[C:ri=\E[D:nd=\E[C:\
X    :UP=\E[%dA:DO=\E[%dB:LE=\E[%dC:RI=\E[%dD:\
X    :so=\E[7m:se=\E[m:us=\E[4m:ue=\E[m:\
X    :mb=\E[5m:md=\E[1m:mr=\E[7m:me=\E[m:as=^N:ae=^O:\
X    :ku=\E[A:kd=\E[B:kl=\E[C:kr=\E[D:kb=^H:\
X    :kn#4:k1=\EOP:k2=\EOQ:k3=\EOR:k4=\EOS:\
X    :im=\E[4h:ei=\E[4l:al=\E[L:dl=\E[M:ic=\E[@:dc=\E[P:sf=\ED:sr=\EM:
SHAR_EOF
true || echo 'restore of termcap.dos failed'
rm -f _shar_wnt_.tmp
fi
# ============= Makefile.dist ==============
if test -f 'Makefile.dist' -a X"$1" != X"-c"; then
    echo 'x - skipping Makefile.dist (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting Makefile.dist (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile.dist' &&
X# Don't change this unless you're sure of what you're doing.
SHAR_EOF
true || echo 'restore of Makefile.dist failed'
fi
echo 'End of  part 2'
echo 'File Makefile.dist is continued in part 3'
echo 3 > _shar_seq_.tmp
exit 0
--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Thu May 30 20:12:40 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 30 May 91 20:12:40 MST
Received: from gargoyle.uchicago.edu by optima.cs.arizona.edu (4.1/15)
    id AA19642; Thu, 30 May 91 20:12:33 MST
Received: by gargoyle.uchicago.edu from sophist (sophist.uchicago.edu) (4.0/1.14)
    id AA03009; Thu, 30 May 91 22:12:31 CDT
Return-Path: <[e-mail]>
Received:  by sophist (4.1/UofC3.1X)
    id AA03062; Thu, 30 May 91 22:13:41 CDT
Date: Thu, 30 May 91 22:13:41 CDT
From: Richard Goerwitz <[e-mail]>
Message-Id: <9105310313.AA03062@sophist>
To: [e-mail]
Subject: utilities

I've got a fairly large library of utilities for things like rewrapping
text, excizing sentences from ASCII files, comma-izing ints and reals,
outputting non-byte-width int/chars, stripping chars from strings, an
extended snapshot routine, and other stuff.  I've posted bits here and
there, but I'd like to disseminate this material more widely, and in a
more complete form.  I'm interested in helping anyone out who thinks
he or she might be helped by them.  I'm really interested (deep down),
though, in rooting up bugs.

If anyone wants these routines, please drop me a line.  Promise me you
will let me know about any changes that you make or about any bugs you
find.

-Richard ([e-mail])

From [e-mail]  Fri May 31 04:21:37 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 31 May 91 04:21:37 MST
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA09625; Fri, 31 May 91 04:21:29 MST
Received: from UKACRL.BITNET (MAILER@UKACRL) by Arizona.edu with PMDF#10282;
 Fri, 31 May 1991 04:21 MST
Received: from RL.IB by UKACRL.BITNET (Mailer R2.07) with BSMTP id 2445; Fri,
 31 May 91 11:22:45 BST
Received: from RL.IB by UK.AC.RL.IB (Mailer R2.07) with BSMTP id 0929; Fri, 31
 May 91 11:22:45 BST
Date: 31 May 91  11:23:12 bst
From: [e-mail]
Subject: Records
To: [e-mail]
Message-Id: <31 May 91  11:23:12 bst  060024@EMAS-A>
X-Envelope-To: [e-mail]
Via:        UK.AC.ED.EMAS-A; 31 MAY 91 11:22:43 BST

Thanks to all those who answered my query about records.

Next question - I am using records as the basis for a simple database
program. Given that the program will be written in a tight enough way to
ensure that it won't be possible to write a list with more elements than
there are in a database entry, what is the advantage of using a record
to store a database entry as opposed to a list?

I've got my own ideas on this, but I'd like to canvass a few other
opinions.


Thanks.

Roger Hare.

From [e-mail]  Fri May 31 06:13:47 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 31 May 91 06:13:47 MST
Received: from timbuk (timbuk.cray.com) by optima.cs.arizona.edu (4.1/15)
    id AA11503; Fri, 31 May 91 06:13:44 MST
Received: from cherry04.cray.com by timbuk (4.1/CRI-MX 1.6e)
    id AA13694; Fri, 31 May 91 08:13:40 CDT
Received: by cherry04.cray.com
    id AA03855; 4.1/CRI-5.6; Fri, 31 May 91 08:13:31 CDT
Date: Fri, 31 May 91 08:13:31 CDT
From: [e-mail] (David S. Cargo)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: Records

I use records instead of lists in cases where I want a more
mnemonic way of accessing structures.  In a program I'm working
on right now, I can tell what structures are compatible because
I have named the fields the same names in the same order.  It
would not be possible to decide that so easily if the lists were
simply the same size.

Likewise, the fact that records are their own types allows me to
base actions based on the type of a particular parameter.  I have
exploited these factors together in the following fragment of code.
Because the name of the record type is also the name of the record
constructor for that type, the following routine returns a value
whose type is the same as the type passed to it without knowing
what that type is.  As long as the type is a record with at least
one field named entries, this fragment will work.

## entry_name -- return the entry portion of an absolute path
procedure entry_name(a_path)
#   Uses globals
#       verified   (record constructor)
#       unverified (record constructor)
#   record verified(entries)
#   record unverified(entries)
    if *a_path.entries > 1
    then return type(a_path)(a_path.entries[-1])
end

A lot of the code I write takes advantage of the type information
carried along by record values.

David S. Cargo ([e-mail])

From [e-mail]  Fri May 31 06:55:19 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 31 May 91 06:55:19 MST
Received: from MIS1.MIS.MCW.EDU by optima.cs.arizona.edu (4.1/15)
    id AA12408; Fri, 31 May 91 06:55:12 MST
Received: from mis.mcw.edu (MCWMI3) by MIS1.MIS.MCW.EDU with PMDF#10477; Fri,
 31 May 1991 08:53 CST
Date: Fri, 31 May 1991 08:52 CST
From: Chris Tenaglia - 257-8765 <[e-mail]>
Subject: Re: database
To: [e-mail]
Message-Id: <[e-mail]>
X-Organization: Medical College of Wisconsin MIS Department (Milwaukee, WI)
X-Vms-To: IN%"[e-mail]"

Regarding:    Records

> Thanks to all those who answered my query about records.

> Next question - I am using records as the basis for a simple database
> program. Given that the program will be written in a tight enough way to
> ensure that it won't be possible to write a list with more elements than
> there are in a database entry, what is the advantage of using a record
> to store a database entry as opposed to a list?
> I've got my own ideas on this, but I'd like to canvass a few other
> opinions.
> Thanks.
> Roger Hare.

Perhaps I don't understand the true use of records, or the true meaning of
database. I wrote a useful little database. I call it 'AtterCop'. It's
nomenclature and early evolution is too bizaare for this message. In it's
first ICON manifestation it used lists. Lists worked well. If you wanted
the data sorted, I had a menu entry that would ask for which fields. It
was slow especially on inquiry serially scanning through the list elements.
Deletion was slower. I moved all the elements back one to cover up the
unwanted record and popped off the last element (duplicate). It permitted
multiple occurences of the key, and printed pretty fast.

Records? I always thought of records as ICONs method for creating user
defined datatypes. I once thought it was a database component, but after
a few experiments, it's true purpose became clear.

Tables? After a database contains 1000 or so items, lists become very slow.
So I rewrote 'AtterCop' using icon tables instead. The database key is a
concatenated string from the key fields, is the index to the table. The
entire record (string with fields delimited including the key ones) is a
list element to that table entry. Thus the database is actually a table of
lists. This still allows multiple occurences to a key, and lookup, and
maintenance functions are handled quite speedily. Also, no explicit sort
is needed. Sorting is done optionally at print or view time. Speed of loading,
saving, printing seems to take a little longer though. See example.

Writing out the database as a list     Writing it as a table of lists
    out := open(database,"w")              out := open(database,"w")
    every write(out,!db)                   every lookup := key(db) do
                                             every write(out,!db[lookup])
    close(out)

Chris Tenaglia (System Manager) | Medical College of Wisconsin
8701 W. Watertown Plank Rd.     | Milwaukee, WI 53226
[phone]                   | [e-mail], mcwmis!tenaglia

From [e-mail]  Fri May 31 07:38:41 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 31 May 91 07:38:41 MST
Message-Id: <[e-mail]>
Received: from REGULUS.BBN.COM by optima.cs.arizona.edu (4.1/15)
    id AA13650; Fri, 31 May 91 07:38:37 MST
To: [e-mail]
Subject: GNU Emacs utility for short on-line summary of Icon syntax
From: Sean Boisen <[e-mail]>
Sender: [e-mail]
Reply-To: [e-mail]
Date: Fri, 31 May 91 10:28:15 EDT

Appended below (in shar format) is a simple GNU Emacs utility that
lets you check the syntax of Icon expressions: for example, while
editing a program, i may forget the arguments to "any". I can then
call the Emacs function describe-icon-symbol, which displays

    any(cset,string,i,j)

Much easier than reaching for the manual!

Richard Goerwitz encouraged me to post it here: no guarantees, but
enjoy. I'd be particularly interested if somebody has more complete
descriptions (mine are only a single line, not always enough to keep
me from reaching for the manual).

........................................
Sean Boisen -- [e-mail]
BBN Systems and Technologies, Cambridge MA


------------------------------ snip snip ------------------------------
#! /bin/sh
# To extract, remove mail header lines and type "sh filename"
echo x - icon-describe.text
sed -e 's/^X//' > icon-describe.text << '!FaR!OuT!'
XThis is a quick syntax helper for Icon users that work with GNU Emacs.
XThe idea is a simple one: while creating a program, say, you're unsure
Xabout the arguments or their orders for push(). With icon-describe, you
Xsimple execute the function "describe-icon-symbol" with point
Xsomewhere around the word push, and the following information
Xis displayed in the mini-buffer:
X
Xpush(list,x)
X
XThis works with procedures, infix/prefix operators, control
Xstructures/reserved words, and keywords. Note that you get notified if
Xsomething isn't in the documentation file, so you can also use it to
Xcheck whether you've got the right symbol name or not (but you'd have
Xto actually go look at the file to see what the _right_ one is).
X
X
XCaveats:
X
XSee your Emacs manual for how to load this automatically when you
Xvisit .icn files (look at auto-mode-alist and icon-mode-hook, assuming
Xyou're using an icon-mode).
X
Xdescribe-icon-symbol is not initially bound to a key, but you'll
Xprobably want to do so.
X
XThe format of the documentation file is one to a line: this is nice
Xbecause it can be displayed in the minibuffer instead of a pop-up
Xwhich then has to be gotten rid of. It's not so nice in that it limits
Xthe amount of information pretty severely. If somebody wants to
Xprovide a larger documentation file i might provide a pop-up version
X(or some hybrid): i'm too lazy to do all the typing, for one thing!
XThere's also an uneven mix of bare syntax description with some
Xdiscussion of what (especially prefix) operators do. A few keywords
Xhave no description because they're newer than the Icon book, and i
Xdidn't have a description handy. Please contribute to this doc file if
Xyou can!
X
XThe function which determines the symbol at point isn't perfect
X(surprise surprise!). In particular it depends on the syntax tables to
Xdetermine what punctuation is, so if your syntax tables aren't right,
Xthis won't be either. I'm open to suggestions for better algorithms.
XThe current version has a preference for looking backward if not
Xactually on part of a symbol: this seemed more useful for those cases
Xwhere you become hesitant about the arguments to a function just after
Xtyping it.
X
XWhile the usual lack of warranty and support applies, i'd still like
Xto hear if there are problems with this.
X
XSean Boisen
XBBN Systems and Technologies Corporation
X
X
XTwo files follow: i call the first icon-describe.el (don't forget to
Xbyte-compile it!), and the second icondoc.txt. Whatever you decide to
Xcall the latter, make sure you set the variable icon-doc-file accordingly!
!FaR!OuT!
echo x - icon-describe.el
sed -e 's/^X//' > icon-describe.el << '!FaR!OuT!'
X;;; Icon syntax describer: by Sean Boisen, BBN Systems and
X;;; Technologies Corporation, [e-mail]. Standard lack of
X;;; warranty applies: may be freely distributed subject to the
X;;; restrictions of the GNU Emacs copyright. Please send me any bug
X;;; fixes and/or improvements!
X;;;
X;;; This still has at least the following known deficiences:
X;;;
X;;; The descriptive text file lacks descriptions for the newer
X;;; keywords. Please add them and send me a version if you can!
X;;;
X;;; It might be nice if icon-symbol-at-point did escape sequences as
X;;; well: it doesn't.
X;;;
X;;; Someday it might be more useful to provide more than one line of
X;;; information, especially for procedures: the main hurdle here is
X;;; that i'm too lazy to type all the text in.
X
X;;; additions:
X;;;
X;;; sboisen 2/23/89: i noticed that &pos gets
X;;; picked up as pos. Hacked describe-icon-symbol for this as a
X;;; special case. Still imperfect if point in just past the colon in
X;;; 0:&pos however...
X;;;
X;;; sboisen 2/23/89: symbols which contain characters with special
X;;; meanings in regexps don't get handled properly! not yet fixed...
X
X(require 'icon-mode)
X
X(provide 'icon-describe)
X
X(defvar icon-doc-file "/d4m/sboisen/emacs/icondoc.txt"
X  "Where the documentation file can be found.")
X
X;; a helper function: get a string containing all the characters matching
X;; some spec in a syntax table. Class is an atom. Useful in conjunction with
X;; skip-chars-forward. Doesn't do the eighth bit.
X
X(defun get-chars-in-class (class syntax-table)
X  (let ((classcode
X      (cond
X        ((eq class 'whitespace) 0)
X        ((eq class 'punctuation) 1)
X        ((eq class 'word) 2)
X        ((eq class 'symbol) 3)
X        ((eq class 'open) 4)    ;this doesn't work!
X        ((eq class 'close) 5)
X        ((eq class 'prefix) 6)
X        ((eq class 'stringquote) 7)
X        ((eq class 'charquote) 9)
X        ((eq class 'startcomment) 11)
X        ((eq class 'endcomment) 12)
X        ))
X    (index 0)
X    (str ""))
X    (while (< index 128)
X      (if (eql (aref syntax-table index) classcode)
X      (setq str (concat str (char-to-string index))))
X      (setq index (1+ index)))
X    str))
X
X(defvar wordchars "a-zA-Z0-9_")
X(defvar junkchars (concat " \n\t\r" "({[)}]"))
X(defvar punct (get-chars-in-class 'punctuation icon-mode-syntax-table))
X
X(defun icon-symbol-at-point ()
X  "Get the closest Icon symbol to point, but don't change your
X       position. Has a preference for looking backward when not
X       directly on a symbol."
X  (let (start end symbol)
X    (save-excursion
X      ;; first see if you're just past a symbol
X      (if (looking-at "\\s-\\|\\s(\\|\\s)\\|\\s>")
X      (skip-chars-backward junkchars)
X    ;; else move forward one character, presumably either a \w or
X    ;; a symbol: but not if at the end of the buffer
X    (or (= (point) (point-max))
X        (forward-char 1)))
X
X      (cond
X    ;; special case for (potential) keywords: just past a &
X    ((eql (preceding-char) 38)
X     (setq start (1- (point)))
X     (cond
X       ((looking-at "\\w")
X        (skip-chars-forward wordchars))
X       ((looking-at "\\s.")
X        (skip-chars-forward punct))
X       ;; else whitespace?
X       ))
X    ;; just past a \\w
X    ((eql (aref icon-mode-syntax-table (preceding-char)) 2)
X     (skip-chars-backward wordchars)
X     ;; worry about being in the middle of a keyword
X     (if (eql (preceding-char) 38)
X         (setq start (1- (point)))
X       (setq start (point)))
X     (skip-chars-forward wordchars))
X    ;; else a symbol?
X    (t
X      (skip-chars-backward punct)
X      (setq start (point))
X      (skip-chars-forward punct)))
X      ;; THE OLD WAY THAT LOOKED FORWARD INSTEAD OF BACKWARD
X;;      ;; skip past whitespace and parens
X;;      (while (looking-at "\\s-\\|\\s(\\|\\s)\\|\\s>")
X;;    (skip-chars-forward junkchars))
X;;      (if (looking-at "\\w")
X;;      (progn
X;;        (skip-chars-forward wordchars)
X;;        (setq start (point))
X;;        (skip-chars-backward wordchars))
X;;    ;; else a symbol?
X;;    (progn
X;;        (skip-chars-forward punct)
X;;        (setq start (point))
X;;        (skip-chars-backward punct)))
X      (buffer-substring start (point)))))
X
X(defun describe-icon-symbol (symbol)
X  "Display the documentation of SYMBOL, an Icon operator."
X  (interactive
X    (let ((fn (icon-symbol-at-point))
X      (enable-recursive-minibuffers t)
X      (case-fold-search nil)    ;require that case match for search
X      val args-file regexp)
X      (setq val (read-from-minibuffer
X          (if fn
X              (format "Symbol (default %s): " fn)
X            "Symbol: ")))
X      (if (string= val "")
X      (setq val fn))
X      ;; this may not work for characters which are special to regexp
X      ;; (like ".")
X      (setq regexp (concat "^" val "[ \t(]"))
X      (if (not (get-file-buffer icon-doc-file))
X      (progn
X        (setq args-file
X          (find-file-noselect icon-doc-file))
X        (set-buffer args-file)
X        (rename-buffer "*ICON-DOC*")))
X      (set-buffer (get-file-buffer icon-doc-file))
X      (goto-char (point-min))
X      (list (if (re-search-forward regexp (point-max) t)
X      (save-excursion
X        (beginning-of-line 1)
X        (let ((lnstart (point)))
X          (end-of-line)
X          (message (buffer-substring lnstart (point)))))
X    (error (format "No definition for %s" val)))))))
!FaR!OuT!
echo x - icondoc.txt
sed -e 's/^X//' > icondoc.txt << '!FaR!OuT!'
XFORMAT: a regexp like "^word(args)" of "^word[\t ]descriptive_text
Xabs(numeric)
Xany(cset,string,i,j)
Xbal(cset1,cset2,cset3,string,i,j)
Xcenter(string1,i,string2)
Xchar(i)
Xclose(file)
Xcollect()
Xcopy(x)
Xcset(x)
Xdelete(x1,x2)
Xdetab(string,i1,i2,...,in)
Xdisplay(i,file)
Xentab(string,i1,i2,...,in)
Xerrorclear()
Xexit(i)
Xfind(string1,string2,i,j)
Xget(list)
Xgetenv(string)
Xiand(i,j)
Xicom(i)
Ximage(x)
Xinsert(x1,x2,x3)
Xinteger(x)
Xior(i,j)
Xixor(i,h)
Xishift(i,j)
Xleft(string1,i,string2)
Xlist(i,x)
Xmany(cset,string,i,j)
Xmap(string1,string2,string3)
Xmatch(string1,string2,i,j)
Xmember(x1,x2)
Xmove(i)
Xnumeric(x)
Xopen(string1,string2)
Xord(string)
Xpop(list)
Xpos(i)
Xproc(x)
Xpull(list)
Xpush(list,x)
Xput(list,x)
Xread(file)
Xreads(file,i)
Xreal(x)
Xremove(string)
Xrename(string1,string2)
Xrepl(string,i)
Xreverse(string)
Xright(string1,i,string2)
Xrunerr(i,x)
Xsave(string)
Xseek(file,i)
Xseq(i,j)
Xset(list)
Xsort(list)
Xsort(table,i)
Xstop(x1,x2,...,xn)
Xstring(x)
Xsystem(string)
Xtab(i)
Xtable(x)
Xtrim(string,cset)
Xtype(x)
Xupto(cset,string,i,j)
Xwhere(file)
Xwrite(x1,x2,...,xn)
Xwrites(x1,x2,...,xn)
XCONTROL STRUCTURES/RESERVED WORDS
Xbreak expr
Xby    i to j by k
Xcase expr of {...}
Xcreate x
Xdefault : expr
Xdo    every expr1 do expr2; until expr1 do expr2; while expr1 do expr2
Xdynamic identifiers
Xelse    if expr1 then expr2 else expr3
Xend
Xevery expr1 do expr2
Xfail
Xglobal identifiers
Xif expr1 then expr2 else expr3
Xinitial expr
Xlink file1,file2,...filen
Xlocal identifiers
Xnext
Xnot expr
Xof    case expr of {...}
Xprocedure identifier(identifiers)
Xrecord identifiers(fields)
Xrepeat expr
Xreturn expr
Xstatic identifiers
Xsuspend expr
Xthen    if expr1 then expr2 else expr3
Xto    i to j by k
Xuntil expr1 do expr2
Xwhile expr1 do expr2
X|    expr1 | expr2; |expr
X\    expr \ i ; \x produces x if x is not null, otherwise fails
X?:=    s ?:= x
X?    s ? x; ?x produces a random element of x, failing if x is empty
XINFIX OPERATIONS
X+    n + m produces the sum of n and m; +n produces the numeric value of n
X-    n - m produces the difference of n and m; -n produces the negative of n
X*    n * m produces the product of n and m; *x produces the size of x
X/      n / m produces n divided by m; /x produces x if x is null, or else fails
X%    n % m    produces the remainder of n divided by m
X^    n ^ m produces n to the power of m; ^e produces a refreshed copy of e
X<    n < m produces m if n is less than m, else fails
X<=    n <= m produces m if n is less than or equal to m, else fails
X=    n = m produces m if n equals m, else fails; =s equiv. to tab(match(s))
X>=    n >= m produces m if n is greater than or equal to m, else fails
X>    n > m produces m if n is greater than m, else fails
X~=    n ~= m produces m if n is not equal to m, else fails
X++    c1 ++ c2 produces the cset union of c1 and c2
X--    c1 -- c2 produces the cset difference of c1 and c2
X**    c1 ** c2 produces the cset intersection of c1 and c2
X||    s1 || s2 produces a string consisting of s1 followed by s2
X<<    s1 << s2  produces s2 if s1 is lexically less than s2, else fails
X<<=    s1 <<= s2  produces s2 if s1 is lexically <= s2, else fails
X==    s1 == s2 produces s2 if s1 is lexically equal to s2, else fails
X>>=    s1 >>= s2 produces s2 if s1 is lexically >= s2, else fails
X>>    s1 >> s2 produces s2 if s1 is lexically greater than s2, else fails
X~==    s1 ~== s2 produces s2 if s2 isn't lexically equal to s2, else fails
X|||    a1 ||| a2 produces a list of the values of a1 followed by those of a2
X@    x @ e activates e and transmits x to it; @e produces the outcome of activating e
X:=    x := y assigns the value of y to x, and produces the variable x
X<-    x <- y assigns y to x and produces x; reverses assignment if resumed
X:=:    x :=: y exchanges the values of x and y and produces the variable x
X<->    x <-> y exchanges x and y and produces x; reverses exchange if resumed
X===    x === y produces y if x and y have the same value, else fails
X~===    x ~=== y produces y if x and y don't have the same value, else fails
X&    x & y produces y; produces a variable if y is a variable
X.    x . y produces a variable for the y field of record x
X+:=    n +:= m assigns the sum of n and m to n and produces n
X-:=    n -:= m assigns the difference of n and m to n and produces n
X*:=    n *:= m assigns the product of n and m to n and produces n
X/:=    n /:= m assigns the difference of n and m to n and produces n
X%:=    n %:= m assigns the remainder of n divided by m to n and produces n
X^:=    n ^:= m assigns n raised to the power m to n and produces n
X<:=    n <:= m assigns m to n if n < m, else fails; produces n
X<=:=    n <=:= m assigns m to n if n <= m, else fails; produces n
X=:=    n =:= m assigns m to n if n = m, else fails; produces n
X>=:=    n >=:= m assigns m to n if n >= m, else fails; produces n
X>:=    n >:= m assigns m to n if n > m, else fails; produces n
X~=:=    n ~=:= m assigns m to n if n ~= m, else fails; produces n
X++:=    c1 ++:= c2 assigns the cset union of c1 and c2 to c1 and produces c1
X--:=    c1 --:= c2 assigns the cset difference of c1 and c2 to c1, producing c1
X**:=    c1 **:= c2 assigns the intersection of c1 and c2 to c1, producing c1
X||:=    s1 ||:= s2 assigns the string s1 || s2 to s1 and produces s1
X<<:=    s1 <:= s2 assigns s2 to s1 if s1 << s2, else fails; produces s1
X<<=:=    s1 <=:= s2 assigns s2 to s1 if s1 <<= s2, else fails; produces s1
X==:=    s1 =:= s2 assigns s2 to s1 if s1 == s2, else fails; produces s1
X>>=:=    s1 >=:= s2 assigns s2 to s1 if s1 >>= s2, else fails; produces s1
X>>:=    s1 >:= s2 assigns s2 to s1 if s1 >> s2, else fails; produces s1
X~==:=    s1 ~=:= s2 assigns s2 to s1 if s1 ~== s2, else fails; produces s1
X|||:=    a1 |||:= a2 assigns to a1 the concatenation of a1 and a2; produces a1
X@:=    x @:= e activates e with the value of x, and assigns the result to x
X===:=    x ===:= y assigns y to x if x === y, else fails; produces x
X~===:=    x ~===:= y assigns y to x if x ~=== y, else fails; produces x
X&:=    x &:= y assigns the value of y to x and produces x
XPREFIX OPERATIONS (some under infix instead)
X~    ~c produces the cset complement of c with respect to &cset
X!    !x generates the elements of x, failing if x is empty (x may be a file)
X.    .x produces the value of x
XKEYWORDS
X&ascii    produces a cset of the 128 ASCII characters
X&clock    produces a string consisting of the current time of day
X&collections
X&cset    produces a cset consisting of all 256 characters
X¤t
X&date    produces a string consisting of the current date
X&dateline    produces a string of the current date and time of day
X&digits
X&error
X&errornumber
X&errortext
X&errorvalue
X&errout    produces the standard error output file
X&fail    fails
X&features
X&file
X&host    produces a string that identifies the host computer
X&input    produces the standard input file
X&lcase    produces a cset consisting of the 26 lowercase letters
X&level    produces the integer level of the current procedure call
X&line
X&main    produces a co-expression for the initial call of main
X&null    produces the null value
X&output    produces the standard output file
X&pos    produces the integer position of scanning in &subject
X&random    produces the value of the seed for the psuedo-random sequence
X®ions
X&source    produces a co-expression for the activator of the current co-expression
X&storage    how much of each storage region is currently being used
X&subject    produces the variable whose value is the string being scanned
X&time    produces the integer number of msecs since beginning of execution
X&trace    produces a variable whose value controls procedure tracing
X&ucase    produces a cset consisting of the 26 uppercase characters
X&version    produces a string that identifies the version of Icon
!FaR!OuT!
exit

From [e-mail]  Fri May 31 08:17:53 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Fri, 31 May 91 08:17:53 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA15592; Fri, 31 May 91 08:17:51 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Fri, 31 May
 1991 08:17 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA29331; Fri, 31 May 91
 08:02:33 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Fri, 31 May 1991 08:17 MST
Date: 31 May 91 14:38:15 GMT
From: cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE: Records
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <31.May.91..11:, 23:12.bst..060024@EMAS-A>

In <31.May.91..11:23:12.bst..060024@EMAS-A> [e-mail] writes:
>
>Next question - I am using records as the basis for a simple database
>program. Given that the program will be written in a tight enough way to
>ensure that it won't be possible to write a list with more elements than
>there are in a database entry, what is the advantage of using a record
>to store a database entry as opposed to a list?

Record field access is much faster than list subscripting.  You can also
get at the fields by name, and not worry about their order.  If you want,
though, you can subscript records (as long as you realize that doing so
erases most of their method of/speed of access advantages).

If you really want to be clever, use a record for all the fields you know
you'll be using, but make one member of the record into a list where you
can store optional or other fields.  You'll get the best of both worlds,
at the expense of some clarity and straightforwardness.

--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From uunet!men2a!aquin!luvthang!talmage  Sat Jun  1 02:07:07 1991
Received: from univers.cs.arizona.edu by cheltenham.cs.arizona.edu; Sat, 1 Jun 91 02:07:07 MST
Received: from uunet.UUCP by univers.cs.arizona.edu; Sat, 1 Jun 91 02:07:06 MST
Received: from men2a.UUCP (LOCALHOST.UU.NET) by relay2.UU.NET with SMTP
    (5.61/UUNET-internet-primary) id AA04543; Sat, 1 Jun 91 03:46:13 -0400
Received: from men2a.UUCP by uunet.uu.net with UUCP/RMAIL
    (queueing-rmail) id 034526.15947; Sat, 1 Jun 1991 03:45:26 EDT
Received: by men2a.ori-cal.com (smail2.5)
    id AA00353; 1 Jun 91 03:52:14 EDT (Sat)
Received: by aquin.ORI-CAL.COM (smail2.5)
    id AA01610; 1 Jun 91 03:37:12 EDT (Sat)
Received: by luvthang.UUCP (1.05D/Amiga)
    id AA02235; Fri, 31 May 91 17:17:07 EST
Date: Fri, 31 May 91 17:17:07 EST
Message-Id: <[e-mail]>
From: uunet!luvthang!talmage (David W. Talmage)
To: uunet!icon-group
Subject: Idol gotcha:  mixing procedures and methods

Boy, do I feel dumb!  Here's a "gotcha" for those of us who work with
Idol, Clint Jeffery's neato object-oriented language derived from Icon.

In Idol, you can have both procedures and methods in a class
definition.  Procedures become part of the global name space while
methods stay local to the objects of their class.  Because procedures
are in the global space, they have no concept of the variable "self",
which all methods may use to access the instance variables of their
class.  Procedures which try to dereference self invoke a run-time
error: "record expected".

This sample should illustrate the problem:

class DoNuthin(theFrobotz, theZimZam)
method asString()
  return "theFrobotz= " || self.theFrobotz || " theZimZam= " || self.theZimZam
end

procedure printThem()
  write( self.theFrobotz )
  write( self.theZimZam )
end

initially
  printThem()
end

procedure main()
local aDoNuthin

  aDoNuthin := DoNuthin( "David", "Talmage" )
  write( aDoNuthin$asString() )

end

I don't want to tell you how long it took me to figure that one out.

-----------------------------------------------------------------------------
David W. Talmage ([e-mail])
"I need fifty dollars to make you hollar.  I get paid to run this luvthang."

From cjeffery  Mon Jun  3 12:17:05 1991
Date: Mon, 3 Jun 91 12:17:05 MST
From: "Clinton Jeffery" <cjeffery>
Message-Id: <[e-mail]>
Received: by cheltenham.cs.arizona.edu; Mon, 3 Jun 91 12:17:05 MST
To: uunet!men2a!aquin!luvthang!talmage
Cc: icon-group
In-Reply-To: David W. Talmage's message of Fri, 31 May 91 17:17:07 EST <[e-mail]>
Subject: Idol gotcha:  mixing procedures and methods

<<This is a reply to David Talmage's note on mixing procedures and methods
  in Idol.  Regular Icon readers will not miss anything if they skip it.>>

Procedures inside class declarations are regular Icon procedures and do not
have any implicit "self" object on which to operate.  Idol used to flag this
with an error to prevent the kind of confusion Mr. Talmage experienced.  But
it is quite useful to allow normal Icon code (such as helping procedures)
to be included within a class declaration.  Idol does not take the view
that every piece of code should be a method, any more than it views
every piece of data as an object.  Saying "procedure" when you mean
"method" will indeed cause the kind of problems Mr. Talmage described.

From uunet!men2a!aquin!luvthang!talmage  Wed Jun  5 14:36:06 1991
Received: from univers.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 5 Jun 91 14:36:06 MST
Received: from uunet.UUCP by univers.cs.arizona.edu; Wed, 5 Jun 91 14:36:06 MST
Received: from uunet.uu.net (LOCALHOST.UU.NET) by relay1.UU.NET with SMTP
    (5.61/UUNET-internet-primary) id AA11701; Wed, 5 Jun 91 14:26:09 -0400
Received: from men2a.UUCP by uunet.uu.net with UUCP/RMAIL
    (queueing-rmail) id 142547.9400; Wed, 5 Jun 1991 14:25:47 EDT
Received: by men2a.ori-cal.com (smail2.5)
    id AA24099; 5 Jun 91 14:34:43 EDT (Wed)
Received: by aquin.ORI-CAL.COM (smail2.5)
    id AA02705; 5 Jun 91 14:17:48 EDT (Wed)
Received: by luvthang.aquin.ori-cal.com (1.05D/Amiga)
    id AA02343; Wed, 5 Jun 91 08:50:51 EST
Date: Wed, 5 Jun 91 08:50:51 EST
Message-Id: <[e-mail]>
From: uunet!luvthang.aquin.ori-cal.com!talmage (David W. Talmage)
To: uunet!icon-group
Subject: sorting files larger than physical memory

Once upon a time, Richard Goerwitz posted some text indexing code he
called gettext().  I've been using it and trying to improve it.  One
thing I'm working on is sorting the keys in the index files so
searches for keys are faster.  This presents a problem when the keys
are too many to fit in available memory at one time.  I'm looking for
solutions to this problem.

My solution, for the time being, is to read the keys in batches that
fit in my limited memory, sorting each batch with the built-in
function sort().  Each sorted batch I write to a temporary file.  When
all batches are sorted, I merge the temporary files one record at a
time in much the same way as you'd merge piles of sorted index cards.

I welcome comments and code from anyone.

-----------------------------------------------------------------------------
David W. Talmage ([e-mail])
"I need fifty dollars to make you hollar.  I get paid to run this luvthang."

From @um.cc.umich.edu:[e-mail]  Wed Jun  5 15:53:57 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Wed, 5 Jun 91 15:53:57 MST
Received: from umich.edu by optima.cs.arizona.edu (4.1/15)
    id AA26204; Wed, 5 Jun 91 15:53:54 MST
Received: from um.cc.umich.edu by umich.edu (5.61/1123-1.0)
    id AA18627; Wed, 5 Jun 91 18:53:50 -0400
Received: from MTS.cc.Wayne.edu by um.cc.umich.edu via MTS-Net; Wed, 5 Jun 91 18:47:45 EDT
Date: Wed, 5 Jun 91 18:47:34 EDT
From: [e-mail]
To: [e-mail]
Message-Id: <[e-mail]>
Subject: Sorting index files


Dave Talmage inquired about sorting files that are too large to
fit in memory.   I had the same problem in my indexing program
for ``TeX for the Impatient''.  My solution was simple: two Icon
programs and a sort in between, using the sort program that comes
with your system.  This solution works equally well for Unix and
DOS, although the standard DOS sorting program is probably not
satisfactory; you'll have to shop around for a better one.  You
can also do it with a single Icon program and the `system'
function, or maybe even more elegantly with `system' and piped
files under Unix.  But the two-program solution ain't that bad.

A couple more details: the first pass analyzes each index entry
and attaches a sort key to it.  With appropriate use of the Icon
map function, you can handle the fine points of sorting uppercase
versus lowercase and handling index entries that begin with
special characters.  The second pass strips the sort keys and
collects the entries for a particular index heading.

By the way, the standard practice on ordering special characters
in an index is to use the ASCII collating sequence.  As far as
I'm concerned, that's a copout.  Indices are intended to be read
by people, not by machines.  How many of your buddies (male or
female, no sexism intended) remember the ASCII collating sequence
for the special characters?  A much better solution is to sort
the special characters by their English names, which you should
list for the reader so as to avoid any confusion (is it ``star''
or ``asterisk'', ``dash'' or ``minus'')?  A few twiddles are in
order: ``parenthesis, left'' rather than ``left parenthesis'',
etc.

Paul Abrahams
[e-mail]



From [e-mail]  Thu Jun  6 04:09:14 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 6 Jun 91 04:09:14 MST
Received: from MIS1.MIS.MCW.EDU by optima.cs.arizona.edu (4.1/15)
    id AA25230; Thu, 6 Jun 91 04:09:09 MST
Received: from mis.mcw.edu (MCWMI3) by MIS1.MIS.MCW.EDU with PMDF#10477; Thu, 6
 Jun 1991 06:09 CST
Date: Thu, 6 Jun 1991 06:09 CST
From: Chris Tenaglia - 257-8765 <[e-mail]>
Subject: Re: Sorting index files
To: [e-mail]
Cc: [e-mail]
Message-Id: <[e-mail]>
X-Organization: Medical College of Wisconsin MIS Department (Milwaukee, WI)
X-Vms-To: IN%"[e-mail]"
X-Vms-Cc: IN%"[e-mail]"

Regarding:    Sorting index files

> Dave Talmage inquired about sorting files that are too large to
> fit in memory.   I had the same problem in my indexing program
> for ``TeX for the Impatient''.  My solution was simple: two Icon
> programs and a sort in between, using the sort program that comes
> with your system.  This solution works equally well for Unix and
> DOS, although the standard DOS sorting program is probably not
> satisfactory; you'll have to shop around for a better one.  You
> can also do it with a single Icon program and the `system'
> function, or maybe even more elegantly with `system' and piped
> files under Unix.  But the two-program solution ain't that bad.
>>..more..
> Paul Abrahams
> [e-mail]

I also have a report generator with the same problem. It loads, sorts,
outputs. Somewhere between 2000 and 5000 items is the limit of icon
sort() {under VMS} so once the list is loaded I test it's size. If
greater than the limit, I write it to a temporary file, sort with
             system("sort/key=(pos:5,size:12,ascending) file.tmp")
reload the file, output the report and cleanup temp files.

Although there are sometimes when the list goes to 20,000 to 50,000 items
and I can't even fit it. So I have a passed parameter (-file) when I know this
will happen to run everything with temp files. VMS, unlike unix does not
have piping (who | sort | mail tenaglia).

Chris Tenaglia (System Manager) | Medical College of Wisconsin
8701 W. Watertown Plank Rd.     | Milwaukee, WI 53226
[phone]                   | [e-mail], mcwmis!tenaglia


From [e-mail]  Thu Jun  6 11:08:23 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 6 Jun 91 11:08:23 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA09074; Thu, 6 Jun 91 11:08:20 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Thu, 6 Jun
 1991 10:56 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA17391; Thu, 6 Jun 91 10:48:02
 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Thu, 6 Jun 1991 11:08 MST
Date: 6 Jun 91 17:30:10 GMT
From: agate!spool.mu.edu!sol.ctr.columbia.edu!ira.uka.de!i41s5![e-mail] (Angelo
 Schneider Betr.Prechelt)
Subject: WHAT Icon ?
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Karlsruhe, FRG

Would anybody please mail me some information
about icon?

Can I get anywhere a compiler or at least a to C-Compiler?

thanx in advance

angelo

From [e-mail]  Sun Jun  9 12:24:09 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Sun, 9 Jun 91 12:24:09 MST
Received: from gargoyle.uchicago.edu by optima.cs.arizona.edu (4.1/15)
    id AA20386; Sun, 9 Jun 91 12:24:07 MST
Received: by gargoyle.uchicago.edu from sophist (sophist.uchicago.edu) (4.0/1.14)
    id AA28884; Sun, 9 Jun 91 14:24:05 CDT
Return-Path: <[e-mail]>
Received:  by sophist (4.1/UofC3.1X)
    id AA07148; Sun, 9 Jun 91 14:25:08 CDT
Date: Sun, 9 Jun 91 14:25:08 CDT
From: Richard Goerwitz <[e-mail]>
Message-Id: <9106091925.AA07148@sophist>
To: [e-mail]
Subject: ansi routines

Is anyone using the IPL ansi.icn library?  If so, I have a set of
compatible routines I'm trying to test out that will run under a
wider variety of platforms.  Anyone who wants to try them out, pleas
drop me a line.


   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Mon Jun 10 12:42:17 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 10 Jun 91 12:42:17 MST
Received: from eos.arc.nasa.gov by optima.cs.arizona.edu (4.1/15)
    id AA08664; Mon, 10 Jun 91 12:42:15 MST
Received: Mon, 10 Jun 91 12:42:05 -0700 by eos.arc.nasa.gov (5.65/1.2)
Date: Mon, 10 Jun 91 12:42:05 -0700
From: Michael Shafto <[e-mail]>
Message-Id: <[e-mail]>
To: [e-mail], [e-mail]
Subject: Re:  ansi routines
Cc: [e-mail]

Richard --

Yes, and I would be interested in testing your new improved version.

Mike

From [e-mail]  Mon Jun 10 14:50:07 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Mon, 10 Jun 91 14:50:07 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA19481; Mon, 10 Jun 91 14:49:55 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Mon, 10 Jun
 1991 14:49 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA03491; Mon, 10 Jun 91
 14:30:50 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Mon, 10 Jun 1991 14:49 MST
Date: 10 Jun 91 21:11:45 GMT
From: cis.ohio-state.edu!zaphod.mps.ohio-state.edu!sdd.hp.com!news.cs.indiana.edu!ux1.cso.uiuc.edu!midway!ellis.uchicago.edu![e-mail] (Richard L.
 Goerwitz)
Subject: RE:  ansi routines
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: University of Chicago
References: <[e-mail]>

[e-mail] (Michael Shafto) writes:
>
>Yes, and I would be interested in testing your new improved version.

I wasn't clear enough:  My version is expanded (in the sense that
the ANSI interface can be applied to non-ANSI terminals).  I'm not
sure that it really constitutes an improvement.  Anyway, I haven't
had enough requests to consider posting, so I reiterate the offer
of sending them to anyone who wants to use them.

It's really a good idea to used generalized I/O for any programs
written in Icon, since Icon runs on so many platforms.  These new
ANSI routines have the advantage of working as-is on DOS platforms
with the ansi.sys driver installed.  The escape codes are hard-
coded in.  If, however, you want to run a program written with
them on, say, a UNIX box, the routines are structured so that you
can just link in the Icon termlib-type routines I posted some time
ago here (and which I have copies of I'll gladly pass on; I use
them constantly, and can't seem to stop revising them).  There is
also a library of high-level routines I wrote for use in conjunc-
tion with the termlib-type library.  These can also be linked in
with the revised ANSI screen control library.  The routines in
the revised library sense what it is you've linked in, and make
use of whatever you've made available (if in fact they need any
additional help - which they don't in DOS environments).

The idea is to have a generalized library of screen functions
that DOS users can blindly use, which take up minimal space, are
fairly fast, and which can be augmented for Unix without having
to change a single line of code (and without requiring the user
to have to do worry about setting up any sort of database).  Ad-
mittedly, these routines are a bit more spartan than the iolib
routines I posted a while back.  They are a lot more hassle-free,
though, and they cover pretty much all the basic functions that
people doing visually oriented programs would need.

You know, speaking of screen control, I wrote a set of Icon-based
windowing routines some time ago.  They let you open up virtual
screens, move them around, create borders, overlap them, write to
any screen (aka window), and have the portion showing on the stan-
dard screen be correctly updated (if in fact any was showing).

The reason I didn't post them is quite simple:  Although they were
fast enough for most purposes, they ate up way, way too much mem-
ory.  I implemented the concept of a displayable area with the
Icon equivalent of a 2d array (a list of lists), and then tried
various ways of representing squares in that array (integers, rec-
ords, etc.).  The trouble was that I wanted them to be pointers
to window structures created by the user.  Not having this facility,
I had to use records, which used up just too much space.

It *almost* worked.  :-(  I guess I wish that Icon had some sort
of explicit pointer data type.

--

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer

From [e-mail]  Tue Jun 11 16:39:17 1991
Received: from optima.cs.arizona.edu by cheltenham.cs.arizona.edu; Tue, 11 Jun 91 16:39:17 MST
Resent-From: [e-mail]
Received: from Arizona.edu (Merlin.Telcom.Arizona.EDU) by optima.cs.arizona.edu (4.1/15)
    id AA20908; Tue, 11 Jun 91 16:39:12 MST
Received: from ucbvax.Berkeley.EDU by Arizona.edu with PMDF#10282; Tue, 11 Jun
 1991 16:38 MST
Received: by ucbvax.Berkeley.EDU (5.63/1.42) id AA17305; Tue, 11 Jun 91
 16:30:41 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews for
 [e-mail] ([e-mail]) (contact
 [e-mail] if you have questions)
Resent-Date: Tue, 11 Jun 1991 16:38 MST
Date: 11 Jun 91 22:45:29 GMT
From: acf5![e-mail] (Thanasis Mitsolides)
Subject: ALLOY: Parallel, higher level, and flexible. V2.0
Sender: [e-mail]
Resent-To: [e-mail]
To: [e-mail]
Resent-Message-Id: <[e-mail]>
Message-Id: <[e-mail]>
X-Envelope-To: [e-mail]
X-Vms-To: [e-mail]
Organization: New York University

This, announces the availability of the interpreter, manual,
 examples, and thesis for the programming language ALLOY v2.0.
ALLOY now completely unifies its functional and object oriented aspects.
 Also, its supports a much richer library.

ALLOY is high level, parallel, flexible and efficient.
ALLOY combines serial/parallel ev., eager/lazy ev., single/multiple solutions
 and parallel object oriented programming in a remarkably simple framework.

Example programs ready for execution include:
 1) factorial, partition sort, FP             (highly parallel)
 2) fibonacci sequence, prime numbers             (eager or lazy)
 3) systolic sort, hamming network            (clear flow of data)
 4) list member, tree leave, list permutation, n queens (multiple solutions)
 5) queue, stack, faa, semaphores, dinning philosophers    (objects)
 6) prolog package, prolog/parlog programming styles     (flexibility)

Part of ALLOY is explained in:
[MH90]    Thanasis  Mitsolides  and  Malcolm  Harrison.   Generators  and  the
          replicator control  structure in the parallel  environment of ALLOY.
          In ACM  SIGPLAN '90  Conference on  Programming Language  Design and
          Implementation, pages 189--196, White Plains, New York, June 1990.

The abstract of the ALLOY manual is appended at the end of this message.
The sources, manual, example programs, benchmarks, and thesis of ALLOY
are available for anonymous FTP from cs.nyu.edu (128.122.140.24)

I hope you will find ALLOY interesting.
I will be glad to answer your comments!
Thank you,

Thanasis


===============================================================================
                ABSTRACT

       ALLOY is a higher level parallel  programming language appropriate
     for programming  massively parallel computing systems.   It is based
     on  a combination  of  ideas from  functional,  object oriented  and
     logic programming languages.
       The  result  is  a  language that can  directly support functional,
     object  oriented  and logic  programming  styles  in a  unified  and
     controlled framework.   Evaluating modes support serial  or parallel
     execution,  eager or  lazy evaluation,  non-determinism or  multiple
     solutions etc.   ALLOY is  simple as it only requires  29 primitives
     in all (half of which for Object Oriented Programming support).
       This article, starts with  a formal definition of the  small ALLOY
     kernel  proceeds with the  definition of  some useful libraries  and
     concludes  with examples  which demonstrate  its expressiveness  and
     clarity.
       Programming language ALLOY is located  on system spunky.cs.nyu.edu
     directory  ~mitsolid/alloy.   This article can  be found in dvi  and
     ascii  form  on subdirectory  doc,  The  examples presented  can  be
     found  in subdirectory progs.   The  interpreter is executable  file
     alloy.   All the above and the sources of the  ALLOY interpreter are
     available   for   anonymous  ftp  on  system  cs.nyu.edu   directory
     pub/local/alloy.

-------------------------------------------------------------------------------
Internet: [e-mail]                 ([e-mail])
UUCP    : ...!uunet!cmcl2!cs!mitsolid
-------------------------------------------------------------------------------


--
-------------------------------------------------------------------------------
Internet: [e-mail]                 ([e-mail])
UUCP    : ...!uunet!cmcl2!cs!mitsolid
-------------------------------------------------------------------------------

From uunet!men2a!aquin!luvthang!talmage  Thu Jun 13 10:11:25 1991
Received: from univers.cs.arizona.edu by cheltenham.cs.arizona.edu; Thu, 13 Jun 91 10:11:25 MST
Received: from uunet.UUCP by univers.cs.arizona.edu; Thu, 13 Jun 91 10:11:24 MST
Received: from uunet.uu.net (via LOCALHOST.UU.NET) by relay1.UU.NET with SMTP
    (5.61/UUNET-internet-primary) id AA00621; Thu, 13 Jun 91 08:22:21 -0400
Received: from men2a.UUCP by uunet.uu.net with UUCP/RMAIL
    (queueing-rmail) id 082208.20608; Thu, 13 Jun 1991 08:22:08 EDT
Received: by men2a.ori-cal.com (smail2.5)
    id AA12884; 13 Jun 91 08:19:53 EDT (Thu)
Received: by aquin.ORI-CAL.COM (smail2.5)
    id AA05816; 13 Jun 91 07:34:44 EDT (Thu)
Received: by luvthang.aquin.ori-cal.com (1.05D/Amiga)
    id AA02419; Tue, 11 Jun 91 10:25:31 EST
Date: Tue, 11 Jun 91 10:25:31 EST
Message-Id: <[e-mail]>
From: uunet!luvthang.aquin.ori-cal.com!talmage (David W. Talmage)
To: uunet!icon-group
Subject: Increasing the number of concurrently open files

How many open files can an Icon program have at one time?  How can I
change this?  I'm encountering a limit of about 20 with Amiga Icon
version 8.0, February 14, 1990.  It looks like I can open 17 files of
my own choosing.  The remaining three must be &input, &output, and
&errout.

The documentation tells me of an icont option -SFnnnn where nnnn is
the number of files.  Is there anything else I must do?  I've tried
-SF50, for example, with no change.

Enclosed, for the curious, is a program that determines how many open
files you can have at one time.

David Talmage
uunet!luvthang!talmage

----- Begin included text -----
# File: OpenFileTest.icn
# Author: David W. Talmage
#
# Usage: iconx OpenFileTest [numfiles]
#
# OpenFileTest attempts to open numfiles files and keep them all open
# at the same time.  If it cannot open one of the files, OpenFileTest
# reports the name and number of the file.
#
# OpenFileTest removes all of the files it creates.
#
# By default, numfiles is 15.
#
record fileRec( theFilePointer, theFileName )

procedure main( argv )
local aFileRec
local fileName
local fRecList
local numFRecs
local openFileCount
local j

  openFileCount := 0
  numFRecs := integer( argv[1] ) | 15
  fRecList := list()

#
# CHANGE THE BASE NAME OF THE TEMPORARY FILE TO ONE FITTING YOUR SYSTEM.
#
  every fileName := (tempname("t:xxOFT." ) \ numFRecs) do {


    aFileRec := fileRec( open( fileName, "w" ), fileName ) | break(
        write( "OpenFileTest: Can't open ", fileName,
        ", file #", openFileCount + 1 ) )

    openFileCount +:= 1
    put( fRecList, aFileRec )

  }

  write( "OpenFileTest: opened ", openFileCount, " concurrently." )

  #
  # Clean up after ourselves.  Close and delete each temporary file.
  #
  every j := 1 to openFileCount do {

    close( fRecList[ j ].theFilePointer )
    remove( fRecList[ j ].theFileName )

  }
end


# This is a version of Ronald Florence's ([e-mail]) tempname
# generator from post.icn of January 8, 1991.  That procedure was
# based on Richard Goerwitz's tempname generator, probably the one
# named get_dos_tempname in gdl.icn version 1.2.
#
# tempname() generates a sequence of unique temporary file names with
# some common base name.
#

procedure tempname(basename)
local temp_name

  every temp_name := basename || right(1 to 999,3,"0") do {
    close(open(temp_name)) & next
    suspend \temp_name
  }
end