rs@uunet.UU.NET (Rich Salz) (06/24/87)
Submitted by: Brian Harvey <bh@mit-amt>
Mod.Sources: Volume 10, Number 21
Archive-Name: logo/Part01
[ Logo is a a way of life, not just a programming language. Here's the
definitive Unix release from one of the primary prophets. --r$ ]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 6)."
# Contents: MANIFEST README adm.i admtek.i atari.i dr11k.c gigi.i
# helpfile library library/beep.lg library/f.lg library/g.lg
# library/gigimove.lg library/hanoi.lg library/home.lg
# library/howis.lg library/l.lg library/laugh.lg library/listp.lg
# library/pick.lg library/poly.lg library/pos.lg library/quest.lg
# library/quiz1.lg library/setcursor.lg library/setheight.lg
# library/setitalic.lg library/setpos.lg library/setsize.lg
# library/setslant.lg library/setslope.lg library/setx.lg
# library/sety.lg library/textprint.lg library/top.lg
# library/towards.lg logohead.c main.c makefile makehelp proplist.c
# splithelp.c sun.i tek.i unix.c zerr.c
# Wrapped by rsalz@pineapple.bbn.com on Wed Jun 24 14:26:50 1987
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f MANIFEST -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"MANIFEST\"
else
echo shar: Extracting \"MANIFEST\" \(1926 characters\)
sed "s/^X//" >MANIFEST <<'END_OF_MANIFEST'
X File Name Archive # Description
X-----------------------------------------------------------
X MANIFEST 1
X README 1
X adm.i 1
X admtek.i 1
X applediff 2
X atari.i 1
X dr11k.c 1
X gigi.i 1
X helpfile 1
X library 1
X library/beep.lg 1
X library/f.lg 1
X library/g.lg 1
X library/gigimove.lg 1
X library/hanoi.lg 1
X library/home.lg 1
X library/howis.lg 1
X library/l.lg 1
X library/laugh.lg 1
X library/listp.lg 1
X library/pick.lg 1
X library/poly.lg 1
X library/pos.lg 1
X library/quest.lg 1
X library/quiz1.lg 1
X library/setcursor.lg 1
X library/setheight.lg 1
X library/setitalic.lg 1
X library/setpos.lg 1
X library/setsize.lg 1
X library/setslant.lg 1
X library/setslope.lg 1
X library/setx.lg 1
X library/sety.lg 1
X library/textprint.lg 1
X library/top.lg 1
X library/towards.lg 1
X logo.h 2
X logo.y 4
X logoaux.c 3
X logohead.c 1
X logoman.1 5
X logoman.2 6
X logonum.c 2
X logoop.c 3
X logoparse.c 2
X logoproc.c 3
X main.c 1
X makefile 1
X makehelp 1
X olddiff 2
X procedit.c 2
X procvars.c 2
X proplist.c 1
X splithelp.c 1
X storage.c 2
X sun.i 1
X tek.i 1
X turtle.c 3
X unix.c 1
X zerr.c 1
END_OF_MANIFEST
if test 1926 -ne `wc -c <MANIFEST`; then
echo shar: \"MANIFEST\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f README -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(10027 characters\)
sed "s/^X//" >README <<'END_OF_README'
XUnix Logo Interpreter
X Brian Harvey
X Lincoln-Sudbury Regional High School
X
XThis is release 4 of Unix Logo. It differs from release 3 in that it
Xmore closely follows the syntax of LCSI versions of Logo (Apple Logo,
XIBM Logo, etc.) In particular, multiple commands on a line are allowed
Xwithout semicolons required between them. The prompt character is '?'
Xinstead of '*' as before. The abbreviations 'f', 'l', and 'top' have
Xbeen eliminated. Positioned text (cleartext and setcursor) are supported
Xusing termlib. The 'random' primitive now takes an input, like 'rnd',
Xinstead of being equivalent to 'rnd 10' as before. Error messages are
Xcloser to those in other versions of Logo. Procedure names can be longer
Xthan 11 characters if your version of Unix has long file names.
X
XThe following obsolete paragraph is included to help users of previous
Xversions understand the version history.
X
X-----
XThis is release 3.2 of Unix Logo. Release 1 was the one on the first 1982
XUsenix tape. Release 2 was sent by me (BH) directly to only a few sites.
XThis release is much like release 2 in capabilities and syntax, but has
Xbeen rearranged internally somewhat to make the process of installation
Xon a new system a bit easier. One major new feature in release 3 is the
Xpause facility, which allows interactive debugging in the local context
Xof an error. More on this below. Release 3.1 differs from 3 only in a
Xfew bug fixes and in what is left out under the SMALL option. Release 3.2
Xdiffers from release 3.1 in bug fixes, better error messages, and one
Xincompatible change: the quotient of two integers can be a non-integer.
X-----
X
XI would like to thank Don Martin and his students at the College of Marin,
Xwho have found huge numbers of obscure bugs in Logo and therefore helped
Xmake this release much more reliable than it would otherwise have been.
X
XLogo is a programming language for education. It is, I think, unquestionably
Xthe best introductory learning language now available, because it combines
Xthe ease of an interactive language (like BASIC, otherwise terrible) with
Xthe power and structure of a procedural language (like Pascal, not bad once
Xyou get past the details of editing and compiling and loading and semicolons
Xand does var go before or after const). If you aren't convinced, read the
Xbook "Mindstorms" by Seymour Papert. It doesn't matter how old your
Xstudents are.
X
XThis directory contains an interpreter for the Logo programming language.
XThe interpreter is written in C and YACC, and runs under Unix(TM) version 7.
XIt has been exported also to Vax 4BSD and to Idris on a PDP-11. This program
Xis based on a Logo interpreter originally written at the Boston Children's
XMuseum; the present version is very much improved in its capabilities. On
Xthe other hand, the original version ran in a 64Kb address space; this version
Xrequires split I/D on the PDP-11. (It can be run on a smaller 11 by turning
Xon the definition of SMALL in logo.h, but with hardly any recursion allowed.
XThis configuration just barely works and is not recommended. If someone with
Xsuch a system wants to tune it up and send me the results, please do. SMALL
Xeliminates the pause feature (pause, continue, errpause, etc.) and the
Xproperty list feature (pprop, gprop, etc.) as well as using short ints and
Xfloats instead of long ints and doubles.)
X
XThe file "logoman" in this directory is an nroff-format reference manual. It's
Xvery terse; you should really learn Logo from some other manual and use this
Xone just to learn about idiosyncracies. There are also two smaller
Xdocumentation files, "applediff" for people accustomed to Apple
XLogo, and "olddiff" for people accustomed to the first LSRHS release.
XIf you are getting this file via Usenet comp.sources.unix, you will
Xhave to do "cat logoman.[12] >logoman" first.
X
XUsers of the first release of LSRHS Logo (the one on the Usenix 82.1 tape)
Xwill find the present version more robust and also more featureful. Its
Xsyntax is much like that of Apple Logo, which should be helpful to people
Xwith Apples as well as real computers. Line numbers have been flushed,
Xexcept for use with the go command. The kludgy re-entrant use of the YACC
Xparser has been eliminated.
X
XThe enclosed makefile should manage to compile this Logo with no errors.
XYou will have to make some modifications for local conditions, most notably
Xin the area of turtle graphics. Most installation dependencies have been
Xcollected at the beginning of the file logo.h which is included in all
Xcompilations.
X
XTURTLE GRAPHICS. You must #define symbols in logo.h for the kind(s) of
Xdisplay hardware you support. Also, if you have a graphics terminal which
Xis not one of the ones already supported in this release, you'll have to
Xadd some code to turtle.c to support it. The enclosed turtle.c
Xknows about six kinds of graphics hardware:
X 1) Terrapin floor turtles, connected via DR11-K interfaces.
X 2) Atari 800 personal computers, running a special terminal program.
X 3) DEC GIGI graphics terminals.
X 4) Retrographics boards (known to work with ADM-5 terminals,
X maybe also for other Retrographics products).
X 5) Tektronix 4014 storage tube displays (with severe restrictions
X because of their inability to erase selectively).
X 6) Sun Microsystems workstations.
XThe files ./*.i contain terminal-specific code which is #included in the
Xcompilation of turtle.c if the corresponding terminal is #defined in logo.h.
XThe code for floor turtles is done very differently and is not separated into
Xa .i file because, alas, it's not so modular. If you have neither graphics
Xterminals nor floor turtles, you should turn on the NOTURTLE definition in
Xlogo.h to eliminate the turtle primitives.
X
XDEFAULT EDITOR. The "edit" command in Logo does not use an editor built
Xinto Logo itself. Instead, it forks and runs your favorite editor in a
Xnew process. If you have an EDITOR variable in your environment, it uses
Xthat editor (it tries with /bin, /usr/bin, and nothing prepended). If not,
Xit uses the editor specified in the EDT definition in logo.h. This is
X"jove" in the version as distributed.
X
XINPUT WAITING TEST. The "keyp" operation depends on a system call to
Xcheck for characters waiting to be read from the keyboard. If you are
Xrunning a Berkeley-derived Unix, this will work correctly. If not, but
Xyou have your own such system call, edit procedure keyp() in logoaux.c
Xto use your own version.
X
XFILENAME FORMAT. Each Logo procedure is stored in a file called <name>.lg
Xin the current working directory. Under version 7 Unix, this allows names
Xof procedures to be up to eleven letters long. VMS filenames can only be
Xnine letters. The parameter NAMELEN in logo.h should be adjusted. (Note:
Xdepending on when you got your version of Eunice, it may allow real Unix
Xfilenames, in which case you needn't worry about this.)
X
XTHE PAUSE FEATURE. You can pause on an error
Xinside a procedure, so you can examine the context interactively. The
Xpause feature distinguishes SIGINT and SIGQUIT, which were treated identically
Xin earlier releases. In the normal distribution, SIGQUIT returns to toplevel,
Xwhereas SIGINT causes a pause. The problem is with Eunice, which doesn't
Xprovide SIGQUIT because VMS doesn't have enough interrupt characters.
XTherefore, the standard distribution allows pausing but not quitting to
Xtoplevel, although you can say "toplevel" while paused. If you'd rather
Xhave quitting be the default, as in previous releases, interchange the
Xdefinitions of PAUSESIG and OTHERSIG in logo.h; there are also commands
Xto allow the user to make this switch dynamically.
X
X(Eunice users: Until just recently, an obscure bug in Eunice had the effect
Xthat when you type ^C you don't see a prompt until you hit return. The switch
Xcalled EUNICE in logo.h enables a workaround for this bug. Dave Kashtan has
Xnow fixed the underlying problem, but not necessarily in the version you have.
XIf you get too few prompts, turn on the #define EUNICE; if too many prompts,
Xturn it off.)
X
X-----
XINSTALLATION etc.
X
XSaying "make install" after you compile your Logo will install Logo in
X/bin/logo and will also set up two directories:
X /usr/lib/logo Library routines written in Logo for general use
X Also stuff for edit and pots commands.
X /usr/doc/logo Excerpts from the manual for the "describe" command
XThe files in these directories are copied, not moved; you can delete the
Xoriginals if you prefer. See the makefile. These directories must have
Xthe names shown here, although you can put logo itself somewhere other than
X/bin if you prefer.
X
XThere are three C source files included here which are not part of the Logo
Xinterpreter itself. One, logohead.c, is used to compile the program
X/usr/lib/logo/logohead which is used for the pots command. Another,
Xsplithelp.c, is part of the makehelp shell script which is used to generate
Xthe online help messages from the manual. The third C file,
Xdr11k.c, is a device driver for version 7 for a DEC DR11-K used to interface
XTerrapin floor turtles (you get two per DR11-K) to the PDP-11. The interface
Xcosts much more than the turtles!
X
XINCOMPATIBILITY WITH RELEASE 2. (This release is VERY incompatible with
Xrelease 1; see the file olddiff for details.) To be compatible
Xwith VMS restricted filenames, to run under Eunice, the names of files used
Xto store Logo procedure definitions have been changed from foo.logo to
Xfoo.lg (some installations have a version of release 2 in which the name
Xfoo.log is used, but that looks too much like a log file from a batch job;
Xthe new version seems more Unixy anyway). If you prefer to keep the old
Xconvention of .logo names, turn on the definition of EXTLOGO in logo.h.
X
XCheck your makefile to be sure it refers to "y.tab.c" and "y.tab.o" on
XUnix, "ytab.c" and "ytab.o" on Eunice. (Again, some versions of Eunice
Xuse the real Unix filenames.)
X
XIf you have questions about this Logo, try
X Computer Department
X Lincoln-Sudbury Regional High School
X 390 Lincoln Road
X Sudbury, MA 01776
X 617 443-9961
X
END_OF_README
if test 10027 -ne `wc -c <README`; then
echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f adm.i -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"adm.i\"
else
echo shar: Extracting \"adm.i\" \(1444 characters\)
sed "s/^X//" >adm.i <<'END_OF_adm.i'
X/* Include file for turtle.c for ADM with Retrographics board */
X
Xint admturt(),admfrom(),admto(),admstate();
Xstruct display adm ={0.0,0.0,0.0,-512.0,511.0,-390.0,389.0,1.0,0,
X "","\032\035\033\014\030","","\032\035\033\014\030",
X admturt,admfrom,admto,nullfn,nullfn,nullfn,
X nullfn,nullfn,nullfn,admstate};
X
Xadmturt(hide)
Xint hide; /* nonzero to erase turtle */
X{
X double newx,newy,angle;
X
X printf("\035");
X angle = (mydpy->turth-90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X printf(hide ? "\033\177" : "\033a");
X plotpos((int)newx,(int)(yscrunch*newy));
X angle = mydpy->turth*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X plotpos((int)newx,(int)(yscrunch*newy));
X angle = (mydpy->turth+90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X plotpos((int)newx,(int)(yscrunch*newy));
X angle = (mydpy->turth-90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X plotpos((int)newx,(int)(yscrunch*newy));
X printf("\037\030");
X}
X
Xadmfrom(x,y)
Xdouble x,y;
X{
X printf("\035");
X printf(penerase ? "\033\177" : "\033a");
X plotpos((int)x,(int)y);
X}
X
Xadmto(x,y)
Xdouble x,y;
X{
X plotpos((int)x,(int)y);
X printf("\037\030");
X}
X
Xadmstate(which) {
X if (which=='R') {
X printf("ADM can't penreverse, setting pendown.\n");
X penerase = 0;
X }
X}
X
END_OF_adm.i
if test 1444 -ne `wc -c <adm.i`; then
echo shar: \"adm.i\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f admtek.i -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"admtek.i\"
else
echo shar: Extracting \"admtek.i\" \(249 characters\)
sed "s/^X//" >admtek.i <<'END_OF_admtek.i'
X
X/* Include file for turtle.c for both ADM and TEK */
X
Xplotpos(x,y)
Xint x,y;
X{
X char s[5];
X
X x += 512;
X y += 390;
X s[0] = 040 + ((y>>5)&037);
X s[1] = 0140 + (y&037);
X s[2] = 040 + ((x>>5)&037);
X s[3] = 0100 + (x&037);
X s[4] = 0;
X printf("%s",s);
X}
X
END_OF_admtek.i
if test 249 -ne `wc -c <admtek.i`; then
echo shar: \"admtek.i\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f atari.i -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"atari.i\"
else
echo shar: Extracting \"atari.i\" \(2230 characters\)
sed "s/^X//" >atari.i <<'END_OF_atari.i'
X
X/* Include file for turtle.c for Atari 800 as graphics terminal */
X
Xint ataturn(),apenc(),asetc(),astate();
XNUMBER ncheck();
X
Xstruct display bwatari ={0.0,0.0,0.0,-160.0,160.0,-96.0,96.0,0.875,0,
X "\033#G","\033c","\033.t","\033.c",
X nullfn,nullfn,nullfn,nullfn,nullfn,nullfn,ataturn,
X apenc,asetc,astate};
Xstruct display colatari ={0.0,0.0,0.0,-80.0,80.0,-48.0,48.0,0.875,0,
X "\033#G","\033c","\033.t","\033.c",
X nullfn,nullfn,nullfn,nullfn,nullfn,nullfn,ataturn,
X apenc,asetc,astate};
X
Xataturn() {
X printf("\033.%dh",(int)((mydpy->turth+11.0)/22.5));
X}
X
Xapenc(ipen)
Xregister int ipen;
X{
X if ((ipen<0) || (ipen>6)) {
X puts("Bad pen color, must be 0 to 6.");
X errhand();
X }
X mydpy = (ipen ? &colatari : &bwatari);
X printf("\033.%dP",ipen);
X if (!(mydpy->cleared)) {
X printf("\033.c"); /* clear screen */
X mydpy->cleared++;
X }
X
X /* this is to fix bug in Atari program */
X printf("\033.%dh",(int)((mydpy->turth+11.0)/22.5));
X}
X
Xasetc(ipen,colorlist)
Xregister int ipen;
Xstruct object *colorlist;
X{
X register struct object *next;
X register int icolor,intens;
X static int normint[] = {1,5,5,1};
X NUMBER number;
X
X if ((ipen<0) || (ipen>3)) {
X puts("Pen number must be 0 to 3.");
X errhand();
X }
X
X if (listp(colorlist)) {
X number = ncheck(localize(colorlist->obcar));
X icolor = number;
X next = colorlist->obcdr;
X number = ncheck(localize(next->obcar));
X intens = number;
X mfree(colorlist);
X } else {
X number = ncheck(colorlist);
X icolor = number;
X intens = normint[ipen];
X }
X if ((icolor<0) || (icolor>15) || (intens<0) || (intens>7)) {
X puts("Invalid color numbers.");
X errhand();
X }
X printf("\033.%d;%dC",ipen,(icolor*16)+(intens*2));
X}
X
Xastate(which) {
X switch(which) {
X case 'c':
X fflush(stdout);
X sleep(1);
X case '*':
X return;
X case 'w':
X fflush(stdout);
X sleep(1);
X ataturn();
X printf("\033.U\033.%d;%dG",
X (int)(yscrunch*mydpy->turty),(int)(mydpy->turtx));
X if (pendown)
X printf("\033.%c","DER"[penerase]);
X return;
X case 'G':
X printf("\033.%d;%dG",
X (int)(yscrunch*mydpy->turty),(int)(mydpy->turtx));
X return;
X case 'R':
X printf("Atari can't penreverse; setting pendown.\n");
X penerase = 0;
X which = 'D';
X /* falls into */
X default:
X printf("\033.%c",which);
X }
X}
X
END_OF_atari.i
if test 2230 -ne `wc -c <atari.i`; then
echo shar: \"atari.i\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f dr11k.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"dr11k.c\"
else
echo shar: Extracting \"dr11k.c\" \(2022 characters\)
sed "s/^X//" >dr11k.c <<'END_OF_dr11k.c'
X
X/*
X * Driver for Terrapin turtles interfaced via DR11-K.
X * Based on DR-11C driver Copyright (c) 1978, the Children's Museum.
X * This version by Brian Harvey, Lincoln-Sudbury Regional High School.
X */
X
X#include "../h/param.h"
X#include "../h/dir.h"
X#include "../h/user.h"
X
X/* The hardware registers */
Xstruct dr {
X int drcsr;
X char dribuf[2];
X char drobuf[2];
X};
X
X#define NTURTDR 1 /* Number of DR11Ks for turtles (2 turtles per DR) */
X
Xstruct dr *dr_addr[2] = { (struct dr *)0167770, (struct dr *)0167760};
X
Xstruct turt {
X struct proc *procp;
X int time;
X char turnoff;
X} turtle[2*NTURTDR];
X
Xstruct turtcmd {
X char cmd,bits;
X} trans[] ={
X 'f', 05, /* forward */
X 'b',012, /* back */
X 'l',011, /* left */
X 'r', 06, /* right */
X 'P', 0200, /* pen down */
X 'H', 060, /* high horn */
X 'L', 040, /* low horn */
X 'B', 0100, /* headlights (bright) */
X};
X
X#define NCMDS (sizeof(trans) / sizeof(struct turtcmd))
X
Xturtopen(dev,flag) {
X dev = minor(dev);
X if (dev >= 2*NTURTDR) {
X u.u_error = ENXIO;
X return;
X }
X if (turtle[dev].procp) {
X u.u_error = EBUSY;
X return;
X }
X turtle[dev].procp = u.u_procp;
X}
X
Xturtclose(dev) {
X dev = minor(dev);
X turtle[dev].procp = 0;
X turtle[dev].time = 0;
X dr_addr[dev>>1]->drobuf[dev&01] = -1;
X}
X
Xturttimo(dev) {
X spl5();
X dr_addr[dev>>1]->drobuf[dev&01] |= turtle[dev].turnoff;
X turtle[dev].time = 0;
X wakeup(&turtle[dev]);
X spl0();
X}
X
Xturtwrite(dev) {
X register c,i;
X
X dev = minor(dev);
X c = cpass();
X if (c < 0) return;
X for (i=0; i<NCMDS; i++) {
X if (c == trans[i].cmd) goto good;
X }
X cpass();
X u.u_error = EIO;
X return;
Xgood:
X spl5();
X if((turtle[dev].time = 2*cpass()) < 0) { /* BH 8/25/80 2* */
X turtle[dev].time = 0;
X spl0();
X u.u_error = EIO;
X return;
X }
X dr_addr[dev>>1]->drobuf[dev&01] &= ~trans[i].bits;
X if (turtle[dev].time) {
X turtle[dev].turnoff = trans[i].bits;
X timeout(turttimo,dev,turtle[dev].time);
X while(turtle[dev].time)
X sleep(&turtle[dev],9);
X }
X spl0();
X}
X
Xturtread(dev) {
X register c;
X
X dev = minor(dev);
X c = dr_addr[dev>>1]->dribuf[dev&01];
X passc(c);
X}
X
END_OF_dr11k.c
if test 2022 -ne `wc -c <dr11k.c`; then
echo shar: \"dr11k.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f gigi.i -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"gigi.i\"
else
echo shar: Extracting \"gigi.i\" \(2132 characters\)
sed "s/^X//" >gigi.i <<'END_OF_gigi.i'
X
X/* Include file for turtle.c for GIGI */
X
Xint gigiturt(),gigifrom(),gigito(),gtcheck(),gpenc(),gstate();
Xstruct display gigi ={0.0,0.0,0.0,-384.0,383.0,-240.0,239.0,0.8,0,
X "\033PpS(E)P[384,240]\033\\\033PrSM0\033\\\033[20;1H",
X "\033PrSM2\033\\\033PpS(E)\033\\",
X "\033PrSM2\033\\\033PpS(E)\033\\",
X "\033PpS(E)\033\\",
X gigiturt,gigifrom,gigito,gtcheck,nullfn,nullfn,nullfn,
X gpenc,nullfn,gstate};
X
Xchar *gigipens[] = {"W(R)","W(E)","W(C)"};
X
Xgtcheck() {
X if (textmode) {
X printf("Not in text mode!\n");
X errhand();
X }
X}
X
Xgmovepos(x,y)
Xint x,y;
X{
X char s[5];
X
X x += 384;
X y = 240 - y;
X printf("P[%d,%d]",x,y);
X}
X
Xgplotpos(x,y)
Xint x,y;
X{
X char s[5];
X
X x += 384;
X y = 240 - y;
X printf("V[%d,%d]",x,y);
X}
X
Xgigifrom(oldx,oldy)
Xdouble oldx,oldy;
X{
X printf("\033Pp");
X gmovepos((int)oldx,(int)oldy);
X}
X
Xgigito(newx,newy)
Xdouble newx,newy;
X{
X printf(gigipens[penerase]);
X gplotpos((int)newx,(int)newy);
X printf("\033\\");
X}
X
Xgigiturt()
X{
X double newx,newy,angle;
X
X printf("\033PpW(C)");
X angle = (mydpy->turth-90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X gmovepos((int)newx,(int)(yscrunch*newy));
X angle = mydpy->turth*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X gplotpos((int)newx,(int)(yscrunch*newy));
X angle = (mydpy->turth+90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X gplotpos((int)newx,(int)(yscrunch*newy));
X angle = (mydpy->turth-90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X gplotpos((int)newx,(int)(yscrunch*newy));
X printf(gigipens[penerase]);
X printf("\033\\");
X}
X
Xgpenc(ipen)
Xregister int ipen;
X{
X if ((ipen<0) || (ipen>7)) {
X puts("Bad pen color, must be 0 to 7.");
X errhand();
X }
X printf("\033PpW(I%d)\033\\",ipen);
X}
X
Xgstate(which) {
X switch (which) {
X case 't':
X printf("\033PrSM2\033\\\033PpS(E)\033\\");
X break;
X case 's':
X case 'f':
X printf("\033PrSM0\033\\\033PpS(E)\033\\");
X if (textmode && shown) gigiturt();
X break;
X case '*':
X printf("\033[K");
X }
X}
X
END_OF_gigi.i
if test 2132 -ne `wc -c <gigi.i`; then
echo shar: \"gigi.i\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f helpfile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"helpfile\"
else
echo shar: Extracting \"helpfile\" \(398 characters\)
sed "s/^X//" >helpfile <<'END_OF_helpfile'
X
XLogo is an interactive procedural programming language designed for
Xeducation. The file
X /usr/src/cmd/logo/logoman
Xis an nroff-format logo manual. To find out about a particular Logo
Xprimitive, use the "describe" command with the name of the primitive as
Xits input, e.g.
X describe "print
Xto see the description of the print command.
X
XThe command to leave Logo is "goodbye" (abbreviated "bye").
X
END_OF_helpfile
if test 398 -ne `wc -c <helpfile`; then
echo shar: \"helpfile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d library ; then
echo shar: Creating directory \"library\"
mkdir library
fi
if test -f library/beep.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/beep.lg\"
else
echo shar: Extracting \"library/beep.lg\" \(27 characters\)
sed "s/^X//" >library/beep.lg <<'END_OF_library/beep.lg'
X
Xto beep :n
Xhitoot :n
Xend
X
END_OF_library/beep.lg
if test 27 -ne `wc -c <library/beep.lg`; then
echo shar: \"library/beep.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/f.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/f.lg\"
else
echo shar: Extracting \"library/f.lg\" \(38 characters\)
sed "s/^X//" >library/f.lg <<'END_OF_library/f.lg'
X
Xto f :thing
Xoutput first :thing
Xend
X
END_OF_library/f.lg
if test 38 -ne `wc -c <library/f.lg`; then
echo shar: \"library/f.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/g.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/g.lg\"
else
echo shar: Extracting \"library/g.lg\" \(70 characters\)
sed "s/^X//" >library/g.lg <<'END_OF_library/g.lg'
X
Xto g
Xpr [The abbreviation for 'goodbye' is now 'bye', not 'g'.]
Xend
X
END_OF_library/g.lg
if test 70 -ne `wc -c <library/g.lg`; then
echo shar: \"library/g.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/gigimove.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/gigimove.lg\"
else
echo shar: Extracting \"library/gigimove.lg\" \(151 characters\)
sed "s/^X//" >library/gigimove.lg <<'END_OF_library/gigimove.lg'
X
XREPLACE THE TWO-CHAR SEQUENCE ^[ WITH AN ESCAPE, TWICE IN THIS FILE
Xto gigimove :x :y
Xtype "^[PpP\[
Xtype :x+384
Xtype ",
Xtype 240-:y
Xtype "\]^[\\
Xend
X
END_OF_library/gigimove.lg
if test 151 -ne `wc -c <library/gigimove.lg`; then
echo shar: \"library/gigimove.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/hanoi.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/hanoi.lg\"
else
echo shar: Extracting \"library/hanoi.lg\" \(190 characters\)
sed "s/^X//" >library/hanoi.lg <<'END_OF_library/hanoi.lg'
X
Xto hanoi :number :from :to :other
Xif equalp :number 0 [stop]
Xhanoi :number-1 :from :other :to
Xprint {sentence [Move disk] :number "from :from "to :to}
Xhanoi :number-1 :other :to :from
Xend
X
END_OF_library/hanoi.lg
if test 190 -ne `wc -c <library/hanoi.lg`; then
echo shar: \"library/hanoi.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/home.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/home.lg\"
else
echo shar: Extracting \"library/home.lg\" \(31 characters\)
sed "s/^X//" >library/home.lg <<'END_OF_library/home.lg'
X
Xto home
Xsetxy 0 0
Xseth 0
Xend
X
END_OF_library/home.lg
if test 31 -ne `wc -c <library/home.lg`; then
echo shar: \"library/home.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/howis.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/howis.lg\"
else
echo shar: Extracting \"library/howis.lg\" \(135 characters\)
sed "s/^X//" >library/howis.lg <<'END_OF_library/howis.lg'
X
Xto howis :whatever
Xif equalp first :whatever "w output "wonderful
Xif equalp first :whatever "t output "terrific
Xoutput "ordinary
Xend
X
END_OF_library/howis.lg
if test 135 -ne `wc -c <library/howis.lg`; then
echo shar: \"library/howis.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/l.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/l.lg\"
else
echo shar: Extracting \"library/l.lg\" \(37 characters\)
sed "s/^X//" >library/l.lg <<'END_OF_library/l.lg'
X
Xto l :thing
Xoutput last :thing
Xend
X
END_OF_library/l.lg
if test 37 -ne `wc -c <library/l.lg`; then
echo shar: \"library/l.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/laugh.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/laugh.lg\"
else
echo shar: Extracting \"library/laugh.lg\" \(47 characters\)
sed "s/^X//" >library/laugh.lg <<'END_OF_library/laugh.lg'
X
Xto laugh
Xpr "ha
Xpr [ha ha]
Xpr [ha ha ha]
Xend
X
END_OF_library/laugh.lg
if test 47 -ne `wc -c <library/laugh.lg`; then
echo shar: \"library/laugh.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/listp.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/listp.lg\"
else
echo shar: Extracting \"library/listp.lg\" \(58 characters\)
sed "s/^X//" >library/listp.lg <<'END_OF_library/listp.lg'
X
Xto listp :listpobject
Xoutput not wordp :listpobject
Xend
X
END_OF_library/listp.lg
if test 58 -ne `wc -c <library/listp.lg`; then
echo shar: \"library/listp.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/pick.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/pick.lg\"
else
echo shar: Extracting \"library/pick.lg\" \(55 characters\)
sed "s/^X//" >library/pick.lg <<'END_OF_library/pick.lg'
X
Xto pick :list
Xoutput nth 1+rnd count :list :list
Xend
X
END_OF_library/pick.lg
if test 55 -ne `wc -c <library/pick.lg`; then
echo shar: \"library/pick.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/poly.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/poly.lg\"
else
echo shar: Extracting \"library/poly.lg\" \(87 characters\)
sed "s/^X//" >library/poly.lg <<'END_OF_library/poly.lg'
X
Xto poly :side :ang :num
Xif :num=0 [stop]
Xfd :side
Xrt :ang
Xpoly :side :ang :num-1
Xend
X
END_OF_library/poly.lg
if test 87 -ne `wc -c <library/poly.lg`; then
echo shar: \"library/poly.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/pos.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/pos.lg\"
else
echo shar: Extracting \"library/pos.lg\" \(35 characters\)
sed "s/^X//" >library/pos.lg <<'END_OF_library/pos.lg'
X
Xto pos
Xoutput list xcor ycor
Xend
X
END_OF_library/pos.lg
if test 35 -ne `wc -c <library/pos.lg`; then
echo shar: \"library/pos.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/quest.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/quest.lg\"
else
echo shar: Extracting \"library/quest.lg\" \(146 characters\)
sed "s/^X//" >library/quest.lg <<'END_OF_library/quest.lg'
X
Xto quest :question :answer
Xtype :question
Xif equalp request :answer [print [You're right!] ; stop]
Xprint sentence [No, silly, it's] :answer
Xend
X
END_OF_library/quest.lg
if test 146 -ne `wc -c <library/quest.lg`; then
echo shar: \"library/quest.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/quiz1.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/quiz1.lg\"
else
echo shar: Extracting \"library/quiz1.lg\" \(163 characters\)
sed "s/^X//" >library/quiz1.lg <<'END_OF_library/quiz1.lg'
X
Xto quiz1
Xtype [Who is the greatest musician of all time]
Xif equalp request [John Lennon] [print [You're right!] ; stop]
Xprint [No, silly, it's John Lennon!]
Xend
X
END_OF_library/quiz1.lg
if test 163 -ne `wc -c <library/quiz1.lg`; then
echo shar: \"library/quiz1.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setcursor.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setcursor.lg\"
else
echo shar: Extracting \"library/setcursor.lg\" \(63 characters\)
sed "s/^X//" >library/setcursor.lg <<'END_OF_library/setcursor.lg'
X
Xto setcursor :place
Xsetcursorxy first :place last :place
Xend
X
END_OF_library/setcursor.lg
if test 63 -ne `wc -c <library/setcursor.lg`; then
echo shar: \"library/setcursor.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setheight.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setheight.lg\"
else
echo shar: Extracting \"library/setheight.lg\" \(56 characters\)
sed "s/^X//" >library/setheight.lg <<'END_OF_library/setheight.lg'
X
Xto setheight :height
Xmake "gigitextheight :height
Xend
X
END_OF_library/setheight.lg
if test 56 -ne `wc -c <library/setheight.lg`; then
echo shar: \"library/setheight.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setitalic.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setitalic.lg\"
else
echo shar: Extracting \"library/setitalic.lg\" \(54 characters\)
sed "s/^X//" >library/setitalic.lg <<'END_OF_library/setitalic.lg'
X
Xto setitalic :slant
Xmake "gigitextitalic :slant
Xend
X
END_OF_library/setitalic.lg
if test 54 -ne `wc -c <library/setitalic.lg`; then
echo shar: \"library/setitalic.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setpos.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setpos.lg\"
else
echo shar: Extracting \"library/setpos.lg\" \(72 characters\)
sed "s/^X//" >library/setpos.lg <<'END_OF_library/setpos.lg'
X
Xto setpos :setposplace
Xsetxy first :setposplace last :setposplace
Xend
X
END_OF_library/setpos.lg
if test 72 -ne `wc -c <library/setpos.lg`; then
echo shar: \"library/setpos.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setsize.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setsize.lg\"
else
echo shar: Extracting \"library/setsize.lg\" \(48 characters\)
sed "s/^X//" >library/setsize.lg <<'END_OF_library/setsize.lg'
X
Xto setsize :size
Xmake "gigitextsize :size
Xend
X
END_OF_library/setsize.lg
if test 48 -ne `wc -c <library/setsize.lg`; then
echo shar: \"library/setsize.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setslant.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setslant.lg\"
else
echo shar: Extracting \"library/setslant.lg\" \(55 characters\)
sed "s/^X//" >library/setslant.lg <<'END_OF_library/setslant.lg'
X
Xto setslant :slant
Xmake "gigitextslant 45*:slant
Xend
X
END_OF_library/setslant.lg
if test 55 -ne `wc -c <library/setslant.lg`; then
echo shar: \"library/setslant.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setslope.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setslope.lg\"
else
echo shar: Extracting \"library/setslope.lg\" \(55 characters\)
sed "s/^X//" >library/setslope.lg <<'END_OF_library/setslope.lg'
X
Xto setslope :slope
Xmake "gigitextslope 45*:slope
Xend
X
END_OF_library/setslope.lg
if test 55 -ne `wc -c <library/setslope.lg`; then
echo shar: \"library/setslope.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/setx.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/setx.lg\"
else
echo shar: Extracting \"library/setx.lg\" \(47 characters\)
sed "s/^X//" >library/setx.lg <<'END_OF_library/setx.lg'
X
Xto setx :setxcoord
Xsetxy :setxcoord ycor
Xend
X
END_OF_library/setx.lg
if test 47 -ne `wc -c <library/setx.lg`; then
echo shar: \"library/setx.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/sety.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/sety.lg\"
else
echo shar: Extracting \"library/sety.lg\" \(47 characters\)
sed "s/^X//" >library/sety.lg <<'END_OF_library/sety.lg'
X
Xto sety :setycoord
Xsetxy xcor :setycoord
Xend
X
END_OF_library/sety.lg
if test 47 -ne `wc -c <library/sety.lg`; then
echo shar: \"library/sety.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/textprint.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/textprint.lg\"
else
echo shar: Extracting \"library/textprint.lg\" \(442 characters\)
sed "s/^X//" >library/textprint.lg <<'END_OF_library/textprint.lg'
X
XREPLACE THE TWO-CHAR SEQUENCE ^[ WITH AN ESCAPE, TWICE IN THIS FILE
Xto textprint :text
Xgigimove xcor ycor
Xtype "^[PpT\(B
Xif namep "gigitextslope [type "D; type :gigitextslope]
Xif namep "gigitextsize [type "S; type :gigitextsize]
Xif namep "gigitextslant [type "D; type :gigitextslant]
Xif namep "gigitextheight [type "H; type :gigitextheight]
Xif namep "gigitextitalic [type "I; type :gigitextitalic]
Xtype "\)'
Xtype :text
Xtype "'\(E\)^[\\
Xend
X
END_OF_library/textprint.lg
if test 442 -ne `wc -c <library/textprint.lg`; then
echo shar: \"library/textprint.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/top.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/top.lg\"
else
echo shar: Extracting \"library/top.lg\" \(22 characters\)
sed "s/^X//" >library/top.lg <<'END_OF_library/top.lg'
X
Xto top
Xtoplevel
Xend
X
END_OF_library/top.lg
if test 22 -ne `wc -c <library/top.lg`; then
echo shar: \"library/top.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f library/towards.lg -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"library/towards.lg\"
else
echo shar: Extracting \"library/towards.lg\" \(60 characters\)
sed "s/^X//" >library/towards.lg <<'END_OF_library/towards.lg'
X
Xto towards :pos
Xoutput towardsxy first :pos last :pos
Xend
X
END_OF_library/towards.lg
if test 60 -ne `wc -c <library/towards.lg`; then
echo shar: \"library/towards.lg\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f logohead.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"logohead.c\"
else
echo shar: Extracting \"logohead.c\" \(310 characters\)
sed "s/^X//" >logohead.c <<'END_OF_logohead.c'
X
X/* Print the first line of selected files. Used by Logo pots command. */
X
X#include <stdio.h>
X
Xmain(argc,argv)
Xint argc;
Xchar **argv;
X{
X FILE *fp;
X char line[100];
X
X while (--argc > 0) {
X if ((fp = fopen(argv[1],"r")) != NULL) {
X fgets(line,100,fp);
X printf("%s",line);
X fclose(fp);
X }
X argv++;
X }
X}
X
END_OF_logohead.c
if test 310 -ne `wc -c <logohead.c`; then
echo shar: \"logohead.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f main.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"main.c\"
else
echo shar: Extracting \"main.c\" \(1080 characters\)
sed "s/^X//" >main.c <<'END_OF_main.c'
X
X/* This provides the outermost framework of LOGO, calling the parser to
X * begin with, and then thereafter whenever an interrupt or error occurs.
X * Copyright (C) 1979, The Children's Museum, Boston, Mass.
X * Written by Douglas B. Klunder.
X */
X
X#include "logo.h"
X
Xchar editfile[30];
Xextern char *getbpt;
X#ifndef NOTURTLE
Xextern int turtdes;
Xextern struct display *mydpy;
X#endif
X#ifdef SETCURSOR
X#include <sgtty.h>
Xstruct sgttyb tty;
X#endif
X
Xmain(argc,argv)
Xint argc;
Xchar *argv[];
X{
X int i[2];
X char tbuff[BUFSIZ];
X
X setbuf(stdout,tbuff);
X time(i);
X SRAND(i[1]+i[0]);
X sprintf(editfile,"/tmp/logo%u",(short)getpid());
X#ifdef SETCURSOR
X gtty(1,&tty);
X#endif
X if (argc>1)
X getbpt = argv[1];
X else
X printf("\nWelcome to Children's Museum/LSRHS LOGO\n?");
X fflush(stdout);
X while (enter()==1) {
X yyprompt(1);
X }
X cboff();
X#ifdef SETCURSOR
X stty(1,&tty);
X#endif
X#ifndef NOTURTLE
X#ifdef FLOOR
X if (turtdes>0)
X printf("Please\007 unplug the turtle\007 and put it\007 away.\n");
X#endif
X if (turtdes<0) {
X printf(mydpy->finish);
X (*mydpy->outfn)();
X }
X#endif
X unlink(editfile);
X}
X
END_OF_main.c
if test 1080 -ne `wc -c <main.c`; then
echo shar: \"main.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"makefile\"
else
echo shar: Extracting \"makefile\" \(717 characters\)
sed "s/^X//" >makefile <<'END_OF_makefile'
X
Xall: logo logohead
X
Xlogo: y.tab.o logoparse.o zerr.o main.o logoop.o logoaux.o unix.o \
Xstorage.o turtle.o procedit.o logonum.o procvars.o logoproc.o proplist.o
X ld -X -i -o logo /lib/crt0.o *.o -lm -lc -ltermlib
X
Xy.tab.c: logo.y
X yacc logo.y
X
Xturtle.c: atari.i gigi.i adm.i tek.i admtek.i sun.i
X touch turtle.c
X
Xlogohead: logohead.c
X cc -O -o logohead logohead.c
X
Xhelp: splithelp logoman
X ./makehelp
X
Xsplithelp: splithelp.c
X cc -O -o splithelp splithelp.c
X
X.c.o: ;cc -O -c $*.c
X
Xinstall:
X cp logo /bin/logo
X mkdir /usr/doc/logo
X cp help/* /usr/doc/logo
X cp helpfile applediff olddiff /usr/doc/logo
X mkdir /usr/lib/logo
X cp library/* /usr/lib/logo
X cp logohead /usr/lib/logo
X
Xclean:
X rm *.o logo logohead splithelp
X
END_OF_makefile
if test 717 -ne `wc -c <makefile`; then
echo shar: \"makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f makehelp -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"makehelp\"
else
echo shar: Extracting \"makehelp\" \(35 characters\)
sed "s/^X//" >makehelp <<'END_OF_makehelp'
Xed - logoman << 'foo'
X1i
X.pl 999i
X
END_OF_makehelp
if test 35 -ne `wc -c <makehelp`; then
echo shar: \"makehelp\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f proplist.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"proplist.c\"
else
echo shar: Extracting \"proplist.c\" \(3698 characters\)
sed "s/^X//" >proplist.c <<'END_OF_proplist.c'
X
X/* Property list primitives */
X
X#include "logo.h"
X
X#ifndef SMALL
X
Xstruct property {
X char *prname;
X struct object *prvalue;
X struct property *prnext;
X};
X
Xstruct proplist {
X char *plname;
X struct property *props;
X struct proplist *plnext;
X} *allprops = NULL;
X
Xstruct proplist *findplist(var)
Xchar *var;
X{
X register struct proplist *plp;
X
X for (plp=allprops; plp; plp=plp->plnext)
X if (!strcmp(var,plp->plname)) return(plp);
X return(0);
X}
X
Xstruct property *findprop(prp,name)
Xregister struct property *prp;
Xchar *name;
X{
X for (; prp; prp=prp->prnext)
X if (!strcmp(name,prp->prname)) return(prp);
X return(0);
X}
X
Xpprop(name,prop,object)
Xstruct object *name,*prop,*object;
X{
X char *nstr;
X register struct proplist *plp;
X register struct property *prp,*prp1;
X
X if (!stringp(name)) ungood("Pprop",name);
X if (!stringp(prop)) ungood("Pprop",prop);
X if ((plp=findplist(token(name->obstr)))==0) {
X plp=(struct proplist *)ckmalloc(sizeof(struct proplist));
X nstr = ckmalloc(1+strlen(name->obstr));
X strcpy(nstr,token(name->obstr));
X plp->plname = nstr;
X plp->props = 0;
X plp->plnext = allprops;
X allprops = plp;
X }
X prp = plp->props;
X if (prp1 = findprop(prp,prop->obstr)) {
X lfree(prp1->prvalue);
X } else {
X prp1 = (struct property *)ckmalloc(sizeof(struct property));
X nstr = ckmalloc(1+strlen(prop->obstr));
X strcpy(nstr,token(prop->obstr));
X prp1->prname = nstr;
X prp1->prnext = prp;
X plp->props = prp1;
X }
X prp1->prvalue = globcopy(object);
X mfree(name);
X mfree(prop);
X mfree(object);
X}
X
Xremprop(name,prop)
Xstruct object *name,*prop;
X{
X register struct proplist *plp;
X register struct property *prp,*prp1;
X
X if (!stringp(name)) ungood("Remprop",name);
X if (!stringp(prop)) ungood("Remprop",prop);
X if ((plp=findplist(token(name->obstr)))==0) {
X pf1("%p has no properties\n",name);
X errhand();
X }
X prp = plp->props;
X for (prp1=0; prp; prp=prp->prnext) {
X if (!strcmp(prp->prname,token(prop->obstr))) {
X if (prp1)
X prp1->prnext = prp->prnext;
X else
X plp->props = prp->prnext;
X JFREE(prp->prname);
X lfree(prp->prvalue);
X JFREE(prp);
X break;
X }
X prp1 = prp;
X }
X if (prp == 0) {
X pf1("%p has no %p property.\n",name,prop);
X errhand();
X }
X mfree(name);
X mfree(prop);
X}
X
Xstruct object *gprop(name,prop)
Xstruct object *name,*prop;
X{
X register struct proplist *plp;
X register struct property *prp,*prp1;
X
X if (!stringp(name)) ungood("Gprop",name);
X if (!stringp(prop)) ungood("Gprop",prop);
X if ((plp=findplist(token(name->obstr)))==0) {
X mfree(name);
X mfree(prop);
X return(0);
X }
X prp = plp->props;
X if (prp1 = findprop(prp,token(prop->obstr))) {
X mfree(name);
X mfree(prop);
X return(localize(prp1->prvalue));
X } else {
X mfree(name);
X mfree(prop);
X return(0);
X }
X}
X
Xpps() {
X register struct proplist *plp;
X register struct property *prp;
X register char *name;
X
X for (plp=allprops; plp; plp=plp->plnext) {
X name = plp->plname;
X for (prp=plp->props; prp; prp=prp->prnext) {
X pf1("%s's %s is %p\n",name,prp->prname,prp->prvalue);
X }
X }
X}
X
Xstruct object *plist(name)
Xstruct object *name;
X{
X register struct proplist *plp;
X register struct property *prp;
X register struct object *tail;
X struct object *head;
X
X if (!stringp(name)) ungood("Plist",name);
X if ((plp=findplist(token(name->obstr)))==0) {
X mfree(name);
X return(0);
X }
X if ((prp = plp->props)==0) {
X mfree(name);
X return(0);
X }
X head = tail = globcons(0,0);
X for (; prp; prp=prp->prnext) {
X tail->obcar = globcopy(objcpstr(prp->prname));
X tail->obcdr = globcopy(globcons(0,0));
X tail = tail->obcdr;
X tail->obcar = globcopy(prp->prvalue);
X if (prp->prnext) tail->obcdr = globcopy(globcons(0,0));
X else tail->obcdr = 0;
X tail = tail->obcdr;
X }
X mfree(name);
X return(localize(head));
X}
X
X#endif
X
END_OF_proplist.c
if test 3698 -ne `wc -c <proplist.c`; then
echo shar: \"proplist.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f splithelp.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"splithelp.c\"
else
echo shar: Extracting \"splithelp.c\" \(1772 characters\)
sed "s/^X//" >splithelp.c <<'END_OF_splithelp.c'
X
X/*
X * splithelp.c -- turn nroff output of logoman into help files.
X *
X * For this to work, there must be no em dashes in the logoman source
X * except on lines which name primitives. Also, the file which is
X * nroffed isn't the actual logoman, but a version which has been edited
X * by the makehelp shell script (which also runs this program) to change
X * what's where. The algorithm is that a primitive description starts
X * with a line with a dash (represented here as a tilde) and continues
X * until a line with a nonspace, nonempty first character.
X */
X
X#include <stdio.h>
X
Xint memb(ch,str)
Xregister char ch;
Xregister char *str;
X{
X register char ch1;
X
X while (ch1 = *str++)
X if (ch == ch1)
X return(1);
X return(0);
X}
X
Xmain(argc,argv)
Xchar **argv;
X{
X FILE *ip, *op;
X int writing = 0; /* nonzero when writing a file */
X int empty = 0; /* nonzero after an empty line */
X register char *cp;
X char line[100];
X char primitive[30];
X
X if ((ip = fopen(argv[1],"r")) == NULL) {
X printf("Splithelp: Can't read input.\n");
X exit(1);
X }
X
X while (fgets(line,100,ip)) {
X if (memb('~',line)) { /* start new file */
X empty = 0;
X if (writing)
X fclose(op);
X sscanf(line,"%s",primitive);
X if (strlen(primitive) > 9) {
X for (cp = line; *cp && *cp!=':'; cp++) ;
X sscanf(cp+2,"%s",primitive);
X }
X if ((op = fopen(primitive,"w")) == NULL) {
X printf("Splithelp: Can't write output.\n");
X exit(1);
X }
X for (cp = line; *cp != '~'; cp++) ;
X *cp++ = '-';
X *cp = '-';
X fprintf(op,"%s",line);
X writing++;
X } else if (line[0] == '\n') {
X empty++;
X } else if (writing && line[0]==' ') {
X if (empty) fprintf(op,"\n");
X empty = 0;
X fprintf(op,"%s",line);
X } else if (writing) {
X fclose(op);
X writing = 0;
X }
X }
X if (writing) fclose(op);
X}
X
END_OF_splithelp.c
if test 1772 -ne `wc -c <splithelp.c`; then
echo shar: \"splithelp.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f sun.i -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"sun.i\"
else
echo shar: Extracting \"sun.i\" \(1858 characters\)
sed "s/^X//" >sun.i <<'END_OF_sun.i'
X
X/* Include file for turtle.c for Sun Microsystems workstation */
X
X#include <gfx.h>
X/* If we are on a Sun, Logo must be loaded -lgfx */
X
Xint sunturt(),sunfrom(),sunto(),suninit(),sunstate();
Xstruct display sun ={0.0,0.0,0.0,-1000.0,1000.0,-1000.0,1000.0,1.0,0,
X "","","","",sunturt,sunfrom,sunto,nullfn,suninit,nullfn,
X nullfn,nullfn,nullfn,sunstate};
X
XNUMBER sunoldx,sunoldy;
X
Xtransline(type,fromx,fromy,tox,toy) {
X line(type,fromx+screen.w/2,screen.h/2-fromy,tox+screen.w/2,
X screen.h/2-toy);
X}
X
Xsunturt(hide)
Xint hide; /* nonzero to erase turtle */
X{
X double newx,newy,oldx,oldy,angle;
X
X angle = (mydpy->turth-90.0)*3.141592654/180.0;
X oldx = mydpy->turtx + 15.0*sin(angle);
X oldy = mydpy->turty + 15.0*cos(angle);
X angle = mydpy->turth*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X transline(GXinvert,(int)oldx,(int)(yscrunch*oldy),
X (int)newx,(int)(yscrunch*newy));
X oldx = newx;
X oldy = newy;
X angle = (mydpy->turth+90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X transline(GXinvert,(int)oldx,(int)(yscrunch*oldy),
X (int)newx,(int)(yscrunch*newy));
X oldx = newx;
X oldy = newy;
X angle = (mydpy->turth-90.0)*3.141592654/180.0;
X newx = mydpy->turtx + 15.0*sin(angle);
X newy = mydpy->turty + 15.0*cos(angle);
X transline(GXinvert,(int)oldx,(int)(yscrunch*oldy),
X (int)newx,(int)(yscrunch*newy));
X}
X
Xsuninit() {
X initscreen();
X drasterop(GXset,0,0,SCREEN,1024,1024);
X}
X
Xsunfrom(x,y)
XNUMBER x,y;
X{
X sunoldx = x;
X sunoldy = y;
X}
X
Xsunto(x,y)
XNUMBER x,y;
X{
X static int sunpens[] = {GXclear,GXset,GXinvert};
X /* NOTE should be set,clear but it works this way, why??? */
X
X transline((sunpens[penerase],
X (int)sunoldx,(int)sunoldy,(int)x,(int)y);
X}
X
Xsunstate(which) {
X if (which == 'c' || which == 'w')
X drasterop(GXset,0,0,SCREEN,1024,1024);
X}
X
END_OF_sun.i
if test 1858 -ne `wc -c <sun.i`; then
echo shar: \"sun.i\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f tek.i -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"tek.i\"
else
echo shar: Extracting \"tek.i\" \(835 characters\)
sed "s/^X//" >tek.i <<'END_OF_tek.i'
X
X/* Include file for turtle.c for TEK */
X
Xint tekfrom(),tekto(),tekin(),tekout(),tekstate();
Xstruct display tek ={0.0,0.0,0.0,-512.0,511.0,-390.0,389.0,1.0,0,
X "","\032\035\033\014\030","","\032\035\033\014\030",
X nullfn,tekfrom,tekto,nullfn,tekin,tekout,nullfn,
X nullfn,nullfn,tekstate};
X
Xtekfrom(x,y)
Xdouble x,y;
X{
X printf("\035");
X plotpos((int)x,(int)y);
X}
X
Xtekto(x,y)
Xdouble x,y;
X{
X plotpos((int)x,(int)y);
X printf("\035\067\177\040\100\037\030");
X}
X
Xtekin() {
X shown = 0;
X system("stty -lcase");
X}
X
Xtekout() {
X system("stty lcase");
X}
X
Xtekstate(which) {
X switch(which) {
X case 'R':
X printf("Tek can't penreverse, setting pendown\n.");
X penerase = 0;
X return;
X case 'E':
X printf("Tek can't penerase, setting pendown.\n");
X penerase = 0;
X return;
X case 'S':
X printf("Tek can't showturtle.\n");
X shown = 0;
X }
X}
X
END_OF_tek.i
if test 835 -ne `wc -c <tek.i`; then
echo shar: \"tek.i\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f unix.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"unix.c\"
else
echo shar: Extracting \"unix.c\" \(3955 characters\)
sed "s/^X//" >unix.c <<'END_OF_unix.c'
X
X#include "logo.h"
X#include <setjmp.h>
X#include <signal.h>
X
Xchar *ostring;
XFILE *ofile;
X#ifdef DEBUG
Xint memtrace=0;
Xextern int yydebug;
X#endif
X
X#ifdef PAUSE
X
Xint errpause=0;
X
Xseterrpause() {
X errpause++;
X}
X
Xclrerrpause() {
X errpause = 0;
X}
X#endif
X
Xstruct object *stringform(arg)
Xregister struct object *arg;
X{
X char str[IBUFSIZ];
X struct object *bigsave();
X#ifdef DEBUG
X int omemt;
X
X omemt = memtrace;
X memtrace = 0;
X#endif
X ostring = &str[0];
X str[0] = '\0'; /* in case of empty */
X tyobj(arg);
X ostring = 0;
X#ifdef DEBUG
X memtrace = omemt;
X#endif
X return (bigsave(str));
X}
X
Xputch(ch)
Xregister ch;
X{
X if (ch != -1) {
X putchar(ch);
X }
X return (ch);
X}
X
X/* VARARGS */
Xchar *cpystr(to,f1,f2,f3,f4,f5,f6,f7,f8,f9,f0)
Xregister char *to;
Xchar *f1,*f2,*f3,*f4,*f5,*f6,*f7,*f8,*f9,*f0;
X{
X char *out,**in;
X
X out = to;
X in = &f1;
X while (*in) {
X strcpy(out,*in);
X out += strlen(*in);
X in++;
X }
X return (out);
X}
X
Xjmp_buf env;
X
Xextern errrec();
X
Xint floflo() {
X signal(SIGFPE,floflo);
X puts("Arithmetic overflow.");
X errhand();
X}
X
Xenter()
X{
X register x;
X
X if (x=setjmp(env)) {
X return(x);
X } else {
X onintr(errrec,1);
X signal(SIGFPE,floflo);
X return (yyparse());
X }
X}
X
Xleave(val)
X{
X putchar('\n');
X longjmp(env,val);
X}
X
Xint sigarg;
Xint (*intfun)();
Xextern sigquit();
X#ifdef PAUSE
Xint pausesig = PAUSESIG;
Xint othersig = OTHERSIG;
Xint psigflag = 0;
X
Xsigpaws() { /* User signals a pause request */
X signal(pausesig,sigpaws);
X psigflag++;
X}
X#endif
X
Xonintr(inttf,val)
Xregister int (*inttf)(),val;
X{
X sigarg = val;
X#ifdef PAUSE
X signal(othersig,sigquit);
X signal(pausesig,sigpaws);
X#else
X signal(SIGINT,sigquit);
X signal(SIGQUIT,sigquit);
X#endif
X intfun = inttf;
X}
X
X#ifdef DEBUG
Xint deb_quit=0;
X#endif
X
Xsigquit()
X{
X#ifdef DEBUG
X if(deb_quit) abort();
X#endif
X alarm(0);
X#ifdef PAUSE
X signal(othersig,sigquit);
X#else
X signal(SIGINT,sigquit);
X signal(SIGQUIT,sigquit);
X#endif
X (*intfun)(sigarg);
X}
X
X#ifdef DEBUG
Xsetdebquit() {
X deb_quit++;
X}
X
Xsetmemtrace() {
X memtrace++;
X}
X
Xsetyaccdebug() {
X yydebug++;
X}
X#endif
X
X#ifdef PAUSE
Xsetipause() {
X pausesig = SIGINT;
X othersig = SIGQUIT;
X}
X
Xsetqpause() {
X pausesig = SIGQUIT;
X othersig = SIGINT;
X}
X#endif
X
Xputc1(cha)
Xregister cha;
X{
X if(ostring)
X {
X *ostring++=cha;
X *ostring=0;
X }
X else if(ofile)fputc(cha,ofile);
X else putchar(cha);
X}
Xsputs(str)
Xregister char *str;
X{
X register char c;
X
X if(ofile)
X while (c = *str++) fputc(c&0177,ofile);
X else if(ostring){
X while (c = *str++) {
X if (c & 0200) *ostring++ = '\\';
X *ostring++ = c & 0177 ;
X }
X *ostring = '\0';
X }
X else
X while (c = *str++) fputc(c&0177,stdout);
X}
Xnputs(str)
Xregister char *str;
X{
X register char c;
X
X while (c = *str++) fputc(c,stdout);
X}
X
X/*VARARGS*/
Xpf1(str,a1,a2,a3,a4)
Xregister char *str;
Xstruct object *a1,*a2,*a3,*a4;
X{
X register c;
X register struct object **arg;
X#ifdef DEBUG
X int omemt;
X
X omemt = memtrace;
X memtrace = 0;
X#endif
X arg= &a1;
X while(c= *str++){
X if(c=='%'){
X c= *str++;
X if(c=='d'){
X if(ostring){
X sprintf(ostring,"%d",(int)(*arg++));
X ostring+=strlen(ostring);
X }else if(ofile)
X fprintf(ofile,"%d",(int)(*arg++));
X else printf("%d",(int)(*arg++));
X } else if(c=='o'){
X if(ostring){
X sprintf(ostring,"%o",(int)(*arg++));
X ostring+=strlen(ostring);
X }else if(ofile)
X fprintf(ofile,"%o",(int)(*arg++));
X else printf("%o",(int)(*arg++));
X } else if(c=='s'){
X if(ostring){
X strcpy(ostring,(char *)(*arg++));
X ostring += strlen(ostring);
X } else if (ofile)
X fprintf(ofile,"%s",(char *)(*arg++));
X else printf("%s",(char *)(*arg++));
X } else if(c=='l'){
X if(!listp(*arg)){
X if(emptyp(*arg)) sputs("empty");
X else if(stringp(*arg) && !nump(*arg))
X putc1('\"');
X }
X fty1(*arg++);
X } else if(c=='p') {
X if(!stringp(*arg)) {
X *arg=stringform(*arg);
X sputs((*arg)->obstr);
X mfree(*arg);
X } else sputs((*arg)->obstr);
X arg++;
X }
X else putc1(c);
X }
X else putc1(c);
X }
X#ifdef DEBUG
X memtrace = omemt;
X#endif
X}
X
END_OF_unix.c
if test 3955 -ne `wc -c <unix.c`; then
echo shar: \"unix.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f zerr.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"zerr.c\"
else
echo shar: Extracting \"zerr.c\" \(2650 characters\)
sed "s/^X//" >zerr.c <<'END_OF_zerr.c'
X
X/* This file contains most of the error messages for LOGO, along with
X* the functions that print the various messages.
X*
X* Copyright (C) 1979, The Children's Museum, Boston, Mass.
X* Written by Douglas B. Klunder.
X*/
X#include "logo.h"
Xextern int yychar,errtold;
Xextern short yyerrflag;
Xextern char *ibufptr;
Xextern char charib;
Xextern int letflag;
Xextern struct lexstruct keywords[];
X
Xaerr2(etype,arg,op) /* This handles an unknown second input to infix
X * arithmetic operations. */
Xregister char *etype,*arg;
Xchar op;
X{
X if (!errtold) {
X nputs(etype);
X pf1(" of %l and what?\n",arg);
X putchar(op);
X puts(" must have two numbers for inputs.");
X errtold++;
X }
X}
X
Xnotenf(op)
Xregister op;
X{
X if (!errtold) {
X pf1("Not enough inputs to %s.\n",keywords[op].word);
X errtold++;
X }
X}
X
X
Xunerr(c) /* Unknown following unary - or +. */
Xregister char c;
X{
X if (!errtold) {
X putchar(c);
X puts(" what?");
X putchar(c);
X pf1(" must be followed by a number.\n");
X errtold++;
X }
X}
Xinferr(arg,op) /* Incorrect second input to infix operator. */
Xregister char *arg;
Xregister op;
X{
X if (!errtold) {
X switch(op) {
X case '+': aerr2("sum",arg,'+');break;
X case '-': aerr2("difference",arg,'-');break;
X case '*': aerr2("product",arg,'*');break;
X case '/': aerr2("quotient",arg,'/');break;
X case '\\': aerr2("remainder",arg,'\\');break;
X case '<': aerr2("lessp",arg,'<');break;
X case '>': aerr2("greaterp",arg,'>');break;
X case '^': aerr2("pow",arg,'^');break;
X case '=':
X pf1("equalp of %l and what?\n",arg);
X puts("= takes two inputs.");
X }
X errtold++;
X }
X}
Xop2er1(op,arg) /* No second input to two-input operation. */
Xregister op;
Xregister char *arg;
X{
X if (!errtold) {
X nputs(keywords[op].word);
X pf1(" of %l and what?\n",arg);
X nputs(keywords[op].word);
X puts(" takes two inputs.");
X errtold++;
X }
X}
Xterr() /* Incorrect title. */
X{
X puts("That doesn't look like a title to me.");
X errclear();
X}
Xyyerror(str)
Xregister char *str;
X{
X if ( *str == 'y') {
X puts("Too many levels of recursion.");
X errtold++;
X }
X/* yacc has two messages. We ignore "syntax error" which has been dealt with
Xdownlevel already, and on "yacc stack overflow" we must clear out the tables.
X */
X}
X
Xlogoyerror() /* General unknown command. */
X{
X if (yychar==1) return;
X puts("I don't understand that.");
X puts("Please submit a Logo bug report, telling what you typed,");
X puts(" and asking for a more specific error message.");
X}
Xerrclear() /* clear error status in editor. */
X{
X ibufptr=NULL;
X yychar= -1;
X yyerrflag=0;
X letflag=0;
X}
Xungood(name,val)
Xregister char *name,*val;
X{
X nputs(name);
X pf1(" doesn't like %l as input.\n",val);
X errhand();
X}
X
END_OF_zerr.c
if test 2650 -ne `wc -c <zerr.c`; then
echo shar: \"zerr.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 1 \(of 6\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 6 archives.
echo "Now see the README"
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archiv;
X N;
X