This is logoaux.m in view mode; [Download] [Up]
/* This file contains a miscellany of functions for LOGO, both
* primary implementation of LOGO operations and commands, and also various
* other functions for maintaining the overhead of the interpreter (variable
* storage, function calls, etc.)
*
* Copyright (C) 1979, The Children's Museum, Boston, Mass.
* Written by Douglas B. Klunder
*/
#include <sgtty.h>
#include "logo.h"
#include <setjmp.h>
#ifdef NEXT
extern NXStream *aStream;
#endif NEXT
extern jmp_buf yerrbuf;
int tvec[2] ={0,0};
extern int yychar,yylval,yyline;
extern int topf,errtold,flagquit;
extern FILE *ofile;
extern char *ostring;
extern char *getbpt;
extern char charib;
extern int pflag,letflag;
extern int currtest;
struct runblock *thisrun = NULL;
extern struct plist *pcell; /* for PAUSE */
extern struct stkframe *fbr;
#ifdef PAUSE
extern int pauselev,psigflag;
#endif
tyobj(text)
register struct object *text;
{
register struct object *temp;
char str[30];
if (text==0) return;
switch (text->obtype) {
case CONS:
for (temp = text; temp; temp = temp->obcdr) {
fty1(temp->obcar);
if(temp->obcdr) putc1(' ');
}
break;
case STRING:
sputs(text->obstr);
break;
case INT:
sprintf(str,FIXFMT,text->obint);
sputs(str);
break;
case DUB:
sprintf(str,"%g",text->obdub);
if (!index(str,'.')) strcat(str,".0");
sputs(str);
break;
}
}
fty1(text)
register struct object *text;
{
if (listp(text)) {
putc1('[');
tyobj(text);
putc1(']');
} else tyobj(text);
}
fillbuf(text) /* Logo TYPE */
register struct object *text;
{
tyobj(text);
mfree(text);
}
struct object *cmprint(arg)
struct object *arg;
{
fillbuf(arg);
putchar('\n');
return ((struct object *)(-1));
}
struct object *cmtype(arg)
struct object *arg;
{
fillbuf(arg);
return ((struct object *)(-1));
}
struct object *cmfprint(arg)
struct object *arg;
{
fty1(arg);
putchar('\n');
mfree(arg);
return ((struct object *)(-1));
}
struct object *cmftype(arg)
struct object *arg;
{
fty1(arg);
mfree(arg);
return ((struct object *)(-1));
}
setfile(file)
register struct object *file;
{
file = numconv(file,"File command");
if (!intp(file)) ungood("File command",file);
ofile = (FILE *)((int)(file->obint));
mfree(file);
}
fileprint(file,text)
register struct object *file,*text;
{
setfile(file);
fillbuf(text);
fputc('\n',ofile);
ofile = NULL;
}
filefprint(file,text)
register struct object *file,*text;
{
setfile(file);
fty1(text);
mfree(text);
fputc('\n',ofile);
ofile = NULL;
}
filetype(file,text)
register struct object *file,*text;
{
setfile(file);
fillbuf(text);
ofile = NULL;
}
fileftype(file,text)
struct object *file,*text;
{
setfile(file);
fty1(text);
mfree(text);
ofile = NULL;
}
struct object *openfile(name,type)
register struct object *name;
register char *type;
{
FILE *fildes;
if (!stringp(name)) ungood("Open file",name);
fildes = fopen(name->obstr,type);
if (!fildes) {
pf1("Can't open file %l.\n",name);
errhand();
}
mfree(name);
return(localize(objint((FIXNUM)((int)fildes))));
}
struct object *loread(arg)
struct object *arg;
{
return(openfile(arg,"r"));
}
struct object *lowrite(arg)
struct object *arg;
{
return(openfile(arg,"w"));
}
struct object *callunix(cmd)
register struct object *cmd;
{
register struct object *str;
#ifdef NEXT
char unixcmnd[200],unixpipe[1024];
FILE *popen(), *unixstream;
char *retptr;
str = stringform(cmd);
cpystr(unixcmnd,str->obstr," ","<&-",NULL);
unixstream = popen(unixcmnd,"r");
while((retptr = fgets(unixpipe,1024,unixstream)) != NULL)
{
printf("%s",&unixpipe);
fflush(stdout);
}
pclose(unixstream);
fflush(stdout);
#else /* NOT NEXT */
str = stringform(cmd);
system(str->obstr);
#endif /* NEXT */
mfree(str);
mfree(cmd);
return ((struct object *)(-1));
}
struct object *fileclose(file)
register struct object *file;
{
setfile(file);
fclose(ofile);
ofile = NULL;
return ((struct object *)(-1));
}
struct object *fileread(file,how)
register struct object *file;
int how; /* 0 for fileread (returns list), 1 for fileword (returns str) */
{
char str[200];
register struct object *x;
char *svgbpt;
char c;
setfile(file);
fgets(str,200,ofile);
if (feof(ofile)) {
ofile = NULL;
if (how) return((struct object *)0);
return(localize(objcpstr("")));
}
ofile = NULL;
if (how) {
str[strlen(str)-1] = '\0';
return(localize(objcpstr(str)));
}
str[strlen(str)-1] = ']';
c = charib;
charib = 0;
svgbpt = getbpt;
getbpt = str;
x = makelist();
getbpt = svgbpt;
charib = c;
return(x);
}
struct object *lfread(arg)
struct object *arg;
{
return(fileread(arg,0));
}
struct object *lfword(arg)
struct object *arg;
{
return(fileread(arg,1));
}
struct object *lsleep(tim) /* wait */
register struct object *tim;
{
int itim;
tim = numconv(tim,"Wait");
if (intp(tim)) itim = tim->obint;
else itim = tim->obdub;
mfree(tim);
sleep(itim);
return ((struct object *)(-1));
}
struct object *input(flag)
int flag; /* 0 for readlist, 1 for request */
{
int len;
char s[512];
register struct object *x;
char *svgbpt;
char c;
if (flag) putchar('?');
fflush(stdout);
#ifdef NEXT
len = NXRead(aStream,s,512);
#else
len = read(0,s,512);
#endif NEXT
if (len <= 0) len = 1;
s[len-1]=']';
c = charib;
charib = 0;
svgbpt = getbpt;
getbpt = s;
x = makelist();
getbpt = svgbpt;
charib = c;
return (x);
}
struct object *readlist() {
return(input(0));
}
struct object *request() {
return(input(1));
}
struct object *ltime() /* LOGO time */
{
char ctim[50];
register struct object *x;
char *svgbpt;
char c;
time(tvec);
strcpy(ctim,ctime(tvec));
ctim[strlen(ctim)-1]=']';
c = charib;
charib = 0;
svgbpt = getbpt;
getbpt = ctim;
x = makelist();
getbpt = svgbpt;
charib = c;
return(x);
}
dorun(arg,num)
struct object *arg;
FIXNUM num;
{
register struct object *str;
register struct runblock *rtemp;
rtemp = (struct runblock *)ckmalloc(sizeof(struct runblock));
if (num != 0) {
rtemp->rcount = num;
rtemp->rupcount = 0;
} else {
rtemp->rcount = 1; /* run or if, not repeat */
if (thisrun)
rtemp->rupcount = thisrun->rupcount - 1;
else
rtemp->rupcount = 0;
}
rtemp->roldyyc = yychar;
rtemp->roldyyl = yylval;
rtemp->roldline = yyline;
rtemp->svbpt = getbpt;
rtemp->svpflag = pflag;
rtemp->svletflag = letflag;
rtemp->svch = charib;
if (arg == (struct object *)(-1)) { /* PAUSE */
rtemp->str = (struct object *)(-1);
} else {
str = stringform(arg);
mfree(arg);
strcat(str->obstr,"\n");
rtemp->str = globcopy(str);
mfree(str);
}
rtemp->rprev = thisrun;
thisrun = rtemp;
rerun();
}
rerun() {
yychar = -1;
pflag = 0;
letflag = 0;
charib = '\0';
thisrun->rupcount++;
if (thisrun->str == (struct object *)(-1)) /* PAUSE */
getbpt = 0;
else
getbpt = thisrun->str->obstr;
}
unrun() {
register struct runblock *rtemp;
yychar = thisrun->roldyyc;
yylval = thisrun->roldyyl;
yyline = thisrun->roldline;
getbpt = thisrun->svbpt;
pflag = thisrun->svpflag;
letflag = thisrun->svletflag;
charib = thisrun->svch;
if (thisrun->str != (struct object *)(-1)) /* PAUSE */
lfree(thisrun->str);
rtemp = thisrun;
thisrun = thisrun->rprev;
JFREE(rtemp);
}
dorep(count,cmd)
struct object *count,*cmd;
{
FIXNUM icount;
count = numconv(count,"Repeat");
if (intp(count)) icount = count->obint;
else icount = count->obdub;
if (icount < (FIXNUM)0) ungood("Repeat",count);
if (icount == (FIXNUM)0) {
mfree(cmd);
cmd = 0;
icount++;
}
dorun(cmd,icount);
mfree(count);
}
struct object *repcount() {
if (!thisrun) {
puts("Repcount outside repeat.");
errhand();
}
return(localize(objint(thisrun->rupcount)));
}
#ifdef PAUSE
dopause() {
register struct plist *opc;
if (pflag || getbpt) {
printf("Pausing");
opc = pcell;
if (fbr && fbr->oldline==-1) {
opc=fbr->prevpcell;
}
if (opc&&!topf) printf(" at line %d in procedure %s",yyline,
opc->procname->obstr);
printf("\n");
pauselev++;
}
if (psigflag) {
psigflag = 0;
#ifdef EUNICE
yyprompt();
#endif
}
if (pflag || getbpt)
dorun((struct object *)(-1),(FIXNUM)0);
}
unpause() {
if (pauselev > 0) {
pauselev--;
unrun();
}
}
#endif
errhand() /* do error recovery, then pop out to outer level */
{
errtold++;
flagquit = 0;
onintr(errrec,1);
#ifdef PAUSE
longjmp(yerrbuf,9);
#else
#ifdef NEXT
blankid = [controler flush];
#else NEXT
fflush(stdout);
#endif NEXT
ltopl();
#endif
}
nullfn()
{
}
readlin(fd,buf) /* read a line from file */
register FILDES fd;
register char *buf;
{
register char *i;
for (i = buf; *(i-1) != '\n'; i++) read(fd,i,1);
}
makeup(str)
register char *str;
{
register char ch;
while (ch = *str) {
if (ch >= 'a' && ch <= 'z') *str = ch-040;
str++;
}
}
struct object *cbreak(ostr)
register struct object *ostr;
{
struct sgttyb sgt;
register char *str;
#ifdef CBREAK
if (!stringp(ostr)) ungood("Cbreak",ostr);
str = ostr->obstr;
makeup(str);
if (strcmp(str,"ON") && strcmp(str,"OFF")) {
puts("cbreak input must be \"on or \"off");
errhand();
}
gtty(0,&sgt);
if (!strcmp(str,"ON")) {
sgt.sg_flags |= CBREAK;
sgt.sg_flags &= ~ECHO;
} else {
sgt.sg_flags &= ~CBREAK;
sgt.sg_flags |= ECHO;
}
stty(0,&sgt);
mfree(ostr);
return ((struct object *)(-1));
#else
printf("No CBREAK on this system.\n");
errhand(); /* Such as V6 or Idris */
#endif
}
cboff()
{
struct sgttyb sgt;
#ifdef CBREAK
gtty(0,&sgt);
sgt.sg_flags &= ~CBREAK;
sgt.sg_flags |= ECHO;
stty(0,&sgt);
#endif
}
struct object *readchar()
{
char s[2];
fflush(stdout);
#ifdef NEXT
NXRead(aStream,s,1);
#else
read(0,s,1);
#endif NEXT
s[1] = '\0';
return(localize(objcpstr(s)));
}
struct object *keyp()
{
#ifdef TIOCEMPTY
int i;
fflush(stdout);
ioctl(0,TIOCEMPTY,&i);
if (i)
return(true());
else
#else
#ifdef FIONREAD
long i;
fflush(stdout);
ioctl(0,FIONREAD,&i);
if (i)
return(true());
else
#endif
#endif
return(false());
}
struct object *settest(val)
struct object *val;
{
if (obstrcmp(val,"true") && obstrcmp(val,"false")) ungood("Test",val);
currtest = !obstrcmp(val,"true");
mfree(val);
return ((struct object *)(-1));
}
loflush() {
fflush(stdout);
}
struct object *cmoutput(arg)
struct object *arg;
{
extern int endflag;
#ifdef PAUSE
if (!pflag && thisrun && thisrun->str==(struct object *)(-1))
unpause();
#endif
endflag = 1;
return(arg);
}
#ifdef SETCURSOR
int gotterm = 0;
/* Termcap definitions */
char *UP,
*CS,
*CM,
*CL,
*BC,
*padchar;
char PC = '\0';
short ospeed;
char tspace[128];
char **meas[] = {
&CS, &CM, &CL, &UP, &BC, &padchar, 0
};
char tbuff[1024];
getTERM()
{
char *getenv();
struct sgttyb tty;
char *ts="cscmclupbcpc";
char *termname = 0,
*termp = tspace;
int i;
if (gotterm) return(gotterm);
if (gtty(1, &tty)) {
ospeed = B1200;
} else {
tty.sg_flags &= ~ XTABS;
ospeed = tty.sg_ospeed;
stty(1,&tty);
}
termname = getenv("TERM");
if (termname == 0) {
puts("No terminal in environment.");
gotterm = -1;
return(gotterm);
}
if (tgetent(tbuff, termname) < 1) {
pf1("No termcap entry for %s\n",termname);
gotterm = -1;
return(gotterm);
}
for (i = 0; meas[i]; i++) {
*(meas[i]) = (char *) tgetstr(ts, &termp);
ts += 2;
}
if (padchar) PC = *padchar;
gotterm = 1;
return(gotterm);
}
extern int putch();
struct object *clrtxt()
{
if (getTERM() < 0) return;
tputs(CL,24,putch);
return ((struct object *)(-1));
}
struct object *setcur(x,y)
struct object *x,*y;
{
int ix,iy;
x=numconv(x,"Setcursorxy");
y=numconv(y,"Setcursorxy");
if (!intp(x)) ungood("Setcursorxy",x);
if (!intp(y)) ungood("Setcursorxy",y);
if (getTERM() > 0) {
ix = x->obint;
iy = y->obint;
tputs(tgoto(CM,ix,iy),1,putch);
}
mfree(x);
mfree(y);
return ((struct object *)(-1));
}
#endif SETCURSOR
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.