Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/28/libtes.sim
There are 2 other files named libtes.sim in the archive. Click here to see a list.
OPTIONS(/P:"Tests of external MACRO-10 procedures");
BEGIN
EXTERNAL TEXT PROCEDURE conc,daytime,today;
EXTERNAL REAL PROCEDURE clocktime,cptime;
EXTERNAL INTEGER PROCEDURE output,putsize,input,scanint;
EXTERNAL TEXT PROCEDURE rest, frontstrip;
EXTERNAL PROCEDURE write,read,sleep;
EXTERNAL TEXT PROCEDURE inline,upcase;
TEXT p,t,t1,t2,t3,t4,t5,t6;
INTEGER i,j,k,l,m,n;
BOOLEAN b,b1,b2,b3;
REAL r,r1,r2,r3;
LONG REAL lr,lr1,lr2,lr3;
CHARACTER c,c1,c2,c3;
REF(Infile)inf,inf1,inf2;
REF(Directfile)df,df1,df2;
REF(Outfile)ouf,ouf1,ouf2;
REF(Printfile)prf,prf1,prf2;
CHARACTER testchar;
TEXT im;
PROCEDURE prompt(t); VALUE t; TEXT t;
BEGIN Outtext(t); Breakoutimage; END;
PROCEDURE display(t1,t2); VALUE t1,t2; TEXT t1,t2;
BEGIN Outtext(t1); Outchar('"'); Outtext(t2); Outchar('"'); Outimage; END;
PROCEDURE inim;
BEGIN Inimage; im.Setpos(1); IF Endfile THEN GOTO out;
END;
INTEGER nproc;
BOOLEAN PROCEDURE testexists(procname); VALUE procname; TEXT procname;
BEGIN upcase(procname);
IF testchar='?' THEN
BEGIN Outtext(procname);
IF nproc = 5 THEN
BEGIN nproc:=0;
Outimage;
END ELSE
BEGIN nproc:=nproc+1;
Outchar(Char(9));
END;
END ELSE testexists:=upcase(p)=procname;
END testexists;
im :- Sysin.Image;
inf:-Sysin; ouf:-Sysout;
start: Outimage; nproc:= 0;
Outtext("Which procedure?"); Breakoutimage;
inim;
p:-Sysin.Image.Sub(1,6);
testchar:=p.Getchar;
IF testchar='?' THEN
BEGIN Outtext("Available procedures:"); Outimage;
END;
Sysin.Setpos(0);
COMMENT Each test on a new page, surrounded by
! IF testexists("p-name") THEN
! BEGIN
! <test code, including declaration of
! EXTERNAL [<type>] PROCEDURE p-name>
! END ELSE
! where p-name is exactly 6 characters from the start of
! the procedure name;
IF testexists("abort ") THEN
BEGIN
EXTERNAL PROCEDURE abort;
prompt("Give message:"); inim;
t:-Copy(im.Strip);
abort(t);
END ELSE
!-------------------------------------------------------------------;
IF testexists("boksta") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE bokstav;
INTEGER i; CHARACTER c;
FOR i:=0 STEP 1 UNTIL 127 DO
IF bokstav(Char(i)) THEN
BEGIN Outchar(Char(i)); Outchar('('); Outint(i,3); Outtext(") ");
IF Pos>50 THEN Outimage;
END;
Outimage
END ELSE
!-------------------------------------------------------------------;
IF testexists("check?") THEN GOTO scan_number ELSE
!-------------------------------------------------------------------;
IF testexists("compre") THEN
BEGIN
EXTERNAL TEXT PROCEDURE compress;
l: t:-inline("input text t:",Sysin);
IF t==NOTEXT THEN GO TO out;
prompt("Char to eliminate:/(blank)/:"); inim;
c:=im.Getchar;
display("compress(t,c)=",compress(t,c));
GO TO l;
out:
END ELSE
IF testexists("conc ") THEN
BEGIN !text concatenation;
TEXT t1,t2,t3,t;
! EXTERNAL TEXT PROCEDURE conc;
t1:-Copy("ABCDEFGHIJ");
t2:-Copy("123456789012345");
t :- conc(t1,t2);
display("t1=",t1);
display("t2=",t2);
display("t=",t);
display("t.Sub(3,11)=",t.Sub(3,11));
display("""ZYX1234""=","ZYX1234");
display("conc=",conc(t.Sub(3,11),"ZYX1234"));
END ELSE
!-------------------------------------------------------------------;
IF testexists("conc2 ") THEN
BEGIN !text concatenation;
TEXT t1,t2,t3,t;
EXTERNAL TEXT PROCEDURE conc2;
t1:-Copy("ABCDEFGHIJ");
t2:-Copy("123456789012345");
t :- conc2(t1,t2);
display("t1=",t1);
display("t2=",t2);
display("t=",t);
display("t.Sub(3,11)=",t.Sub(3,11));
display("""ZYX1234""=","ZYX1234");
display("conc2=",conc2(t.Sub(3,11),"ZYX1234"));
END ELSE
IF testexists("date ") THEN GOTO date_time_max_etc ELSE
!-------------------------------------------------------------------;
IF testexists("depcha") THEN
BEGIN
EXTERNAL PROCEDURE depchar;
CHARACTER c;
TEXT t;
INTEGER i;
t:-Blanks(10);
FOR i:=-3 STEP 1 UNTIL 12 DO
BEGIN depchar(t,i,Char(Rank('A')-1+i));
END;
Outtext(t); Outimage;
END ELSE
IF testexists("dotype") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE dotypeout;
l: prompt("Which TTY?/your own/:"); inim;
t:-Copy(im.Strip);
IF t==NOTEXT THEN
BEGIN inf1:-Sysin;
ouf1:-Sysout;
END ELSE
IF im.Getchar=Char(27) THEN GOTO out ELSE
BEGIN
inf1:-NEW Infile(t);
ouf1:-NEW Outfile(t);
inf1.Open(Blanks(80));
ouf1.Open(Blanks(80));
END;
l1: INSPECT ouf1 DO
BEGIN
Outtext("Starting output - try stopping via ^O"); Outimage;
FOR i:=1 STEP 1 UNTIL 10 DO
BEGIN
Outint(i,5); Outtext("AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA");
Outimage;
END;
IF dotypeout(ouf1) THEN
BEGIN
ouf1.Outtext("^O defeated"); ouf1.Outimage;
END;
END;
prompt("More from the same tty?/NO/"); inim;
c:=im.Getchar;
IF NOT (c=' ' OR c='N' OR c='n') THEN GOTO l1;
IF inf1=/=Sysin THEN
BEGIN
inf1.Close; ouf1.Close;
END;
GOTO l;
out:
END ELSE
IF testexists("echo ") THEN
BEGIN
EXTERNAL PROCEDURE echo;
inf:-Sysin;
prompt("Before call on echo - input a line:"); inim;
echo(inf,1);
prompt("Special editor mode, input line:"); inim;
display("Your line was:",im);
echo(inf,2);
prompt("echo should be suppressed now, input a line:"); inim;
display("Your line was:",im);
echo(inf,4);
prompt("echoing characters unaltered now, input a line:"); inim;
echo(inf,0);
prompt("Input mode as integer >=0 and <=7:"); inim;
t:-im.Strip;
echo(inf,IF t==NOTEXT THEN 0 ELSE t.Getint);
prompt("Input a line:"); inim;
display("Your line was:",im);
END ELSE
!-------------------------------------------------------------------;
IF testexists("enterd") THEN
BEGIN
EXTERNAL PROCEDURE enterdebug;
BOOLEAN con;
l: prompt("Want to continue after enterdebug?/Yes/"); inim;
c:=im.Sub(1,1).Getchar;
IF c=Char(27) THEN GOTO out;
t:-Copy(im.Strip);
con:=t==NOTEXT OR c='y' OR c='Y';
enterdebug(con);
GOTO l;
out:
END ELSE
IF testexists("fetcha") THEN
BEGIN
EXTERNAL CHARACTER PROCEDURE fetchar;
CHARACTER c;
TEXT t;
INTEGER i;
t:-Copy("ABCDEFGHIJKLMNOP");
FOR i:=-3 STEP 1 UNTIL 20 DO
BEGIN Outchar(fetchar(t,i)); Outchar(',');
END;
END ELSE
!-------------------------------------------------------------------;
IF testexists("filena") THEN
BEGIN
EXTERNAL TEXT PROCEDURE filename;
REF(Infile)inf; REF(Printfile)prf; REF(Outfile)ouf;
inf:-Sysin;
prf:-Sysout;
ouf:-NEW Outfile("TMP.TMP");
Outtext(filename(inf));
Outimage;
Outtext(filename(prf));
Outimage;
Outtext(filename(ouf));
Outimage;
END ELSE
!-------------------------------------------------------------------;
IF testexists("finddi") THEN
BEGIN
EXTERNAL REF(Directfile)PROCEDURE finddirectfile;
prompt("File spec:"); inim;
WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
BEGIN
t1:-Copy(im); !Save im;
prompt("Access/U/:");
inim; t:-im.Strip;
c:='U'; IF t=/=NOTEXT THEN c:=t.Getchar;
df:-finddirectfile(t1,c='U' OR c='u');
b:=df=/=NONE;
Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
Outimage;
prompt("File spec:"); inim;
END;
GOTO start;
END ELSE
IF testexists("findin") THEN
BEGIN
EXTERNAL REF(Infile)PROCEDURE findinfile;
prompt("File spec:"); inim;
WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
BEGIN
inf:-findinfile(im);
b:=inf=/=NONE;
Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
Outimage;
prompt("File spec:"); inim;
END;
GOTO start;
END ELSE
!-------------------------------------------------------------------;
IF testexists("findou") THEN
BEGIN
EXTERNAL REF(Outfile)PROCEDURE findoutfile;
prompt("File spec:"); inim;
WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
BEGIN
ouf:-findoutfile(im);
b:=ouf=/=NONE;
Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
Outimage;
prompt("File spec:"); inim;
END;
GOTO start;
END ELSE
!-------------------------------------------------------------------;
IF testexists("findpr") THEN
BEGIN
EXTERNAL REF(Printfile)PROCEDURE findprintfile;
prompt("File spec:"); inim;
WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
BEGIN
prf:-findprintfile(im);
b:=prf=/=NONE;
Outtext(IF b THEN "<FOUND>" ELSE "<NOT FOUND>");
Outimage;
prompt("File spec:"); inim;
END;
GOTO start;
END ELSE
IF testexists("findtr") THEN
BEGIN
EXTERNAL CHARACTER PROCEDURE findtrigger;
l0: Outtext("Stop test by altmode"); Outimage;
prompt("master string:/AB....Z$#@/:"); inim;
t:-im.Strip;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
t:-Copy(IF t==NOTEXT THEN "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@" ELSE t);
display("t=",t);
l: prompt("Start pos/1/:"); inim;
IF im.Strip == NOTEXT THEN i:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
i:=im.Getint;
prompt("subtext length/rest of t/:"); inim;
IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
j:=im.Getint;
prompt("pos of subtext/1/:"); inim;
IF im.Strip == NOTEXT THEN m:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
m:=im.Getint;
t1:-t.Sub(i,j);
display("master string",t1);
l1: t1.Setpos(m);
prompt("triggers:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l;
t2:-im.Strip;
c:=findtrigger(t1,t2);
Outtext("findtrigger value="); Outchar(c);
IF NOT t1.More THEN Outtext(" (not found)");
Outimage;
GOTO l1;
out:
END ELSE
IF testexists("freeze") THEN
BEGIN EXTERNAL PROCEDURE freeze;
freeze(i);
Outtext("Return code:"); Outint(i,5); Outimage;
END ELSE
!-------------------------------------------------------------------;
IF testexists("from ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE from;
INTEGER i;
TEXT t;
t:-Copy("ABCDEFGHIJKL");
FOR i:=-3 STEP 1 UNTIL 20 DO
BEGIN
Outtext(from(t,i)); Outimage;
END;
END ELSE
!-------------------------------------------------------------------;
IF testexists("front ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE front;
TEXT t;
t:-Copy("ABCDEFGHIJKL");
WHILE t.More DO
BEGIN
t.Getchar; Outtext(front(t)); Outimage;
END;
END ELSE
IF testexists("frontc") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE frontcompare;
Outtext("Input a string on each line - Stop test by altmode"); Outimage;
prompt("config:"); inim;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN
t:- Copy(im.Strip);
IF t=/=NOTEXT THEN t2:-t;
prompt("string:"); inim;
t:-Copy(im.Strip);
IF t=/=NOTEXT THEN t1:-t;
prompt("string.Pos:"); inim;
t:-frontstrip(im);
IF t=/=NOTEXT THEN
BEGIN
IF Digit(t.Getchar) THEN t1.Setpos(t.Getint);
END;
display("string.Rest=",rest(t1));
Outimage;
b:= frontcompare(t1,t2);
IF b THEN Outtext("<EQUAL>") ELSE Outtext("<UNEQUAL>");
Outimage;
prompt("config:"); inim;
END;
END ELSE
IF testexists("fronts") THEN
BEGIN
TEXT t,t1,t2;
INTEGER i,j,k;
Outtext("Input a string on each line - Stop test by altmode"); Outimage;
Inimage;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN
t1:- Copy(Sysin.Image.Strip);
display("t1=",t1);
t:- frontstrip(t1);
display("frontstrip(t1)=",t);
t2:- IF t1.Length>=8 THEN t1.Sub(3,6) ELSE NOTEXT;
t:- frontstrip(t2);
display("t1.Sub(3,6)=",t2);
display("frontstrip(t1.Sub(3,6))=",t);
Outtext("Input a string on each line - Stop test by altmode"); Outimage;
Inimage;
END;
END ELSE
IF testexists("getite") THEN
BEGIN
EXTERNAL TEXT PROCEDURE getitem;
l0: Outtext("Stop test by altmode"); Outimage;
prompt("text to analyze:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
t:-Copy(im);
display("t=",t);
l: prompt("Start pos/1/:"); inim;
IF im.Strip == NOTEXT THEN i:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
i:=im.Getint;
prompt("subtext length/rest of t/:"); inim;
IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
j:=im.Getint;
prompt("pos of subtext/1/:"); inim;
IF im.Strip == NOTEXT THEN m:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
m:=im.Getint;
t1:-t.Sub(i,j);
display("current text:",t1);
t1.Setpos(m);
Outtext("Items found"); Outimage;
t2:-getitem(t1);
WHILE t2=/=NOTEXT DO
BEGIN display("",t2); t2:-getitem(t1); END;
GOTO l;
out:
END ELSE
IF testexists("imax ") THEN
BEGIN
EXTERNAL INTEGER PROCEDURE imax;
INTEGER i1, i2;
i1:=1; i2:=2;
Outtext("imax(i1,i2)="); Outint(imax(i1,i2),5); Outimage;
Outtext("imax(i2,i1)="); Outint(imax(i2,i1),5); Outimage;
END ELSE
!-------------------------------------------------------------------;
IF testexists("imin ") THEN
BEGIN
EXTERNAL INTEGER PROCEDURE imin;
INTEGER i1, i2;
i1:=1; i2:=2;
Outtext("imin(i1,i2)="); Outint(imin(i1,i2),5); Outimage;
Outtext("imin(i2,i1)="); Outint(imin(i2,i1),5); Outimage;
END ELSE
!-------------------------------------------------------------------;
IF testexists("initem") THEN
BEGIN
EXTERNAL TEXT PROCEDURE initem;
l0: Outtext("Stop test by altmode"); Outimage;
l: prompt("text to analyze:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
Outtext("Items found"); Outimage;
t2:-initem(inf);
WHILE t2=/=NOTEXT DO
BEGIN display("",t2); t2:-initem(inf); END;
IF NOT inf.Endfile THEN GOTO l;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("inord ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE inord;
l0: Outtext("Stop test by altmode"); Outimage;
l: prompt("text to analyze:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
Outtext("Items found"); Outimage;
t2:-inord(inf);
WHILE t2=/=NOTEXT DO
BEGIN display("",t2); t2:-inord(inf); END;
IF NOT inf.Endfile THEN GOTO l;
out:
END ELSE
IF testexists("input ") THEN
BEGIN
ARRAY a[1:10], a1[1:2,3:4];
TEXT ARRAY ta[1:4];
prompt("Infile or Directfile (I or D)/I/:"); inim;
c1:=im.Getchar;
IF NOT (c1='d' OR c1='D') THEN
BEGIN
INSPECT NEW Infile("output.tmp") DO
BEGIN
Open(Blanks(80));
Sysout.Outimage;
inf1:-THIS Infile;
Inimage; ! To start a buffer;
FOR k:=1 STEP 1 UNTIL 8 DO
BEGIN
l:=input(inf1,i,j,r,lr,c,t,t2,t3,t4,t5,t6);
write(i,j,r,lr,c,t,t2,t3);
Sysout.Outtext("words input:"); Sysout.Outint(l,8);
Sysout.Outimage;
Sysout.Outimage;
l:=input(inf1,ta,a,a1,i,j);
Sysout.Outtext("words input:"); Sysout.Outint(l,8);
Sysout.Outimage;
write("ta[1]=""",ta[1],""", ","a1[2,4]=""",a1[2,4],"""");
Sysout.Outimage;
END;
Close;
END END ELSE
INSPECT NEW Directfile("putdf.tmp") DO
BEGIN
Open(Blanks(80));
write(i,j,r,lr,c,t2);
Sysout.Outimage;
df1:-THIS Directfile;
FOR k:=1 STEP 1 UNTIL 8 DO
BEGIN
l:=input(df1,i,j,r,lr,c,t2);
Sysout.Outtext("words input:"); Sysout.Outint(l,8);
Sysout.Outimage;
l:=input(df1,ta,a,a1,i,j);
Sysout.Outtext("words input:"); Sysout.Outint(l,8);
Sysout.Outimage;
END;
Close;
END;
END ELSE
IF testexists("inputc") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE inputcheck;
l: prompt("Which TTY?/your own/:"); inim;
t:-Copy(im.Strip);
IF t==NOTEXT THEN
BEGIN inf1:-Sysin;
ouf1:-Sysout;
END ELSE
IF im.Getchar=Char(27) THEN GOTO out ELSE
BEGIN
inf1:-NEW Infile(t);
ouf1:-NEW Outfile(t);
inf1.Open(Blanks(80));
ouf1.Open(Blanks(80));
END;
l1: ouf1.Outtext("Expecting some input:"); ouf1.Breakoutimage;
IF inf1=/=Sysin THEN
BEGIN
prompt("Give CR-LF when you want to go on"); inim;
END ELSE
BEGIN Outtext("Sleeping for 10 seconds: -"); Outimage;
sleep(10.0);
END;
IF inputcheck(inf1) THEN
BEGIN inf1.Inimage;
Outtext("Input from tty:"); Outtext(inf1.Image); Outimage;
END;
prompt("More from the same tty?/NO/"); inim;
c:=im.Getchar;
IF NOT (c=' ' OR c='N' OR c='n') THEN GOTO l1;
IF inf1=/=Sysin THEN
BEGIN
inf1.Close; ouf1.Close;
END;
GOTO l;
out:
END ELSE
IF testexists("inputw") THEN
BEGIN
EXTERNAL INTEGER PROCEDURE inputwait;
Simulation BEGIN INTEGER nch;
REAL maxtime;
Outtext("Number of TTYs:"); Breakoutimage;
nch:= Inint;
prompt("Max wait time (secs)/10.000/"); inim;
IF im.Strip=/=NOTEXT THEN maxtime:=Inreal ELSE maxtime:=10.000;
BEGIN
INTEGER inch;
REF (Infile) ARRAY infiles[1:nch];
REF (tty) ARRAY ttys[-1:nch];
Process CLASS tty(filename); VALUE filename; TEXT filename;
BEGIN REF (Infile) ttyin; REF (Outfile) ttyout;
INTEGER l;
TEXT filespec;
l:=filename.Length;
filespec:-Blanks(2*l);
filespec.Sub(1,l) := filespec.Sub(l+1,l) := filename;
filespec.Sub(l*2,1).Putchar('i');
ttyin :- NEW Infile(filespec);
filespec.Sub(l*2,1).Putchar('o');
ttyout :- NEW Outfile(filespec);
INSPECT ttyin DO
BEGIN inch:= inch + 1;
IF inch > nch THEN Sqrt(-1);
infiles[inch]:- THIS Infile;
ttys[inch]:- THIS tty;
Open(Blanks(80));
INSPECT ttyout DO
BEGIN Open(Blanks(80));
WHILE NOT Endfile DO
BEGIN Outtext("Input:"); Breakoutimage;
Passivate; Inimage;
INSPECT Sysout DO
BEGIN
Outtext(today); Outtext(" "); Outtext(daytime);
Outtext(" Input received on ");
Outtext(filename); Outchar('"');
Outtext(ttyin.Image.Strip);
Outchar('"'); Outimage
END telling the master;
END while loop;
Close
END inspecting outfile;
Close
END inspecting infile;
END of tty;
Process CLASS waiter;
BEGIN
IF inch>0 THEN GO TO First;
WHILE inch > 0 DO
BEGIN
ACTIVATE ttys[inch];
First:
inch:= inputwait(infiles,maxtime);
END loop;
IF inch=0 THEN Outtext("** no input **")
ELSE Outtext("** time exit **");
END waiter;
TEXT filename;
GO TO start;
WHILE filename =/= NOTEXT DO
BEGIN ACTIVATE NEW tty(filename);
start:
Outtext("Device:"); Breakoutimage;
Inimage; filename:- Sysin.Image.Strip;
END read loop;
ACTIVATE NEW waiter DELAY 0;
Hold(1000.0);
END block 2;
END of program
END ELSE
IF testexists("lastlo") THEN
BEGIN
EXTERNAL INTEGER PROCEDURE lastloc;
l: prompt("File spec:/df.tmp/:"); inim;
IF im.Getchar=Char(27) THEN GO TO out;
df:-NEW Directfile(IF im.Strip==NOTEXT THEN "df.tmp" ELSE im.Strip);
df.Open(Blanks(20));
i:=lastloc(df);
Outtext("lastloc="); Outint(i,5); Outimage;
l1: prompt("Add a record? Answer with Location"); inim;
IF im.Strip==NOTEXT THEN
BEGIN df.Close; GOTO l END;
j:=Inint;
IF j>0 THEN
BEGIN prompt("Contents:"); inim;
df.Intext(20);
df.Locate(j);
df.Outimage;
END;
i:=lastloc(df);
Outtext("lastloc="); Outint(i,5); Outimage;
GOTO l1;
out:
END ELSE
IF testexists("lineco") THEN
BEGIN
EXTERNAL INTEGER PROCEDURE linecount;
REF(Printfile)p;
INTEGER normal_linecount;
p:-NEW Printfile("p.TMP");
p.Open(Blanks(80));
p.Linesperpage(100);
Outint(linecount(p),10);
normal_linecount:=linecount(Sysout);
Outint(normal_linecount,10);
Linesperpage(10);
Outint(linecount(Sysout),10);
Outint(linecount(Sysout),10);
Linesperpage(normal_linecount);
Outint(linecount(NONE),10);
p.Close;
END ELSE
!-------------------------------------------------------------------;
IF testexists("litenb") THEN
BEGIN
EXTERNAL TEXT PROCEDURE litenbokstav;
INTEGER i;
TEXT t;
Outtext("Input one string per image, stop by altmode:"); Outimage;
Inimage;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN t:-Sysin.Image.Strip;
Outtext("litenbokstav=""");
Outtext(litenbokstav(t));
Outchar('"'); Outimage;
Inimage;
END;
END ELSE
IF testexists("lookah") THEN
BEGIN
EXTERNAL CHARACTER PROCEDURE lookahead;
prompt("Infile or Directfile('i' or 'd':)"); inim;
c:=im.Getchar;
b:=c='d' OR c='D';
prompt("file spec:"); inim;
t2:-im.Strip;
inf:-Sysin;
IF b THEN
BEGIN
df:-NEW Directfile(IF t2==NOTEXT THEN "X.TMP/ACCESS:RONLY" ELSE t2);
df.Open(Blanks(80));
END ELSE
BEGIN
IF t2=/=NOTEXT THEN
BEGIN inf:-NEW Infile(t2); inf.Open(Blanks(80));
END ELSE IF inf==NONE THEN
inf:-Sysin;
END;
IF b THEN
BEGIN
INSPECT df DO
BEGIN Inimage;
WHILE NOT Endfile DO
BEGIN
c:=lookahead(df); c1:=Inchar;
IF c NE c1 AND c NE ' ' THEN
BEGIN display("Error in image:",Image);
Sqrt(-1);!!!!;
GOTO fin
END END END END ELSE
BEGIN
INSPECT inf DO
BEGIN Inimage;
WHILE NOT Endfile DO
BEGIN
c:=lookahead(inf); c1:=Inchar;
IF c NE c1 AND c NE ' ' THEN
BEGIN display("Error in image:",Image);
Sqrt(-1);!!!!;
GOTO fin
END END END END;
fin:
END ELSE
IF testexists("makete") THEN
BEGIN
EXTERNAL TEXT PROCEDURE maketext;
CHARACTER c;
TEXT t;
INTEGER i;
FOR i:=-3 STEP 1 UNTIL 12 DO
BEGIN t:-maketext(Char(Rank('A')-1+i),i);
Outtext(t); Outimage;
END;
END ELSE
!-------------------------------------------------------------------;
IF testexists("max???") THEN GOTO date_time_max_etc ELSE
!-------------------------------------------------------------------;
IF testexists("number") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE numbered;
INSPECT NEW Infile("input") DO
BEGIN
Open(Blanks(80));
Inimage;
WHILE NOT Endfile DO
BEGIN
IF numbered THEN Outtext("*** ");
Outtext(Image); Outimage;
Inimage
END;
Close
END;
END ELSE
IF testexists("outchr") THEN
BEGIN
EXTERNAL PROCEDURE outchr;
l: t:-inline("output file:",Sysin);
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
IF t==NOTEXT THEN ouf1:-Sysout ELSE
BEGIN
ouf1:-NEW Outfile(t);
ouf1.Open(Blanks(20));
ouf1.Outimage;
END;
l1: t1:-inline("Chars to be copied:",Sysin);
c:=IF t1=/=NOTEXT THEN t1.Sub(1,1).Getchar ELSE Char(0);
IF c=Char(27) THEN GOTO l;
l2: t2:-inline("Repeat count:/1/:",Sysin);
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l1;
i:=1; IF t2=/=NOTEXT THEN i:=im.Getint;
WHILE t1.More DO
BEGIN
c:=t1.Getchar;
IF Digit(c) THEN
BEGIN
t1.Setpos(t1.Pos-1);
c:=Char(scanint(t1));
END;
outchr(ouf1,c,i);
END;
GOTO l2;
out:
END ELSE
IF testexists("output") THEN
BEGIN
TEXT PROCEDURE tx; tx:-Copy(" tx ");
ARRAY a[1:10], a1[1:2,3:4];
TEXT ARRAY ta[1:4];
FOR i:=1 STEP 1 UNTIL 4 DO
BEGIN
t:-Blanks(i);
FOR j:=1 STEP 1 UNTIL i DO t.Putchar(Char(i-1+Rank('A')));
ta[i]:-Copy(t);
END;
FOR i:=1 STEP 1 UNTIL 10 DO a[i]:=i*i;
FOR i:=1,2 DO FOR j:=3,4 DO a1[i,j]:=i*10+j;
r:=4004; lr:=r/345; c:='C';
prompt("Outfile or Directfile (O or D)/O/:"); inim;
c1:=im.Getchar;
IF NOT (c1='d' OR c1='D') THEN
BEGIN
INSPECT NEW Outfile("output.tmp") DO
BEGIN
Open(Blanks(80));
t4:-Copy("ABCDEFGHIJKLMNOPQPRSTUVWXYZ1234567890abcdefghijklmnopqrst");
write(i,j,r,lr,c,"TEXT");
Sysout.Outimage;
ouf1:-THIS Outfile;
Outimage; ! To start a buffer;
FOR i:=1 STEP 1 UNTIL 8 DO
BEGIN
t5:-t4.Sub(3,7); t6:-t4.Sub(13,10);
l:=putsize(i,j,r,lr,c,"TEXT",tx,t4.Sub(10,23),t4,t5,t6);
Sysout.Outtext("words output according to putsize:"); Sysout.Outint(l,8);
Sysout.Outimage;
l:=output(ouf1,i,j,r,lr,c,"TEXT",tx,t4.Sub(10,23),t4,t5,t6);
Sysout.Outimage;
Sysout.Outtext("words output:"); Sysout.Outint(l,8);
Sysout.Outimage;
l:=output(ouf1,ta,a,a1,i,j);
Sysout.Outtext("words output:"); Sysout.Outint(l,8);
Sysout.Outimage;
END;
Close;
END END ELSE
INSPECT NEW Directfile("putdf.tmp") DO
BEGIN
Open(Blanks(80));
write(i,j,r,lr,c,"TEXT");
Sysout.Outimage;
df1:-THIS Directfile;
FOR k:=1 STEP 1 UNTIL 8 DO
BEGIN
l:=output(df1,i,j,r,lr,c,"TEXT");
Sysout.Outimage;
Sysout.Outtext("words output:"); Sysout.Outint(l,8);
Sysout.Outimage;
l:=output(df1,ta,a,a1,i,j);
Sysout.Outtext("words output:"); Sysout.Outint(l,8);
Sysout.Outimage;
END;
Close;
END;
END ELSE
IF testexists("puttex") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE puttext;
TEXT t,t1,t2;
INTEGER i; BOOLEAN b;
t2:- Copy("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
t1:- Copy("12345678");
FOR i:=1 STEP 4 UNTIL 40 DO
BEGIN b:=puttext(t2,t1.Sub(2,6));
Outtext(IF b THEN "TRUE " ELSE "FALSE ");
Outtext(t2); Outimage;
END;
END ELSE
!-------------------------------------------------------------------;
IF testexists("read") THEN GOTO write_test ELSE
IF testexists("refio ") THEN
BEGIN
INTEGER count; ! Keeps track of a objects;
CLASS a(ia,ca,iaa,ta,taa);
INTEGER ia; CHARACTER ca;
INTEGER ARRAY iaa; TEXT ta; TEXT ARRAY taa;
BEGIN
INTEGER a_number;
REAL x; REF(a)ra; REF(a) ARRAY raa[1:5];
count:=count+1; !Object ordinal number;
IF count<10 THEN
BEGIN INTEGER i;
count:=count+1;
a_number:=count;
x:=count;
ra:-THIS a;
FOR i:=1 STEP 1 UNTIL 5 DO
raa[i]:-NEW a(i,Char(Mod(Rank(ca)+1,127)),iaa,ta,taa);
END;
END a;
REF(a)xa;
REF(a)ARRAY xra[1:3];
TEXT t;
TEXT ARRAY xta[1:2];
INTEGER ARRAY xia[1:2,3:4];
prompt("output or input/input/:"); inim;
testchar:=im.Getchar;
IF testchar='O' OR testchar='o' THEN
BEGIN
ouf1:-NEW Outfile("putref.tmp");
ouf1.Open(Blanks(80));
FOR i:=1,2 DO xta[i]:-Copy("ABCDEFGHIJK").Sub(i,2);
t:-Copy("12345676890");
FOR i:=1,2 DO FOR j:=3,4 DO xia[i,j]:=i*10+j;
FOR i:=1 STEP 1 UNTIL 3 DO
xra[i]:-NEW a(i,Char(i+Rank('A')-1),xia,t,xta);
FOR i:=1,2,3 DO
BEGIN
xa:-xra[i];
l:=putsize(xa);
Sysout.Outtext("putsize="); Sysout.Outint(l,5); Sysout.Outimage;
l:=output(ouf1,xa);
Sysout.Outtext("output="); Sysout.Outint(l,5); Sysout.Outimage;
END;
ouf1.Close; ouf1:-NONE;
END ELSE
BEGIN
inf1:-NEW Infile("putref.tmp");
inf1.Open(Blanks(80));
FOR i:=1,2 DO xta[i]:-Copy("ABCDEFGHIJK").Sub(i,2);
t:-Copy("12345676890");
FOR i:=1,2 DO FOR j:=3,4 DO xia[i,j]:=i*10+j;
FOR i:=1 STEP 1 UNTIL 3 DO
xra[i]:-NEW a(-i,' ',xia,t,xta);
FOR i:=1,2,3 DO
BEGIN
xa:-xra[i];
input(inf1,xa);
END;
inf1.Close; inf1:-NONE;
END;
END ELSE
IF testexists("restor") THEN
BEGIN EXTERNAL PROCEDURE restore;
l: prompt("Program name:/x/:"); inim;
t:-im.Strip;
IF t==NOTEXT THEN t:-Copy("x") ELSE t:-Copy(t);
IF t.Getchar=Char(27) THEN GOTO out;
restore(t);
GOTO l;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("run ") THEN
BEGIN EXTERNAL PROCEDURE run;
l: prompt("Program name:/x/:"); inim;
t:-im.Strip;
IF t==NOTEXT THEN t:-Copy("x") ELSE t:-Copy(t);
IF t.Getchar=Char(27) THEN GOTO out;
l1: prompt("Entry point number/1/:"); inim;
c:=im.Getchar;
IF c=Char(27) THEN GOTO l;
i:=1; IF im.Strip=/=NOTEXT THEN i:=Inint;
run(t,i);
GOTO l1;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("save ") THEN
BEGIN EXTERNAL INTEGER PROCEDURE save;
l: prompt("save file name:/x.sav/:"); inim;
t:-im.Strip;
IF t==NOTEXT THEN t:-Copy("x.sav") ELSE t:-Copy(t);
IF t.Getchar=Char(27) THEN GOTO out;
l1: prompt("Continue on error?/Yes/:"); inim;
c:=im.Getchar;
IF c=Char(27) THEN GOTO l;
b:=c=' ' OR c='Y' OR c='y';
i:=save(t,b); Outtext("Result="); Outint(i,3); Outimage;
GOTO l1;
out:
END ELSE
IF testexists("scanto") THEN
BEGIN
EXTERNAL TEXT PROCEDURE scanto;
l0: Outtext("Stop test by altmode"); Outimage;
prompt("master string:/AB....Z$#@/:"); inim;
t:-im.Strip;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
t:-Copy(IF t==NOTEXT THEN "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@" ELSE t);
display("t=",t);
l: prompt("Start pos/1/:"); inim;
IF im.Strip == NOTEXT THEN i:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
i:=im.Getint;
prompt("subtext length/rest of t/:"); inim;
IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
j:=im.Getint;
prompt("pos of subtext/1/:"); inim;
IF im.Strip == NOTEXT THEN m:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
m:=im.Getint;
t1:-t.Sub(i,j);
display("master string",t1);
l1: t1.Setpos(m);
prompt("character:/ /:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l;
c:=im.Getchar;
t3:-scanto(t1,c);
display("scanto value=",t3);
k:=t1.Pos-1;
IF NOT t1.More THEN
BEGIN Outtext(" (not found)");
Outimage;
END ELSE
BEGIN c1:=t1.Sub(k,1).Getchar;
IF c1 NE c THEN
BEGIN
display("found character:",t1.Sub(k,1));
Outtext("ERROR."); Outimage;
END;
END;
GOTO l1;
out:
END ELSE
IF testexists("scan??") THEN
scan_number:
BEGIN
SWITCH sw:=l1,l2,l3,l4,l5,l6;
EXTERNAL INTEGER PROCEDURE checkint,checkreal,checkfrac;
EXTERNAL INTEGER PROCEDURE scanfrac;
EXTERNAL LONG REAL PROCEDURE scanreal;
TEXT t,t1;
INTEGER i,j;
l: Outtext("which procedure? 1-checkint,2-checkreal,3-scanint,4-scanreal,");
Outimage; Outtext("5-checkfrac,6-scanfrac:");
Breakoutimage; Inimage; i:=Inint;
Outtext("input string:"); Breakoutimage; Inimage;
t:-Copy(Sysin.Image);
Outtext(" Pos:/1/:"); Breakoutimage; Inimage;
IF Sysin.Image.Strip=/=NOTEXT THEN t.Setpos(Inint);
GOTO sw[i];
GOTO out;
l1: Outint(checkint(t),3); Outint(t.Pos,4); Outimage; GOTO l;
l2: Outint(checkreal(t),3); Outint(t.Pos,4); Outimage; GOTO l;
l3: Outint(scanint(t),15); Outint(t.Pos,4); Outimage; GOTO l;
l4: Outreal(scanreal(t),10,20); Outint(t.Pos,4); Outimage; GOTO l;
l5: Outint(checkfrac(t),3); Outint(t.Pos,4); Outimage; GOTO l;
l6: Outint(scanfrac(t),15); Outint(t.Pos,4); Outimage; GOTO l;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("scratc") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE scratchfile;
prompt("File spec:"); inim;
WHILE NOT (Endfile OR im.Strip==NOTEXT) DO
BEGIN
b:=scratchfile(im);
Outtext(IF b THEN "<DONE>" ELSE "<NOT DONE>");
Outimage;
prompt("File spec:"); inim;
END;
GOTO start;
END ELSE
IF testexists("search") THEN
BEGIN
EXTERNAL INTEGER PROCEDURE search;
l0: Outtext("Stop test by altmode"); Outimage;
prompt("master string:/AB....Z$#@/:"); inim;
t:-im.Strip;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
t:-Copy(IF t==NOTEXT THEN "ABCDEFGHIJKLMNOPQRSTUVWXYZ$#@" ELSE t);
display("t=",t);
l: prompt("Start pos/1/:"); inim;
IF im.Strip == NOTEXT THEN i:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
i:=im.Getint;
prompt("subtext length/rest of t/:"); inim;
IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
j:=im.Getint;
prompt("pos of subtext/1/:"); inim;
IF im.Strip == NOTEXT THEN m:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
m:=im.Getint;
t1:-t.Sub(i,j);
display("master string",t1);
l1: t1.Setpos(m);
prompt("pattern:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l;
t2:-Copy(im.Strip);
prompt("Subtext pos of pattern:/1/:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l1;
IF im.Strip=/=NOTEXT THEN
BEGIN k:=im.Getint;
IF k>0 AND k<=t2.Length
THEN t2:-t2.Sub(k,t2.Length-k+1)
ELSE t2:-NOTEXT;
display("pattern used:",t2);
END;
k:=search(t1,t2);
Outtext("search value="); Outint(k,4);
IF k>t1.Length THEN Outtext(" (not found)");
Outimage;
IF k<=t1.Length THEN
BEGIN t3:-t1.Sub(k,t2.Length);
IF t3 NE t2 THEN
BEGIN
display("found subtext:",t3);
Outtext("ERROR."); Outimage;
END;
END;
GOTO l1;
out:
END ELSE
IF testexists("skip ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE skip;
l: prompt("input text t:"); inim;
t:-im.Strip;
IF t==NOTEXT THEN GO TO out ELSE t:-Copy(t);
prompt("Char to skip:/(blank)/:"); inim;
c:=im.Getchar;
l1: prompt("t.Setpos(i), give i:/1/:"); inim;
t1:-im.Strip;
IF t1=/=NOTEXT THEN i:=t1.Getint ELSE i:=1;
IF i=0 THEN GOTO l;
t.Setpos(i);
display("skip(t,c)=",skip(t,c));
GO TO l1;
out:
END ELSE
IF testexists("sleep ") THEN
BEGIN
! EXTERNAL PROCEDURE sleep;
REAL x;
l: prompt("Sleep interval (seconds):"); inim;
IF im.Strip==NOTEXT THEN GOTO out ELSE x:=im.Getreal;
sleep(x);
GOTO l;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("storbo") THEN
BEGIN
EXTERNAL TEXT PROCEDURE storbokstav;
INTEGER i;
TEXT t;
Outtext("Input one string per image, stop by altmode:"); Outimage;
Inimage;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN t:-Sysin.Image.Strip;
Outtext("storbokstav=""");
Outtext(storbokstav(t));
Outchar('"'); Outimage;
Inimage;
END;
END ELSE
IF testexists("tagord") THEN
BEGIN
EXTERNAL TEXT PROCEDURE tagord;
l0: Outtext("Stop test by altmode"); Outimage;
prompt("text to analyze:"); inim;
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO out;
t:-Copy(im);
display("t=",t);
l: prompt("Start pos/1/:"); inim;
IF im.Strip == NOTEXT THEN i:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
i:=im.Getint;
prompt("subtext length/rest of t/:"); inim;
IF im.Strip == NOTEXT THEN j:=t.Length-i+1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
j:=im.Getint;
prompt("pos of subtext/1/:"); inim;
IF im.Strip == NOTEXT THEN m:=1 ELSE
IF im.Sub(1,1).Getchar=Char(27) THEN GOTO l0 ELSE
m:=im.Getint;
t1:-t.Sub(i,j);
display("current text:",t1);
t1.Setpos(m);
Outtext("Items found"); Outimage;
t2:-tagord(t1);
WHILE t2=/=NOTEXT DO
BEGIN display("",t2); t2:-tagord(t1); END;
GOTO l;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("time ") THEN
date_time_maxint_etc:
BEGIN
EXTERNAL REAL PROCEDURE maxreal;
EXTERNAL INTEGER PROCEDURE maxint;
Outtext(today); Outchar(' '); Outtext(daytime); Outimage;
Outtext("cptime:"); Outfix(cptime,3,15);
Outtext(" clocktime:"); Outfix(clocktime,3,15);
Outimage;
Outtext("maxreal:"); Outreal(maxreal,19,25);
Outtext(" maxint:"); Outint(maxint,15);
Outimage;
END ELSE
IF testexists("tmpin ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE tmpin;
L: t:-inline("tmp name:/tmp/:",Sysin);
IF im.Sub(1,1).Getchar=Char(27) THEN GO TO out;
IF t==NOTEXT THEN t:-Copy("TMP");
t2:-inline("Delete?/no/:",Sysin);
IF t2==NOTEXT THEN b1:=FALSE ELSE
BEGIN c:=im.Sub(1,1).Getchar; b1:=c='y' OR c='Y'
END;
t1:-tmpin(t,b1);
Outtext("TMPCOR file length, contents:"); Outint(t1.Length,4); Outimage;
t2:-Image; Image:-t1; Outimage; Image:-t2;
GO TO L;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("tmpnam") THEN
BEGIN
EXTERNAL TEXT PROCEDURE tmpnam;
l: prompt("Progid:"); inim;
t:-im.Strip;
IF im.Getchar=Char(27) THEN GOTO out;
display("tmpnam(progid)=",tmpnam(t));
GO TO l;
out:
END ELSE
!-------------------------------------------------------------------;
IF testexists("tmpout") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE tmpout;
L: t:-inline("tmp name:/tmp/:",Sysin);
IF im.Sub(1,1).Getchar=Char(27) THEN GO TO out;
IF t==NOTEXT THEN t:-Copy("TMP");
t1:-inline("Contents of TMPCOR file:",Sysin);
IF im.Sub(1,1).Getchar=Char(27) THEN GO TO L;
t3:-Blanks(2); t3.Putchar(Char(13)); t3.Putchar(Char(10)); !CR-LF;
t2:-conc(t1,t3);
WHILE t1=/=NOTEXT DO
BEGIN
t1:-inline("next line or CR",Sysin);
t2:-conc(t2,t1,t3);
END;
IF tmpout(t,t2) THEN Outtext("Ok?") ELSE Outtext("Error");
GO TO L;
out:
END ELSE
IF testexists("trmop ") THEN
BEGIN !test trmop functions;
EXTERNAL INTEGER PROCEDURE trmop;
INTEGER PROCEDURE inoct;
BEGIN INTEGER i; CHARACTER c;
Lastitem;
WHILE Sysin.Image.More DO
BEGIN c:=Inchar;
IF Digit(c) THEN i:=i*8+Rank(c)-Rank('0') ELSE GOTO exit;
END;
exit: inoct := i
END inoct;
INTEGER function,val;
Outtext("Stop test by altmode"); Outimage;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN
Outtext("give function: "); Breakoutimage;
function:=inoct;
IF function//8r1000 NE 1 THEN
BEGIN Outtext(" value: "); Breakoutimage;
val:=inoct;
END;
Outtext("result: "); Outint(trmop(function,Sysout,val),15);
Outimage;
Inimage;
END sysin input loop;
END ELSE
IF testexists("tsub ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE tsub;
INTEGER i;
TEXT t;
t:-Copy("ABCDEFGHIJKL");
FOR j:=-1 STEP 4 UNTIL 20 DO
FOR i:=-3 STEP 4 UNTIL 20 DO
BEGIN
Outtext("tsub(t,"); Outint(i,3); Outchar(','); Outint(j,3);
Outtext(")="""); Outtext(tsub(t,i,j)); Outchar('"');
Outimage;
END;
END ELSE
!-------------------------------------------------------------------;
IF testexists("upcase") THEN
BEGIN
! EXTERNAL TEXT PROCEDURE upcase;
INTEGER i;
TEXT t;
Outtext("Input one string per image, stop by altmode:"); Outimage;
Inimage;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN t:-Sysin.Image.Strip;
Outtext("upcase="""); Outtext(upcase(t)); Outchar('"'); Outimage;
Inimage;
END;
END ELSE
IF testexists("upcomp") THEN
BEGIN
EXTERNAL BOOLEAN PROCEDURE upcompare;
Outtext("Input a master string on each line - Stop test by altmode");
Outimage;
prompt("test string:"); inim;
WHILE NOT (Endfile OR im.Sub(1,1).Getchar=Char(27)) DO
BEGIN
t:- Copy(im.Strip);
IF t=/=NOTEXT THEN t2:-t;
prompt("master:"); inim;
t:-Copy(im.Strip);
IF t=/=NOTEXT THEN t1:-t;
prompt("master.Pos:"); inim;
t:-frontstrip(im);
IF t=/=NOTEXT THEN
BEGIN
IF Digit(t.Getchar) THEN t1.Setpos(t.Getint);
END;
display("rest(master)=",rest(t1));
Outimage;
b:= upcompare(t1,t2);
IF b THEN Outtext("<EQUAL>") ELSE Outtext("<UNEQUAL>");
Outimage;
prompt("test string:"); inim;
END;
END ELSE
!-------------------------------------------------------------------;
IF testexists("upto ") THEN
BEGIN
EXTERNAL TEXT PROCEDURE upto;
INTEGER i;
TEXT t;
t:-Copy("ABCDEFGHIJKL");
FOR i:=-3 STEP 1 UNTIL 20 DO
BEGIN
Outtext(upto(t,i)); Outimage;
END;
END ELSE
OPTIONS(/-W);
IF testexists("write") THEN
write_test: BEGIN
REAL x,y;
REAL ARRAY a[1:5],a1[1:2,1:2];
CHARACTER ARRAY ca[1:3];
INTEGER ARRAY ia[1:2];
LONG REAL ARRAY la[1:2];
TEXT ARRAY ta[1:4];
FOR i:=1,2 DO FOR j:=1,2 DO
BEGIN
a[i+2*(j-1)]:=10^(i+10*j);
a1[i,j]:=i+10^(-j);
t:-ta[i+2*(j-1)]:-Blanks(30);
FOR k:=i STEP 1 UNTIL 30+i-1 DO t.Putchar(Char(i+Rank('A')-1));
END;
write("a=",a);
write("a1=",a1);
write("ta=",ta);
l: prompt("Type of data? (c,i,l,r),followed by a for arrays:/r/:"); inim;
c:=im.Getchar;
c2:=im.Getchar;
IF c=Char(27) THEN GO TO out;
l1: prompt("Input an item:"); inim;
IF im.Strip==NOTEXT THEN GOTO l;
IF c='c' THEN
BEGIN
IF c2='a' THEN
BEGIN
read(ca);
write(ca);
END ELSE
BEGIN
read(c1);
write(c1)
END;
END ELSE
IF c='t' THEN
BEGIN
t1:-Intext(80);
write(t1)
END ELSE
IF c='l' THEN
BEGIN
IF c2='a' THEN
BEGIN
read(la);
write(la);
END ELSE
BEGIN
read(lr1);
write(lr1)
END;
END ELSE
IF c='i' THEN
BEGIN
IF c2='a' THEN
BEGIN
read(ia);
write(ia);
END ELSE
BEGIN
read(i);
write(i)
END;
END ELSE
BEGIN
IF c2='a' THEN
BEGIN
read(a);
write(a);
END ELSE
BEGIN
read(x);
write(x)
END;
END;
GOTO l1;
out:
END ELSE
!End of test program;
BEGIN
IF p.Strip=/=NOTEXT THEN
BEGIN IF testchar NE '?' THEN
BEGIN Outtext("No test for "); Outtext(p); Outimage;
Outtext("? for help"); Outimage;
END END;
END;
IF NOT Endfile THEN GOTO start;
out:
END