perm filename PONYSY.SAI[PNY,SYS]9 blob
sn#139297 filedate 1975-01-14 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PONY" COMMENT
C00007 00003 COMMENT Useful Sail macros
C00012 00004 ! Initialization
C00017 00005 ! SCANNING PROCEDURES
C00026 00006 ! OUTPUT PROCEDURES
C00038 00007 ! DO IT
C00044 ENDMK
C⊗;
BEGIN "PONY" COMMENT
Prancing Pony Cooperative
Point-of-sale Terminal
If you are a "local" user of our system you may charge food on this
terminal. Example: if your programmer initials are "LEO" and you
want to buy a cup of coffee, type
LEO C<return>
COFFEE POOL: Normally the Pony will ask you once a month if you want
to join the coffee pool ($3/month). If you say "Y" it will bill you
accordingly. If you type something else, it will wait till next
month, unless you type precisely "NO, NO, 1000*NO", in which case it
will never ask you again. Even if you choose to charge by the cup,
you will not be billed for more than $3 each month for coffee and
tea.
LUCKY WINNER FEATURE: Occasionally, the program will decide that you
are such a good customer that it will give you the food free. It will
inform you of this decision with suitable bell-ringing.
GAMBLER MODE: If you type an "F", the Pony flips you for it, double
or nothing, and announces the outcome (50:50 chance -- honest!). The
Pony declines to play for negative entries or for cash ("M" code, see
below).
For example, to buy two bagels, a donut, a 20 cent vending machine
item, a 35 cent vending machine item, mild indigestion, and flip for
double or nothing, type
LEO BBD V20 V35 F
In this case, it will open the 20 cent door first and wait for you to
hit <return> again before it opens the .35 door and tells you whether
you won or lost.
The complete list of item codes is:
B - Bagels
C - Coffee or tea
D - Donuts
M - Money (stealing from the change box)
S - Snacks (munches, soup, hot chocolate, etc.)
V - Vending machine
F - Flip for it, double or nothing
G - to enter Gripes, compliments, remarks
I - Itemize your charges day-by-day.
P - change your Password
T - show your Total changes for the month
The B, C, and D codes can be used without a number following, since
their prices are known to the machine. For the V, S, and M codes the
amount must be specified. You can also "uncharge" by specifying a
negative value. For example,
LEO -CCC M-25 V-35
credits your account for three cups of coffee, 25 cents in cash, and a
35 cent vending machine purchase, and arouses the suspicions of the
accountants.
If you would like to know about charges for earlier months, use the "T" or
"I" command followed by ":" and 3 or more letters of the month name.
Thus if LEO were interested in totals for July and August and itemized
charges for September, he would type
LEO T:JUL T:AUG I:SEP
RANDOM INFORMATION: If you would like to know how much has been given
away by the LUCKY WINNER FEATURE, type "SYS T" or "SYS I". To find
out the house net on DOUBLE OR NOTHING this month, type "F T" or "F I".
A positive total means the house is losing. Each of these commands
also lists gross sales for the month.
Bon appetit!
;
COMMENT Useful Sail macros;
REQUIRE "[]<>" DELIMITERS;
DEFINE TAB='11,LF='12,VT='13,FF='14,CR='15,ALT='175,DEL='177,↓=[(CR&LF)],
!=[COMMENT], THRU=[STEP 1 UNTIL], LN=[LENGTH],PROC=[SIMPLE PROCEDURE];
DEFINE PMAX=[300],CMAX=[12]; ! max people, charges/line;
DEFINE BILLFILE=[".PNY"],KEYFILE=["KEYWD"],DOORFILE=["DOORP"],
GRIPEFILE=[" LES.MSG[2,2]"];
DEFINE BEER=[1],CREDIT=[6],LH=['777777000000],KEYMASK=['777770]; ! masks;
DEFINE ASKED=['2],DUN=['4],QUIET=['6]; ! codes;
DEFINE TTYUUO=['051000000000], CALLI=['47000000000], VMICONO=['736600000000],
MTAPE=['072000000000];
DEFINE SYMBRK=2; ! allocate and initialize break tables;
DEFINE BREAK_TABLE(STUFF)=[
REDEFINE SYMBRK=SYMBRK+1, ZZZ=[BREAK]&CVS(SYMBRK);
IFCR SYMBRK>12 THENC REQUIRE "Too many break tables" MESSAGE; ENDC
SIMPLE PROCEDURE ZZZ; SETBREAK(SYMBRK,STUFF);
REQUIRE ZZZ INITIALIZATION;
];
DEFINE BREAK(ID,TERM,OMIT,MODES)= [
BREAK_TABLE(<TERM,OMIT,MODES>);
DEFINE ID=SYMBRK
];
DEFINE SCNBRK(ID,TERM,OMIT,MODES)= [
BREAK_TABLE(<TERM,OMIT,MODES>);
DEFINE ID(S)=[SCAN(S,]&CVS(SYMBRK)&[,BRK)]
];
DEFINE LETTERS=["ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"];
DEFINE SAY(MES)=[OUT(TTY,MES)], INLINE=[INPUT(TTY,1)];
DEFINE TTY=[1],OUCH=[2]; ! TTY I/O channel, DSK CHAN.;
INTEGER INCH,BRK,EOF,FLAG,TTYEOF; ! INPUT/OUTPUT GLOBALS;
STRING BLANKS;
STRING PROC ASK(STRING MES); BEGIN SAY(MES); RETURN(INLINE) END;
STRING PROC RIGHT(INTEGER L; STRING S);
RETURN(IF LN(S)<L THEN BLANKS[1 TO L-LN(S)]&S ELSE S[∞-L+1 TO ∞]);
STRING PROC DEC2(INTEGER D); RETURN(("0"+D%10)&("0"+D MOD 10));
STRING PROC CENTS(INTEGER P); ! integer → $.cents;
RETURN(if P=0 then "0" else
(if abs P≥100 then cvs(P%100) else if P<0 then "-0" else null)&
"."&DEC2(abs P mod 100));
INTEGER PROC HASH(INTEGER SIXB); RETURN(KEYMASK LAND (SIXB*SIXB)); ! hash code;
PROC NOTICE(STRING MESS); BEGIN ! trouble in River City;
SAY("πππ"); SAY(MESS); SAY(" -- PLEASE NOTIFY FRONT OFFICE"&↓);
END;
PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
"OCT","NOV","DEC";
STRING ARRAY MONTH[1:12];
! Initialization;
PRELOAD_WITH CVSIX("GODMOD"),'15,0;
INTEGER ARRAY PNYPASS[0:3]; ! master password block;
INTEGER ARRAY DOOR[0:9]; ! vending machine charges;
INTEGER ARRAY PN[1:PMAX]; ! PN,,password;
STRING ARRAY FRIEND[1:PMAX]; ! friendly name;
boolean phantom; ! TRUE if this is a phantom;
INTEGER PTOP; ! last entry in PN;
SCNBRK(FLUSH,<" ,;$+">,NULL,"XNR"); ! FLUSH JUNK;
SCNBRK(SCALET,LETTERS,NULL,"XNR"); ! GOBBLE LETTERS;
SCNBRK(NUMS,"0123456789.",<" ,;$+">,"XNR"); ! gobble number;
SCNBRK(DIGS,"0123456789",NULL,"XNR"); ! gobble integer;
PROCEDURE INITIAL; BEGIN ! INITIALIZE THE WORLD;
REQUIRE "PHONEY.SAI[1,LES]" SOURCE_FILE;
INTEGER II,pnpa;
LABEL FULL;
procedure store; if ptop<pmax then begin "store PN & friendly"
pn[ptop←ptop+1]←cvsix(prog);
friend[ptop]←friendly;
end
else begin notice("Too many users"); go to full end;
BLANKS←" ";
SETBREAK(1,LF,CR,"INS");
! Pick a TTY;
START_CODE SETOM II; TTYUUO 6,II; END;
PHANTOM←(II=-1); ! IF DETACHED, ITS A PHANTOM;
OPEN(TTY,IF PHANTOM THEN "TTY4" ELSE "TTY",'401,1,1,400,BRK,TTYEOF);
START_CODE SETSTS TTY,1; END; ! Repair TTY IOS;
! Open for accounting I/O;
open(ouch,"dsk",'17,0,0,400,brk,eof);
! Get PN list;
ptop←0;
while read do store;
while class ∧ ¬equ(proj,"Computer Science") do; ! flush non-locals;
friendly←scalet(last); store;
while class do begin friendly←scalet(last); store; end;
! Read password file;
FULL: open(inch←getchan,"dsk",'10,4,0,400,brk,eof);
lookup(inch,keyfile,flag);
if flag then notice("Can't read "&keyfile) else
while ¬eof do if (pnpa←wordin(inch)) land '777777 then begin "search"
integer ps;
ps←lh land pnpa;
for ii←2 thru ptop do if ps=pn[ii] then begin
pn[ii]←pnpa; done
end;
end;
close(inch);
! Read VM prices;
lookup(inch,doorfile,flag);
if flag then notice("Can't read price file")
else arryin(inch,door[0],10);
release(inch);
end "INITIAL";
REQUIRE INITIAL INITIALIZATION;
PROCEDURE WRITEARR(STRING FILE;REFERENCE INTEGER A;INTEGER TOP); BEGIN
enter(ouch,file,flag);
if ¬flag then arryout(ouch,A,top) else
notice(file&" can't be written");
close(ouch);
END;
BOOLEAN PROCEDURE MAIL(string file,mess); if phantom then begin
INTEGER ginch,gouch,ieof,iflag,oflag; ! mail MESS to FILE;
OPEN(GINCH←GETCHAN,"DSK",1,4,0,400,BRK,IEOF);
LOOKUP(GINCH,FILE,IFLAG);
OPEN(GOUCH←GETCHAN,"DSK",1,0,4,0,0,0);
ENTER(GOUCH,FILE,FLAG);
if flag then begin release(ginch); release(gouch); RETURN(false) end;
out(gouch,mess);
if ¬iflag then do out(gouch,input(ginch,0)) until ieof; ! copy old file;
release(ginch); release(gouch); return(true)
end "MAIL";
! SCANNING PROCEDURES;
while true do begin "main"
LABEL START;
string s,so; ! working string, original;
STRING DATIME,pns; ! date-time, prog name;
STRING VMQ,tiq,mon; ! VM queue, TI queue, month;
INTEGER DATE,TIME,DAY; ! current date, time, day;
INTEGER CI,NEG; ! # of charges, minus detected;
INTEGER ARRAY RECORD[1:128+CMAX*2]; ! account buffer;
INTEGER ARRAY CHARGE,CODIT[1:CMAX]; ! prices, codes;
INTEGER ID,PNI,TOT,free; ! Prog. ID, index, total bill, freebies;
integer luck; ! 0=lose, 1=win, 2=normal, 3=lucky;
integer seen; ! 0=normal, 1=negative seen, 2=M seen;
boolean peon;
PROC BARF(STRING MES); BEGIN ! another try;
say("πππ"); say(mes&↓); go to start
end;
PROC ERROR; BARF(so[1 to ∞-ln(s)]&"? Please retype the line");
BOOLEAN PROCEDURE MASTER(INTEGER SIXB); BEGIN ! test master password;
BOOLEAN MF;
PNYPASS[3]←SIXB;
LOOKUP(OUCH,"PNYSYS.UFD[1,1]",MF);
IF MF THEN BEGIN CLOSE(OUCH); BARF("No [PNY,SYS] UFD"); END;
START_CODE SETOM MF; MTAPE OUCH,PNYPASS[0]; SETZM MF END;
! MTAPE skips if SIXB is the password;
CLOSE(OUCH); RETURN(MF)
END "MASTER";
INTEGER PROC SCENT; BEGIN ! convert price;
integer i,j,k,n;
string ss,so;
flush(s);
so←s; n←neg;
if s="-" then n←lop(s);
if ln(ss←nums(s))=0 then begin s←so; return(0) end; ! restore s;
i←cvd(digs(ss));
if brk="." then begin "decimals"
j←lop(ss);
if ln(ss)=0 then i←100*i else
if "0"≤(j←lop(ss))≤"9" ∧ "0"≤(k←lop(ss))≤"9" then
i←100*i+10*j+k-(10*"0"+"0") else error;
end;
if ln(ss) then error;
return(if n then -i else i)
end "SCENT";
PROC BILL(INTEGER CODE,AMT); BEGIN ! write the bill;
if ci≥cmax then barf("Line too long");
codit[ci←ci+1]←cvsix(code);
if (charge[ci]←amt)<0 then seen←1 else if code="M" then seen←2;
end;
PROC CHECK(INTEGER CODE,PRICE); BEGIN ! see if its a multiple of base price;
integer pi;
if (pi←scent)=0 ∨ (pi mod price)≠0 then
barf(""""&code&""" price must be a multiple of "¢s(price));
BILL(CODE,pi);
END;
PROC POOT(INTEGER CODE,PRICE); BEGIN ! charge multiple of PRICE;
integer pi;
flush(s);
if s=code then begin "string"
pi←price;
do begin
pi←pi+price;
s←s[2 to ∞];
flush(s);
end
until s≠code;
if neg then pi←-pi;
end
else if (pi←scent)=0 then pi←if neg then -price else price
else if (pi mod price)≠0 then
barf(""""&code&""" price must be a multiple of "¢s(price));
bill(code,pi);
END "POOT";
PROC VENDI; BEGIN ! vending set-up;
integer va,vi,vj;
if va←abs(vi←scent) then
for vj←0 thru 9 do if va=abs(door[vj]) then begin "gotcha"
if vi>0 then vmq←vmq&vj; ! put it on the VM queue;
bill("V",vi); ! & bill it;
if door[vj]<0 then begin "beer"
if ((va←pn[pni]) land keymask)=0 then
barf("You need a password to buy booze");
if va land beer then barf("Sorry, kid.");
end;
return
end "gotcha";
barf("The vending machine doesn't have a "¢s(va)&" door");
END "VENDI";
INTEGER PROC TOTE; ! this month, or earlier? ;
if s≠":" then return((date div 31)mod 12 + 1) else begin "earlier"
integer ti; string ts;
ti←lop(s); flush(s); ! get to month name;
ts←scalet(s); ts←ts[1 to 3]; ! take first 3 letters;
for ti←1 thru 12 do if equ(ts,month[ti]) then return(ti);
barf(ts&" isn't a month");
end "earlier";
INTEGER PROC SLURP(STRING MES); BEGIN ! read a password;
integer pass,intbit;
string val;
integer aprsav,inten; ! place to save earlier interrupts;
external integer jobapr,jobcni,jobenb;
label interrupt,getit;
proc reenable; begin ! switch back to old interrupts;
call(0,"intenb"); ! turn off interrupts;
jobapr←aprsav; ! restore interrupt handler;
call(inten,"aprenb"); ! reenable old interrupts;
setsts(tty,getsts(TTY)land (lnot '600)); ! Turn on echo;
end;
pass←0;
setsts(TTY,getsts(TTY) lor '600); ! echo off;
say(mes);
inten←jobenb;
start_code
SAFE OWN INTEGER ARRAY SAVACS[0:'17];
MOVEM '17,SAVACS['17]; ! save ACs;
MOVEI '17,SAVACS[0];
BLT '17,SAVACS['16];
MOVE '17,SAVACS['17];
movei 2, interrupt;
exch 2, jobapr; ! interrupt there;
movem 2,aprsav; ! save jobapr;
'717040001130; ! clock int.= 10 sec.;
jrst getit;
interrupt:
calli '400035; ! DEBREAK: user level;
MOVSI '17,SAVACS[0]; ! restore ACs;
BLT '17,'17;
end;
if (pass←pass+1)≥3 then begin "timeout" reenable; return(-1) end;
say("ππππ");
getit: val←inline;
reenable; say(↓);
return(cvsix(right(6,val)));
end "SLURP";
PROCEDURE NIX(integer BAZ); if baz=0 then barf("FOO -- YOU ARE A PASSWORD HACKER")
else if baz=-1 then begin "timeout"
if ci ∧ codit[1]≠cvsix("V") ∨ ¬peon then
MAIL((if peon then right(6,pns) else " LES")&".msg[2,2]",
"∂"&datime&" Prancing Pony
The following entry was typed on the Pony TTY, but no password.
"&pns&" "&so&(if ¬ci then ↓ else "
If you intended this charge to be made, please reenter it.
"));
barf("ππππABORTED BY TIMEOUT");
end
else say(<"πππSORRY, CHARLIE"&↓>);
! OUTPUT PROCEDURES;
PROCEDURE FIXPASS; BEGIN ! SET PRIVELEGES;
integer fpn,fi;
string fs;
label more;
say("? FOR HELP"&↓);
MORE: while ln(fs←ask("*")) do if fs="?" then say(
<"<BLANK> - QUIT
<PN> - SHOW HIS CONTROL CODES
<PN> CODES - SET CODES, WHERE
P - CLEAR PASSWORD
C - CLEAR BEER, CREDIT, & COFFEE
N - NO BEER
A - ALREADY ASKED ABOUT COFFEE
D - DUN HIM
Q - QUIET - DON'T ASK ABOUT COFFEE
">)
else begin "search"
label OK;
integer fpn,val;
fpn←cvsix(scalet(fs)); flush(fs);
for fi←1 thru ptop do if fpn=(lh land (val←pn[fi])) then begin "pn"
if ln(fs)=0 then begin "tellme"
say(<" "&
(if (val land keymask)=0 then "P" else "")&
(if val land beer then "N" else "")&
(case (val land credit)lsh -1 of (
(if val land beer then "" else "C"),
"A","D","Q"))&↓>)
end "tellme"
else begin "enter"
integer fc;
while fc←lop(fs) do
if fc="P" then val←val land (lnot keymask)
else if fc="C" then val←val land(lh lor keymask)
else if fc="N" then val←val lor beer
else if fc="D" then
val←(val land (lnot credit)) lor dun
else if fc="Q" then
val←(val land (lnot credit)) lor quiet
else if fc="A" then
val←(val land (lnot credit)) lor asked
else begin say("πππ"&fc&"?"&↓); go to more end;
pn[fi]←val;
end "enter";
go to more
end "pn";
say("πππNo such guy"&↓);
end "search";
writearr(keyfile,pn[1],ptop);
END "FIXPASS";
PROCEDURE NEWPRICE; BEGIN ! change VM prices;
integer ni;
say(<"BAR PRICE (""-"" for beer bar)"&↓>); ! first, print the old prices;
for ni←0 thru 9 do say(<cvs(ni)&right(5,cents(door[ni]))&↓>);
while ln(s←ask("*")) do if 0≤(ni←LOP(s)-"0")≤9 then begin "examine"
if ln(s) then begin
if s≠" " then begin say("?"&↓); continue end;
flush(s); neg←0; door[ni]←scent;
end
else say(<right(6,cents(door[ni]))&↓>);
end
else say("?"&↓);
writearr(doorfile,door[0],10);
END "NEWPRICE";
PROCEDURE SAVIT; BEGIN ! update charge file;
integer bn,si,vi; ! block #, word #, #;
boolean coffee; ! TRUE if asked about coffee;
proc new_month; begin
integer ni,nj;
bn←1; si←0;
say("New month."&↓); coffee←true; ! clear "asked" field;
for ni←1 thru ptop do if ((nj←pn[ni]) land credit)=asked then
pn[ni]←nj land (lnot credit);
end;
proc saver(integer who,mult); begin
integer ai,aj;
for ai←1 thru ci do begin
tot←tot+(aj←charge[ai]*mult);
record[si+1]←who lor day;
record[si←si+2]←codit[ai]lor(aj land '777777);
end;
end;
coffee←false;
lookup(ouch,mon&billfile,flag);
if flag then new_month else begin "gotit"
integer array data[0:5];
integer fi;
fileinfo(data);
fi←(data[2] land '7777)lor((data[1] land '700000)lsh -3); ! date;
if (date%31 - fi%31)>6 then new_month else begin "read file"
si ← -(data[3] rot 18); bn ← si%128 + 1;
if si←si mod 128 then begin
useti(ouch,bn); arryin(ouch,record[1],si)
end;
end "read file";
end "gotit";
case luck of begin "luck"
begin "lose"
saver(id,2); saver(cvsix("F"),-1); tot←2*tot;
end;
begin "win" saver(cvsix("F"),1); free←tot; tot←0; end;
saver(id,1); ! normal;
begin "lucky" ! lucky;
integer li,lj;
for li←1 thru ci do begin
if (lj←charge[li])>0 then begin
record[si+1]←cvsix("sys") lor day;
free←free+lj;
end
else begin
record[si+1]←id lor day;
tot←tot+lj;
end;
record[si←si+2]←codit[li] lor(lj land '777777);
end;
end "lucky"
end "luck";
if ((vi←pn[pni]) land credit)=0 then begin "coffee"
string ans;
pn[pni]←vi lor asked; coffee←true;
if (ans←ask(
"πππCOFFEE POOL COSTS $3.00/MONTH. TYPE ""Y"" TO JOIN: "))="Y"
then begin
record[si+1]←id lor day;
record[si←si+2]←cvsix("C") lor 300;
tot←tot+300;
end
else if equ(ans,"NO, NO, 1000*NO") then begin "quiet"
pn[pni]←vi lor quiet;
say("SPOIL SPORT!"&↓);
end;
end "coffee";
enter(ouch,mon&billfile,flag);
if flag then begin notice("Cannot write "&mon&billfile); barf(""); end;
useto(ouch,bn);
arryout(ouch,record[1],si);
close(ouch);
if coffee then writearr(keyfile,pn[1],ptop);
END "SAVIT";
PROC VENDOUT; BEGIN ! OPEN VM DOORS;
integer vi,vd;
vi←((vd←lop(vmq)) lsh 4) xor '370;
start_code calli '400005; vmicono @vi; calli '400006 end;
if ln(vmq) then ask(cents(door[vd])&" door open. Hit return for next one");
END;
PROCEDURE TOTAL; BEGIN
DEFINE CODES=["BCDMSVXRP"];
INTEGER ARRAY SUBTOT,GROSS[1:LN(CODES)];
integer w1,w2,cod,val,dayn,ti;
BOOLEAN itemize;
string ts,mont;
proc decode; begin ! decode accounting data;
cod←(w2 lsh-30)+'40; ! ASCII code;
! integer value (+-);
if (val←w2 land '777777)land '400000 then val←val lor lh;
for ti←1 thru ln(codes) do if cod=codes[ti for 1] then return;
release(inch);
notice("Garbage in the accounting files");
barf(cod&"?");
end "DECODE";
itemize←(ti←lop(tiq))land '40; ! itemize≠0 means itemize;
open(inch←getchan,"dsk",'10,4,0,400,brk,eof);
lookup(inch,(mont←month[ti land '37])&billfile,flag);
if flag then begin say(↓&"No data for "&mont&↓); return end;
if itemize then begin dayn←0; say(↓&"DATE CHARGES FOR "&mont); end;
while w1←wordin(inch) do begin "SUM" ! PN,,day;
w2←wordin(inch); ! code,,value;
if (lh land w1)=ID then begin "his own"
decode; subtot[ti]←subtot[ti]+val;
if itemize then begin
if (ti←w1 land '777777)≠dayn then
say(<↓&right(2,cvs(dayn←ti))>);
say(" "&cod&cvs(val));
end;
end "his own"
else if ¬peon then begin "master"
decode; gross[ti]←gross[ti]+val;
end;
end "SUM";
release(inch);
val←0; ts←null;
for ti←1 thru ln(codes) do if w1←subtot[ti] then begin "subtotals"
if (w2←codes[ti for 1])="C" ∧ w1>300 then w1←300; ! coffee≤$3;
val←val+w1;
ts←ts&" "&w2¢s(w1);
end;
say(↓&"Total for "&mont&": $"¢s(val)&" = "&ts&↓);
if ¬peon then begin
val←0; ts←null;
for ti←1 thru ln(codes) do if w1←subtot[ti]+gross[ti] then
begin "subtotals"
val←val+w1;
ts←ts&" "&codes[ti for 1]¢s(w1);
end;
say("Gross for "&mont&": $"¢s(val)&" = "&ts&↓);
end;
END "TOTAL";
PROCEDURE GRIPE; BEGIN ! send a gripe;
string gs,gc;
gc←"∂"&datime&" "&pns&↓;
say(<"
PLEASE ENTER YOUR REMARKS, FOLLOWED BY A LINE CONTAINING JUST "".""" &↓>);
while ¬equ(gs←inline,".") ∧ ¬ttyeof do gc←gc&" "&gs&↓;
if ¬mail(gripefile,gc&↓) then notice("Gripe file cannot be written");
end "GRIPE";
STRING PROC MESS; BEGIN ! final message;
string proc pool; return(if tot then ↓&"$"&
cents(tot)&" charged" else null);
return((case luck of ("Lose: the total is $"¢s(tot),
"πππ"&friend[pni]&" won $"¢s(free)&pool,
"$"¢s(tot)&" for "&friend[pni],
"πππππππCongratulations, "&friend[pni]&", you are a lucky winner!
$"¢s(free)&" free "&pool&"πππππππ"))&" on "&datime&↓)
end "MESS";
! DO IT;
boolean newpassp,gripep,newpricep;
integer mc,key,ticks;
label found;
START:
VMQ←TIQ←NULL; ! clear for new entry;
CI←NEWPASSP←gripep←NEWPRICEP←tot←seen←free←0;
do begin "read"
flush(<S←ask(↓&"EAT! ")>); ! get PN & command;
if ttyeof then close(tty); ! fix end-of-file;
end
until ln(s);
time←(ticks←call(0,"timer"))%3600; ! time since midnight in mins.;
luck←if ticks land '177 then 2 else 3; ! "normal" or "lucky";
day←(date←call(0,"date"))mod 31 +1; ! date in system format;
mon←month[(date div 31)mod 12 +1];
datime←cvs(date%(31*12)+1964)&" "&mon&" "&cvs(day)&", "&
cvs(time%60)&":"&dec2(time mod 60);
if peon←((id←cvsix(pns←scalet(s)))≠cvsix("SYS") ∧ id≠cvsix("F"))
then begin "search"
for pni←1 thru ptop do if id=(lh land (key←pn[pni])) then
go to found;
barf("Sorry, I don't know you");
end "search";
FOUND:
flush(s); so←s;
while mc←lop(s) do begin "decode"
if mc="P" then newpassp←true
else if mc="T" then tiq←tiq&tote
else if mc="I" then tiq←tiq&(tote lor '40)
else if peon then if mc="G" then gripep←true
else if mc="F" then luck←ticks land 1
else begin "peon"
if mc≠"-" then neg←false else begin
neg←true; flush(s); mc←lop(s);
end;
if mc="B" then poot("B",15) else
if mc="C" then poot("C",10) else
if mc="D" then poot("D",20) else
if mc="V" then vendi else
if mc="S" then check("S",5) else
if mc="M" then check("M",1) else error;
end "peon"
else if mc="V" then newpricep←true else error;
flush(s);
end "decode";
if peon then begin "peon"
integer hk;
if luck≤1 then case seen of begin
;
barf("Sorry, I don't flip for negative amounts.");
barf("Sorry, I don't flip for cash")
end;
if ¬(hk←key land keymask) then say("PASSWORD="&↓) else
while hash(mc←slurp("PASSWORD="))≠hk do nix(mc);
if newpassp ∧ (mc←slurp("NEW PASSWORD"))≠-1 then begin "new pass"
pn[pni]←(pn[pni] land(lnot keymask)) lor hash(mc);
writearr(keyfile,pn[1],ptop); ! write out password file;
end;
if ci then savit; ! write billing file;
if phantom then while ln(vmq) do vendout; ! activate VM;
if ci then say(mess); ! type final message;
if (key land credit)=dun then
say(<"Your bill is badly overdue - please pay"&↓>);
end "peon"
else if newpassp ∨ newpricep then begin
while ¬master(mc←slurp("PASSWORD=")) do NIX(MC);
if newpassp then fixpass; ! fix priveleges;
if newpricep then newprice;
end;
while ln(tiq) do total; ! show itemization or totals for month;
if gripep then gripe;
end "main"
end "PONY"