jtm@spock.UUCP (Jan Miksovsky '86 off) (11/16/85)
Last year, I wrote an interpreter for the Karel language to help introduce
students here taking structured programming courses. The language is
very simple, but is more fun for new programmers to use than Pascal since it
is more visually-oriented. I'm running this on a VAX 11/750 under 4.2 BSD,
and I haven't found any problems (yet :-) .
Mail comments, bug reports, suggestions, etc. to me, *please*.
A demo program, maze.k, is enclosed. To run it, type "karel maze.k" and
press the return key after the maze is loaded in.
Enjoy.
Jan Miksovsky
Choate Rosemary Hall
P.O. Box 788
Wallingford, CT 06492
...{decvax}!yale!spock!jtm
# -----------------CUT HERE---------------------
#!/bin/sh
# This is a shell archive. Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# wrapped by spock!jtm on Wed Nov 6 12:03:55 EST 1985
echo x - README
sed 's/^X//' > README << !SHAR!EOF!
XThis is version 1.0 of an interpreter for Karel's programming language as
Xdescribed in "Karel the Robot" by Richard E. Pattis (John Wiley & Sons, 1981).
XThe language is described as a "gentle introduction to Pascal"; while very
Xsimple, it teaches the basics of structured programming.
XN.B. This is *not* the interpreter that Pattis wrote (the one described in the
Xbook), which is copyright. This version was written independently; approval
Xwas obtained from him for this posting. Right is hereby given for unlimited
Xnon-profit use of this particular package.
X
XThe structure of this interpreter is based heavily on that of hoc(1), described
Xin "The Unix Programming Environment" by Brian Kernighan and Rob Pike; anyone
Xinterested in the "guts" of this program should be familiar with that program.
X
X******************************************************************************
X
XFile Contents
X
Xcode.c program executor and run-time routines
Xdoc short BNF-like language description
Xhelp.h help-screen information
Xkarel.1 manual page
Xkarel.h global declarations
Xkarel.y syntactical language definition
Xklex.c lexical analyzer
Xmain.c startup routines, error handlers, etc.
Xscr.c screen routines
Xsymbol.c symbol-table manipulator
Xwords.h Karel keywords and built-in procedures
X
X******************************************************************************
X
X
X Jan Miksovsky
X Choate Rosemary Hall
X P.O. Box 788
X Wallingford, CT 06492
X
X ...{decvax}!yale!spock!jtm
X
!SHAR!EOF!
echo x - makefile
sed 's/^X//' > makefile << !SHAR!EOF!
X# makefile for karel 1.0 11/6/85
X
XOBJS = main.o klex.o symbol.o code.o y.tab.o scr.o
X
Xkarel: $(OBJS)
X cc $(CFLAGS) $(OBJS) -o karel -lcurses -ltermcap
X
X$(OBJS): karel.h
X
Xklex.o: words.h
X
Xwords.h: y.tab.h
X
Xy.tab.c y.tab.h: karel.y
X yacc -d karel.y
X
Xscr.o: help.h
!SHAR!EOF!
echo x - code.c
sed 's/^X//' > code.c << !SHAR!EOF!
X#include <stdio.h>
X#include "karel.h"
X#include "y.tab.h"
X
X/* NPROG is size of program; no one would ever write a program this large */
X#define NPROG 500
X
X#define advpc ++pc
X#define nextinst prog[advpc]
X
XInst prog[NPROG]; /* the machine */
Xint progp; /* next spot for code */
Xint pc; /* program counter */
Xint startaddr; /* start of main block */
Xint flag; /* flag for logic tests */
Xint dest; /* branch destination */
X
Xinitcode() /* set up counters, etc., for execution */
X{
X progp = 0;
X flag = 0;
X pc = 0;
X}
X
Xsetcode(addr, n) /* install one program instruction */
Xint addr;
XInst n;
X{
X prog[addr] = n;
X}
X
Xsetcodeint(addr, n) /* install one int */
Xint addr, n;
X{
X prog[addr] = (Inst) n;
X}
X
Xcode(n) /* install next instruction */
XInst n;
X{
X if (progp >= NPROG)
X severe("program too big", (char *) 0);
X setcode(progp++, n);
X}
X
Xcodeint(n) /* install a int as next instruction */
Xint n;
X{
X code((Inst) n);
X}
X
Xexecute(n) /* execute machine */
Xint n;
X{
X int temp;
X
X temp = pc;
X for (pc = n; (prog[pc] != RETURN) && state; pc++) {
X (*(prog[pc]))();
X update();
X }
X pc = temp;
X}
X
Xturnleft() /* turn karel 90 degrees left */
X{
X if (--dir < 0)
X dir = 3;
X placekarel(y, x);
X}
X
Xbranch() /* jump to another instruction */
X{
X dest = (int) nextinst;
X pc = dest - 1;
X}
X
Xcondbranch() /* jump of last logic test was false */
X{
X if (!flag)
X branch();
X else
X advpc;
X}
X
Xcall() /* call a user-defined instruction */
X{
X execute(nextinst);
X}
X
Xloopexec() /* execute block of code a number of times */
X{
X int k, limit, loopbody;
X
X limit = (int) nextinst;
X loopbody = pc + 2;
X for (k = 0; k < limit; k++)
X execute(loopbody);
X branch();
X}
X
Xturnoff() /* end program execution */
X{
X state = OFF;
X}
X
X/* code for built-in logical test */
X
Xanybeepers() { flag = beepers; }
Xfacingeast() { flag = (dir == 1); }
Xfacingnorth() { flag = (dir == 0); }
Xfacingsouth() { flag = (dir == 2); }
Xfacingwest() { flag = (dir == 3); }
Xfrontblocked() { flag = !sideclear(dir); }
Xfrontclear() { flag = sideclear(dir); }
Xleftblocked() { flag = !sideclear(dir-1); }
Xleftclear() { flag = sideclear(dir-1); }
Xnobeepers() { flag = !beepers; }
Xnotfacingeast() { flag = (dir != 1); }
Xnotfacingnorth() { flag = (dir != 0); }
Xnotfacingsouth() { flag = (dir != 2); }
Xnotfacingwest() { flag = (dir != 3); }
Xrightblocked() { flag = !sideclear(dir+1); }
Xrightclear() { flag = sideclear(dir+1); }
X
Xnexttobeeper()
X{
X flag = (oldch == '*' || (oldch >= '0' && oldch <= '9'));
X}
X
Xnotnexttobeeper()
X{
X nexttobeeper();
X flag = !flag;
X}
!SHAR!EOF!
echo x - doc
sed 's/^X//' > doc << !SHAR!EOF!
X
X
XThe following is a list of statements available in the Karel language...
X
X
Xprimitive instructions:
X move Karel moves one block forward
X turnleft pivots 90 degrees left
X pickbeeper puts beeper in beeper-bag
X putbeeper puts beeper on corner
X turnoff turns off
X
Xblock structure words:
X BEGIN
X <stmt>;
X <stmt>;
X <stmt>;
X ...
X END;
X
X IF <test>
X THEN <stmt>
X [ ELSE <stmt> ]
X
X ITERATE <positive-integer> TIMES
X <stmt>
X
X WHILE <test> DO
X <stmt>
X
X DEFINE-NEW-INSTRUCTION <name> AS
X <stmt>
X
X BEGINNING-OF-PROGRAM
X <definitions>
X BEGINNING-OF-EXECUTION
X <stmt>;
X <stmt>;
X <stmt>;
X ...
X END-OF-EXECUTION
X END-OF-PROGRAM
X
Xtests:
X front-is-clear, front-is-blocked,
X left-is-clear, left-is-blocked,
X right-is-clear, right-is-blocked,
X next-to-a-beeper, not-next-to-a-beeper,
X facing-north, not-facing-north,
X facing-south, not-facing-south,
X facing-east, not-facing-east,
X facing-west, not-facing-west,
X any-beepers-in-beeper-bag,
X no-beepers-in-beeper-bag
X
Xcomments:
X This version of karel uses Pascal-style "{" and "}" comment
X delimiters; this is the only addition to the language described
X in "Karel the Robot"
!SHAR!EOF!
echo x - help.h
sed 's/^X//' > help.h << !SHAR!EOF!
X/* messages for help screen */
X
Xchar *helpmsg[] = {
X "Key Commands:\n",
X "i\tmove north",
X "j\t west",
X "k\t east",
X "m\t south\n",
X "I\tplace Karel facing north",
X "J\t west",
X "K\t east",
X "M\t south\n",
X "o\tplace wall section",
X "q\tquit",
X "s\tsave screen",
X "S\tsave snapshot\n",
X "*\tplace beeper",
X "?\tprint this screen",
X "return\trun program",
X "space\terase an object\n",
X 0
X};
!SHAR!EOF!
echo x - karel.1
sed 's/^X//' > karel.1 << !SHAR!EOF!
X.TH KAREL 1 "Choate Rosemary Hall"
X.UC 4
X.SH NAME
Xkarel \- interpreter for Karel's programming language
X.SH SYNOPSIS
X.br
X.B karel
X[
X.B \-n
X]
X[
X.B \-b
Xbeepers
X]
Xfile.k
X.br
X.SH DESCRIPTION
X.I Karel
Xis an interpreter for Karel's programming language, an introductory language
Xbased on the structure of Pascal, which incorporates some of the visual
Xfeedback possible from languages like Logo.
X.PP
XAfter reading the specified program (with a name ending in ".k"), a
Xscreen with a corresponding name (ending in ".scr") is read if it exists.
XThe screen editor is then called; from there, you can place Karel, the
Xrobot, on the screen, and then run the program by pressing the return key.
X.PP
XThe following flags are recognized by
X.I karel:
X.TP 8
X.B \-b
XSets the number of beepers Karel will be holding at the start of program
Xexecution (default is zero).
X.br
X.TP 8
X.B \-n
XSuppress loading of screen file
X.br
X.TP 0
X.nf
XThe following is a list of the screen editor commands:
X
Xi move cursor north (up)
Xj west (left)
Xk east (right)
Xm south (down)
X
XI place Karel facing north
XJ west
XK east
XM south
X
Xo place wall section
Xq quit; end execution of karel
Xs save screen as file with suffix '.scr'
XS save picture of screen with borders, saved as 'snapshot'
X
X* place beeper
X? print help screen
Xreturn run program
Xspace erase an object
X.fi
X.PP
XNote: after running program, press ESC to leave screen setup as it is, or press
Xany other key to reset screen to setup before program execution.
X.br
X.SH FILES
Xfile.k source program
X.br
Xfile.scr picture of screen, without borders
X.br
Xsnapshot picture of screen, with borders
X.br
X.SH SEE\ ALSO
XPattis, Richard E.;
X.ul 1
XKarel the Robot
X.br
X.SH AUTHOR
XJan Miksovsky
X.SH BUGS
XSome of the "features" of this interpreter are superfluous: e.g., the
Xdashed lines which serve no purpose other than to make the screen look
Xlike the pictures in the book.
!SHAR!EOF!
echo x - karel.h
sed 's/^X//' > karel.h << !SHAR!EOF!
X/* file name suffixes */
X#define PROGSUFFIX "k"
X#define SCRSUFFIX "scr"
X
X/* interpreter states */
X#define OFF 0
X#define COMPILE 1
X#define EDIT 2
X#define RUN 3
X
Xtypedef int (*Inst)(); /* pseudo-compiled instruction */
X
X/* marks end of procedure or main block */
X#define RETURN (Inst) 0
X
Xtypedef struct Bltintype { /* built-in procedure entry */
X char *name;
X Inst func;
X int type;
X} Bltintype;
X
Xtypedef struct Symbol { /* symbol table entry */
X char *name;
X int addr;
X struct Symbol *next;
X} Symbol;
X
X/* in main.c */
Xextern nflg, state;
Xextern severe(), err(), interupt(), screrror();
Xextern char *progname, basename[];
X
X/* in words.h */
Xextern Bltintype bltins[];
X
X/* in symbol.c */
Xextern Symbol *symtab, *lookup();
Xextern install();
X
X/* in klex.c */
Xextern nkeys, gotsemcolon, gotturnoff, linecount, tokenid, yyval;
Xextern yylex(), printdump();
Xextern char yytext[];
X
X/* in code.c */
Xextern progp, startaddr, initcode(), setcode(), code(), execute();
Xextern anybeepers(), facingeast(), facingnorth(), facingsouth();
Xextern facingwest(), frontblocked(), frontclear(), leftblocked();
Xextern leftclear(), nexttobeeper(), nobeepers();
Xextern notfacingeast(), notfacingnorth(), notfacingsouth(), notfacingwest();
Xextern notnexttobeeper(), pickbeeper(), putbeeper(), rightblocked();
Xextern rightclear(), turnleft(), turnoff();
X
X/* in scr.c */
Xextern beepers, dir, x, y, editscr(), reset(), placekarel(), putbeeper();
Xextern pickbeeper(), movekarel(), sideclear(), update(), finish();
Xextern readscrn(), initialize(), shutoff();
Xextern char oldch;
!SHAR!EOF!
echo x - karel.y
sed 's/^X//' > karel.y << !SHAR!EOF!
X%{
X
X#include <stdio.h>
X#include "karel.h"
X
Xextern int condbranch(), branch(), call(), bltin(), loopexec();
Xchar instname[BUFSIZ];
XSymbol *sp;
X
X%}
X
X%start prog
X /* Karel keywords */
X
X%token AS BEGEXEC BEGIN BEGPROG DEFINST DO ELSE END ENDEXEC
X%token ENDPROG IF ITERATE THEN TIMES WHILE
X
X /* interpreter types */
X
X%token KEY BLTIN TEST NUMBER NAME
X
X
X%% /* beginning of rules */
X
X
Xprog : BEGPROG deflist begexec stmtlist ENDEXEC ENDPROG {
X startaddr = \$3;
X code(RETURN);
X }
X | prog error
X { yyerrok; }
X ;
X
Xbegexec : BEGEXEC {
X strcpy(instname, "");
X fprintf(stderr, "main block:\n");
X \$\$ = progp;
X }
X ;
X
Xdeflist : def
X | deflist ';' def
X ;
X
Xdef : /* nothing */
X | definst AS stmt
X { code(RETURN); }
X ;
X
Xdefinst : DEFINST NAME {
X strcpy(instname, yytext);
X fprintf(stderr, "%s:\n", instname);
X install(instname);
X }
X | DEFINST BLTIN
X { err("tried to redefine primitive instruction:",
X yytext); }
X | DEFINST TEST
X { err("tried to redefine logical test:", yytext); }
X ;
X
Xstmtlist : stmt
X | stmtlist ';' stmt
X ;
X
Xstmt : BEGIN stmtlist END
X | IF logictest THEN stmt {
X setcode(\$2 + 1, condbranch);
X setcodeint(\$2 + 2, progp);
X }
X | IF logictest THEN stmt else stmt {
X setcode(\$2 + 1, condbranch);
X setcodeint(\$2 + 2, \$5 + 1);
X setcodeint(\$5, progp);
X }
X | iterate TIMES stmt {
X code(RETURN);
X setcodeint(\$1, progp);
X }
X | WHILE logictest DO stmt {
X setcode(\$2 + 1, condbranch);
X setcodeint(\$2 + 2, progp + 2);
X code(branch);
X codeint(\$2);
X }
X | NAME {
X if ((sp = lookup(yytext)) == (Symbol *) 0)
X err(yytext, "undefined");
X else {
X if (strcmp(yytext, instname) == 0)
X err("recursive procedure call:",
X yytext);
X else {
X code(call);
X codeint(sp->addr);
X }
X }
X }
X | BLTIN {
X if (strcmp(yytext, "turnoff") == 0)
X gotturnoff = 1;
X code(bltins[tokenid].func);
X }
X | error
X ;
X
Xlogictest : TEST {
X \$\$ = progp;
X code(bltins[tokenid].func);
X codeint(0); /* leave room for branch */
X codeint(0); /* instruction and address */
X }
X | NAME
X { err("invalid logical test:", yytext); }
X | BLTIN
X { err("invalid logical test:", yytext); }
X ;
X
Xelse : ELSE {
X code(branch);
X \$\$ = progp;
X codeint(0);
X };
X
Xiterate : ITERATE NUMBER {
X code(loopexec);
X codeint(atoi(yytext));
X \$\$ = progp;
X codeint(0);
X }
X ;
!SHAR!EOF!
echo x - klex.c
sed 's/^X//' > klex.c << !SHAR!EOF!
X#include <stdio.h>
X#include <ctype.h>
X#include "karel.h"
X#include "words.h"
X
Xint nkeys, nbltins; /* number of keywords and bltins */
Xint gotsemcolon;
Xint gotturnoff;
Xint tokenid; /* token number */
Xint linecount; /* no. of lines in input */
Xint yyval;
Xchar yytext[BUFSIZ];
Xstatic char c; /* character being handled */
Xextern FILE *fp; /* source file; found in main.c */
X
Xinitlex() /* prepare the lexical analyzer */
X{
X /* count the number of keywords */
X for (nkeys = 0; keywords[nkeys].name; nkeys++)
X ;
X for (nbltins = 0; bltins[nbltins].name; nbltins++)
X ;
X c = ' ';
X}
X
Xchar egetc(fp) /* get a character, checking for EOF */
XFILE *fp;
X{
X char c;
X
X if ((c = getc(fp)) == EOF)
X severe("unexpected end of program");
X else
X return(c);
X}
X
Xyylex() /* lexical analyzer */
X{
X int len; /* length of word */
X int n; /* temporary */
X
X skipwhite();
X while (c == '{') { /* skip over comment */
X while (c != '}')
X c = egetc(fp);
X c = getc(fp);
X skipwhite();
X }
X len = 0;
X while (isalnum(c) || c == '-') { /* read one word */
X yytext[len++] = c;
X c = getc(fp);
X }
X yytext[len] = '\0'; /* mark end of word */
X if (len > 0 && c != EOF) {
X tokenid = getkeyid(yytext);
X if (tokenid >= 0)
X yyval = keywords[tokenid].keyid;
X else {
X tokenid = getbltinid(yytext);
X if (tokenid >= 0)
X yyval = bltins[tokenid].type;
X else
X yyval = sscanf(yytext, "%d", &n) ? NUMBER:NAME;
X }
X }
X else {
X yyval = c;
X c = getc(fp);
X }
X return(yyval);
X}
X
Xgetkeyid(s) /* find s in keyword array; return -1 if not found */
Xchar *s;
X{
X int cmp, lower, upper, guess, found;
X
X /* use a binary search */
X found = lower = 0;
X upper = nkeys;
X while (lower <= upper && !found) {
X if (!(cmp = strcmp(s, keywords[guess=(lower+upper)/2].name)))
X found = 1;
X else
X if (cmp > 0)
X lower = guess + 1;
X else
X upper = guess - 1;
X }
X return(found ? guess : -1);
X}
X
X
X/* this is sort of redundant, but I didn't want to pass two kinds of */
X/* arrays to the same search routine */
X
X
Xgetbltinid(s) /* find s in built-in array; return -1 if not found */
Xchar *s;
X{
X int cmp, lower, upper, guess, found;
X
X /* use a binary search */
X found = lower = 0;
X upper = nbltins;
X while (lower <= upper && !found) {
X if (!(cmp = strcmp(s, bltins[guess=(lower+upper)/2].name)))
X found = 1;
X else
X if (cmp > 0)
X lower = guess + 1;
X else
X upper = guess - 1;
X }
X return(found ? guess : -1);
X}
X
Xskipwhite() /* skip over white space (tabs, etc.) */
X{
X while (isspace(c)) {
X if (c == '\n')
X linecount++;
X c = getc(fp);
X }
X}
!SHAR!EOF!
echo x - main.c
sed 's/^X//' > main.c << !SHAR!EOF!
X
X/*
X * karel: interpreter for Karel's programming language
X *
X * version 1.0, completed November 6th, 1985
X * by J.T.Miksovsky @ Choate Rosemary Hall
X *
X * N.B. This is *not* the interpreter that Richard E. Pattis wrote (the one
X * described in his book, "Karel the Robot"). Approval from the Pattis was
X * obtained for this distribution.
X *
X */
X
X#include <stdio.h>
X#include <signal.h>
X#include "karel.h"
X
Xint nflg; /* -n (no screen load) option flag */
Xint errfound; /* 1 if a syntax or lexical error found */
Xint state; /* tells if compiling, running, etc. */
Xchar *progname; /* name of this program */
Xchar filename[BUFSIZ]; /* name of the source file */
Xchar basename[BUFSIZ]; /* name of source without suffix */
Xchar *usage = "usage: karel [-n] [-b beepers] file.k\n";
XFILE *fp; /* source file */
X
Xmain(argc, argv)
Xint argc;
Xchar *argv[];
X{
X progname = *argv;
X state = COMPILE;
X beepers = 0;
X /* process arguments */
X nflg = 0;
X argc--;
X argv++;
X while (argc > 0 && **argv == '-') {
X (*argv)++;
X while (**argv)
X switch (*(*argv)++) {
X case 'b':
X if (**argv == '\0') {
X argc--;
X argv++;
X }
X if (sscanf(*argv, "%d",&beepers) != 1)
X syserr("bad beeper number",0);
X if (beepers < 0)
X syserr("bad beeper number",0);
X **argv = '\0';
X break;
X case 'n':
X nflg = 1;
X break;
X default:
X fprintf(stderr, usage);
X exit(1);
X break;
X }
X argc--;
X argv++;
X }
X if (argc != 1) {
X fprintf(stderr, usage);
X exit(1);
X }
X dofiles(*argv);
X /* set up for parsing */
X errfound = 0;
X gotsemcolon = 0;
X gotturnoff = 0;
X linecount = 1;
X initlex();
X initcode();
X yyparse();
X fclose(fp);
X if (!gotturnoff && !errfound)
X severe("no turnoff instruction found", NULL);
X if (!errfound) {
X fprintf(stderr, "\tno lexical or syntatic errors\n");
X /* prepare to call screen editor */
X state = EDIT;
X initialize();
X if (!nflg)
X readscrn();
X editscr();
X }
X else
X fprintf(stderr,
X "Execution suppressed due to compilation errors\n");
X}
X
X/* there are many error handlers to handle many type of errors */
X
Xsyserr(s, t) /* system error: print error message and die */
Xchar *s, *t;
X{
X if (state != COMPILE)
X finish();
X fprintf(stderr, "%s: %s", progname, s);
X if (t)
X fprintf(stderr, "%s", t);
X fputc('\n', stderr);
X exit(1);
X}
X
Xsevere(s, t) /* print error message and die */
Xchar *s, *t;
X{
X fprintf(stderr, "%s", s);
X if (t)
X fprintf(stderr, " %s", t);
X fprintf(stderr, "\ncannot recover from previous errors -- QUIT\n");
X exit(1);
X}
X
Xerr(s, t) /* print error message */
Xchar *s, *t;
X{
X errfound = 1;
X fprintf(stderr, "\t%s", s);
X if (t)
X fprintf(stderr, " %s", t);
X fprintf(stderr, ", line %d\n", linecount);
X}
X
Xyyerror(s) /* handle parser error */
Xchar *s;
X{
X errfound = 1;
X fprintf(stderr, "\t%s, line %d", s, linecount);
X if (yytext[0])
X fprintf(stderr, " near %s", yytext);
X fputc('\n', stderr);
X}
X
Xinterupt() /* handle interupts, die */
X{
X signal(SIGINT, SIG_IGN);
X finish();
X fprintf(stderr, "interupt\n");
X exit(0);
X}
X
Xscrerror(s) /* reset terminal modes, die */
Xchar *s;
X{
X reset();
X fprintf(stderr, "\nscreen error: %s\n", s);
X exit(1);
X}
X
Xdofiles(s) /* get filename, open files, etc. */
Xchar *s;
X{
X int suffstart;
X char suffix[10];
X
X /* check suffix */
X strcpy(suffix, ".");
X strcat(suffix, PROGSUFFIX);
X suffstart = strlen(s) - strlen(suffix);
X if (strcmp(s + suffstart, suffix) != 0)
X syserr("bad filename: ", s);
X s[suffstart] = '\0'; /* delete suffix */
X strcpy(basename, s);
X sprintf(filename, "%s.%s", basename, PROGSUFFIX);
X if ((fp = fopen(filename, "r")) == NULL)
X syserr("can't open file: ", s);
X}
!SHAR!EOF!
echo x - scr.c
sed 's/^X//' > scr.c << !SHAR!EOF!
X#include <stdio.h>
X#include <signal.h>
X#include <curses.h>
X#include "karel.h"
X#include "help.h"
X
X#define scrnchr(t, s) (stdscr->_y[t][s] & 0177)
X
Xint cx, cy; /* cursor coordinates */
Xint x, y; /* Karel's x, y coord's */
Xint dir; /* Karel's heading */
X /* 0 = north */
X /* 1 = east */
X /* 2 = south */
X /* 3 = west */
Xint beepers; /* no. of beepers held */
Xint placed; /* 1 if Karel is placed */
Xint clearln; /* 1 if bottom line */
X /* should be cleared */
Xchar oldch; /* Karel is on top of */
Xchar scrnname[80]; /* name of screen */
XWINDOW *helpscrn; /* editor help screen */
XWINDOW *begscrn; /* screen at start */
X
Xeditscr() /* main interactive loop */
X{
X int c; /* keyboard input char */
X int newx, newy; /* coord's to move to */
X int done; /* signal to quit */
X
X done = 0;
X clearln = 0;
X c = getch();
X while (c != EOF && c != '\004' && !done) {
X if (c == ERR)
X screrror("getting character");
X /* clear bottom line if necessary */
X if (clearln)
X clearline();
X /* get current location */
X getyx(stdscr, cy, cx);
X newx = cx;
X newy = cy;
X switch (c) {
X case 'i':
X newy--;
X break;
X case 'j':
X newx--;
X break;
X case 'k':
X newx++;
X break;
X case 'm':
X newy++;
X break;
X case 'I':
X dir = 0;
X placekarel(cy, cx);
X break;
X case 'J':
X dir = 3;
X placekarel(cy, cx);
X break;
X case 'K':
X dir = 1;
X placekarel(cy, cx);
X break;
X case 'M':
X dir = 2;
X placekarel(cy, cx);
X break;
X case 'O':
X case 'o':
X placeobj('O');
X break;
X case 'Q':
X case 'q':
X done = 1;
X break;
X case '\r':
X case '\n':
X startprog();
X break;
X case 'S':
X snapshot();
X break;
X case 's':
X savescrn();
X break;
X case '8':
X case ':':
X case '*':
X putbeeper();
X break;
X case ' ':
X placeobj(' ');
X break;
X case '\014': /* control-L */
X redraw();
X break;
X case '?':
X case '/':
X help();
X break;
X }
X /* check to see if cursor moved off screen */
X if (newx>=1 && newx<COLS && newy>=0 && newy < LINES-2) {
X cy = newy;
X cx = newx;
X move(cy, cx);
X }
X update();
X if (!done)
X c = getch();
X }
X finish();
X}
X
Xinitialize() /* prepare for screen editing */
X{
X int k;
X
X if (initscr() == ERR || strcmp(ttytype, "unknown") == 0) {
X fprintf(stderr, "TERM variable not set\n");
X exit(0);
X }
X sprintf(scrnname, "%s.%s", basename, SCRSUFFIX);
X signal(SIGINT, interupt);
X scrollok(stdscr, FALSE);
X crmode();
X noecho();
X clear();
X /* set up help screen */
X helpscrn = newwin(0, 0, 0, 0);
X wclear(helpscrn);
X wmove(helpscrn, 0, 0);
X for (k = 0; helpmsg[k]; k++) {
X wprintw(helpscrn, helpmsg[k]);
X waddch(helpscrn, '\n');
X }
X wprintw(helpscrn, "\npress any key to continue: ");
X /* make a second screen to save beginning screen for execution */
X begscrn = newwin(0, 0, 0, 0);
X /* draw the boundaries */
X for (k = 0; k < LINES - 2; k++)
X mvaddch(k, 0, '|');
X mvaddch(LINES - 2, 0, '+');
X for (k = 1; k < COLS; k++)
X mvaddch(LINES - 2, k, '-');
X /* place the cursor in the center of the screen */
X cx = COLS / 2;
X cy = LINES / 2;
X placed = 0;
X oldch = ' ';
X move(cy, cx);
X redraw();
X}
X
Xreset() /* reset the screen to normal mode */
X{
X echo();
X nocrmode();
X endwin();
X}
X
Xredraw() /* redraw the screen */
X{
X /* force curses to redraw screen by copying screen, then copying back*/
X cpscrn(stdscr, begscrn);
X clear();
X cpscrn(begscrn, stdscr);
X touchwin(stdscr); /* make sure everything is drawn */
X move(cy, cx);
X update();
X}
X
Xupdate() /* refresh the screen */
X{
X if (refresh() == ERR)
X screrror("refreshing screen");
X}
X
Xplaceobj(c) /* place a wall, beeper, or space */
Xchar c;
X{
X if (cy == y && cx == x)
X placed = 0;
X addch(c);
X}
X
Xplacekarel(newy, newx) /* put karel on screen at new location */
Xint newy, newx;
X{
X char c; /* symbol karel will be shown as */
X
X if (placed)
X mvaddch(y, x, oldch);
X else
X placed = 1;
X move(newy, newx);
X oldch = inch();
X switch (dir) {
X case 0:
X c = '^';
X break;
X case 1:
X c = '>';
X break;
X case 2:
X c = 'v';
X break;
X case 3:
X c = '<';
X break;
X default:
X screrror("weird direction");
X }
X addch(c);
X y = newy;
X x = newx;
X}
X
Xputbeeper() /* put down one beeper */
X{
X char c; /* char that cursor is on top of */
X
X if (state == RUN)
X c = oldch;
X else
X c = inch();
X if (c == '*')
X c = '2';
X else {
X if (c >= '0' && c <= '8')
X c++;
X else {
X if (c != '9')
X c = '*';
X else {
X shutoff("stacked beepers too high");
X return;
X }
X }
X }
X if (state == RUN) {
X if (--beepers < 0)
X shutoff("don't have enough beepers");
X else
X oldch = c;
X }
X else
X placeobj(c);
X}
X
Xhelp() /* print editor help screen */
X{
X touchwin(helpscrn);
X if (wrefresh(helpscrn) == ERR)
X screrror("refreshing help screen");
X if (wgetch(helpscrn) == ERR)
X screrror("getting character");
X redraw();
X}
X
Xsavescrn() /* save the screen to a file */
X{
X int k, j; /* loop indexes */
X FILE *fp; /* output file */
X FILE *fopen();
X
X if ((fp = fopen(scrnname, "w")) == NULL)
X syserr("can't open file: ", scrnname);
X for (k = 0; k < LINES - 2; k++) {
X for (j = 1; j < COLS; j++)
X fputc(scrnchr(k, j), fp);
X fputc('\n', fp);
X }
X fclose(fp);
X prbotln("screen saved");
X clearln = 1;
X move(cy, cx);
X}
X
Xsnapshot() /* save screen with the borders */
X{
X int k, j; /* loop indexes */
X FILE *fp; /* output file */
X FILE *fopen();
X
X if ((fp = fopen("snapshot", "w")) == NULL)
X syserr("can't open file: snapshot");
X for (k = 0; k < LINES - 2; k++) {
X fputc('|', fp);
X for (j = 1; j < COLS; j++)
X fputc(scrnchr(k, j), fp);
X fputc('\n', fp);
X }
X fputc('+', fp);
X for (k = 1; k < COLS; k++)
X fputc('-', fp);
X fputc('\n', fp);
X fclose(fp);
X prbotln("snapshot saved");
X clearln = 1;
X move(cy, cx);
X}
X
Xsideclear(n) /* return 1 if side n is clear, 0 otherwise */
Xint n;
X{
X int retval; /* value to be returned */
X
X retval = 1;
X /* make sure side-number is between 0 and 3 */
X while (n < 0)
X n += 4;
X n = n % 4;
X switch (n) {
X case 0:
X if (y == 0)
X retval = 0;
X else
X if (scrnchr(y - 1, x) == 'O')
X retval = 0;
X break;
X case 1:
X if (x == COLS - 1)
X retval = 0;
X else
X if (scrnchr(y, x + 1) == 'O')
X retval = 0;
X break;
X case 2:
X if (y == LINES - 3)
X retval = 0;
X else
X if (scrnchr(y + 1, x) == 'O')
X retval = 0;
X break;
X case 3:
X if (x == 1)
X retval = 0;
X else
X if (scrnchr(y, x - 1) == 'O')
X retval = 0;
X break;
X }
X return(retval);
X}
X
Xmovekarel() /* move karel one character forward */
X{
X int newx, newy;
X
X newx = x;
X newy = y;
X if (sideclear(dir)) {
X switch (dir) {
X case 0:
X newy--;
X break;
X case 1:
X newx++;
X break;
X case 2:
X newy++;
X break;
X case 3:
X newx--;
X break;
X }
X placekarel(newy, newx);
X cy = newy;
X cx = newx;
X }
X else
X shutoff("hit a wall");
X}
X
Xfinish() /* clean up; reset terminal modes, etc. */
X{
X scrollok(stdscr, TRUE);
X if (move(LINES - 1, 0) == ERR)
X screrror("moving to bottom of screen");
X if (clrtoeol() == ERR)
X screrror("clearing bottom line");
X if (refresh() == ERR)
X screrror("refreshing screen");
X reset();
X}
X
Xpickbeeper() /* pick up one beeper underneath karel */
X{
X if (oldch == ' ')
X shutoff("tried to pick non-existent beeper");
X else {
X if (oldch == '*')
X oldch = ' ';
X else
X if (oldch == '0')
X oldch = '*';
X else
X oldch--;
X beepers++;
X }
X}
X
Xreadscrn() /* read screen in from a file */
X{
X int k, j; /* loop indexes */
X FILE *fp; /* screen file */
X FILE *fopen();
X char c; /* char being read */
X char *kar; /* these two used to */
X char *kars = "^>v<"; /* place karel */
X char *index();
X
X if ((fp = fopen(scrnname, "r")) != NULL) {
X for (k = 0; k < LINES - 2; k++) {
X for (j = 1; j < COLS; j++) {
X if ((c = getc(fp)) == EOF)
X break;
X if (c != ' ') {
X if (kar = index(kars, c)) {
X dir = 4 - strlen(kar);
X placekarel(k, j);
X }
X else
X mvaddch(k, j, c);
X }
X }
X getc(fp); /* ignore newline */
X }
X fclose(fp);
X }
X move(cy, cx);
X update();
X}
X
Xshutoff(s) /* print s on bottom of screen */
Xchar *s;
X{
X char mesg[BUFSIZ];
X
X state = OFF;
X sprintf(mesg, "\007error shutoff: %.45s. press any key: ", s);
X prbotln(mesg);
X update();
X if (getch() == ERR)
X screrror("getting character");
X if (move(cy, cx) == ERR)
X screrror("moving cursor to karel");
X clearln = 1;
X}
X
Xclearline() /* clear bottom line of screen */
X{
X mvbot();
X if (clrtoeol() == ERR)
X screrror("clearing bottom line");
X if (move(cy, cx) == ERR)
X screrror("moving cursor to karel");
X clearln = 0;
X}
X
Xstartprog() /* prepare for execution, then call program */
X{
X int begx, begy; /* these are all temporary */
X int begdir; /* variables to save conditions */
X int begoldch; /* at start of execution */
X int begbeepers;
X int c; /* key user presses */
X
X /* save current status */
X begx = x;
X begy = y;
X begdir = dir;
X begoldch = oldch;
X begbeepers = beepers;
X cpscrn(stdscr, begscrn);
X if (!placed)
X shutoff("karel has not been placed");
X else {
X state = RUN;
X execute(startaddr);
X if (state != OFF)
X shutoff("turnoff instruction never reached");
X if (clearln == 0) {
X mvbot();
X printw("press any key: ");
X update();
X if ((c = getch()) == ERR)
X screrror("getting character");
X }
X else
X clearln = 0;
X clearline();
X /* restore previous status if ESC was not pressed */
X if (c != '\033') {
X x = begx;
X y = begy;
X dir = begdir;
X oldch = begoldch;
X beepers = begbeepers;
X cpscrn(begscrn, stdscr);
X }
X update();
X }
X state = EDIT;
X}
X
Xcpscrn(a, b) /* copy screen a to screen b */
XWINDOW *a, *b;
X{
X int k, j; /* loop indexes */
X
X for (k = 0; k < LINES - 1; k++)
X for (j = 0; j < COLS; j++)
X b->_y[k][j] = a->_y[k][j];
X touchwin(b);
X}
X
Xmvbot() /* move to bottom of screen */
X{
X if (move(LINES - 1, 0) == ERR)
X screrror("moving cursor to bottom of screen");
X}
X
Xprbotln(s) /* print a line on the bottom of screen */
Xchar *s;
X{
X mvbot();
X if (clrtoeol() == ERR)
X screrror("clearing bottom line");
X printw("%s", s);
X update();
X}
!SHAR!EOF!
echo x - symbol.c
sed 's/^X//' > symbol.c << !SHAR!EOF!
X#include "karel.h"
X
Xstatic Symbol *symtab = 0; /* the symbol table */
X
XSymbol *lookup(s) /* find s in symbol table */
Xchar *s;
X{
X Symbol *sp; /* loop index */
X
X for (sp = symtab; sp != (Symbol *) 0; sp = sp->next)
X if (strcmp(s, sp->name) == 0)
X return(sp);
X return(0); /* not found */
X}
X
Xinstall(s) /* install s in symbol table */
Xchar *s;
X{
X char *emalloc();
X Symbol *sp; /* new symbol table entry */
X
X sp = (Symbol *) emalloc(sizeof(Symbol));
X sp->name = emalloc(strlen(s) + 1);
X strcpy(sp->name, s);
X sp->addr = progp;
X sp->next = symtab;
X symtab = sp;
X}
X
Xchar *emalloc(n) /* do malloc with error checking */
Xint n;
X{
X char *p; /* pointer to free memory */
X char *malloc();
X
X if ((p = malloc(n)) == (char *) 0)
X syserr("out of memory", (char *) 0);
X return(p);
X}
!SHAR!EOF!
echo x - words.h
sed 's/^X//' > words.h << !SHAR!EOF!
X#include "y.tab.h"
X
X/* these lists must be sorted alphabetically in order for the */
X/* binary search routine to work */
X
X
X/* keywords */
X
Xstruct {
X char *name;
X int keyid;
X} keywords[] = {
X "AS", AS,
X "BEGIN", BEGIN,
X "BEGINNING-OF-EXECUTION", BEGEXEC,
X "BEGINNING-OF-PROGRAM", BEGPROG,
X "DEFINE-NEW-INSTRUCTION", DEFINST,
X "DO", DO,
X "ELSE", ELSE,
X "END", END,
X "END-OF-EXECUTION", ENDEXEC,
X "END-OF-PROGRAM", ENDPROG,
X "IF", IF,
X "ITERATE", ITERATE,
X "THEN", THEN,
X "TIMES", TIMES,
X "WHILE", WHILE,
X 0, 0
X};
X
X
X/* built-in procedures and tests */
X
XBltintype bltins[] = {
X "any-beepers-in-beeper-bag", anybeepers, TEST,
X "facing-east", facingeast, TEST,
X "facing-north", facingnorth, TEST,
X "facing-south", facingsouth, TEST,
X "facing-west", facingwest, TEST,
X "front-is-blocked", frontblocked, TEST,
X "front-is-clear", frontclear, TEST,
X "left-is-blocked", leftblocked, TEST,
X "left-is-clear", leftclear, TEST,
X "move", movekarel, BLTIN,
X "next-to-a-beeper", nexttobeeper, TEST,
X "no-beepers-in-beeper-bag", nobeepers, TEST,
X "not-facing-east", notfacingeast, TEST,
X "not-facing-north", notfacingnorth, TEST,
X "not-facing-south", notfacingsouth, TEST,
X "not-facing-west", notfacingwest, TEST,
X "not-next-to-a-beeper", notnexttobeeper, TEST,
X "pickbeeper", pickbeeper, BLTIN,
X "putbeeper", putbeeper, BLTIN,
X "right-is-blocked", rightblocked, TEST,
X "right-is-clear", rightclear, TEST,
X "turnleft", turnleft, BLTIN,
X "turnoff", turnoff, BLTIN,
X 0, 0, 0
X};
!SHAR!EOF!
echo x - maze.k
sed 's/^X//' > maze.k << !SHAR!EOF!
X
X{ karel maze demo: robot will follow the right wall until he finds a beeper }
X
XBEGINNING-OF-PROGRAM
X DEFINE-NEW-INSTRUCTION turnright AS
X ITERATE 3 TIMES
X turnleft;
X
X BEGINNING-OF-EXECUTION
X WHILE not-next-to-a-beeper DO
X BEGIN
X IF right-is-clear
X THEN turnright
X ELSE
X WHILE front-is-blocked DO
X turnleft;
X move
X END;
X turnoff
X END-OF-EXECUTION
X
XEND-OF-PROGRAM
!SHAR!EOF!
echo x - maze.scr
sed 's/^X//' > maze.scr << !SHAR!EOF!
X
X
X
X
X
X
X
X
X
X
XOOOOOOOOOOOOOOOOOOOOOOO
X O O O O
X OOOOOO O OOOOO OOO O O
X O O O O O
XOOO OOOOOOO O OOO O *
X OOOOOOO O O O
X OOOOOOOO O O O OOO
X O O O OOO O O
X OOO OOOOOOOO O O O O
X O OOO O O O
X O OOOOOO O OOO O OOO O
X^O O O O
!SHAR!EOF!