00001 dim C$*100,M$*80
00002 let OWNERS$="PER.STONEY,OWARE ENG.HART,Oware +,RW"
00003 def LEFT$(X$,I)=X$(1:I)
00005 declare all integer*2
00007 print "GOD  --  Galaxy Oriented Developer"
00010 print "(c)1987 Wizard Workshop and Company"
00011 print "(c)1987 Walter Stoneburner"
00015 let VER$="GOD v1.0"
00021 let RGEN_SL,RGEN_CV,USER_GOD=0
00030 who into C$
00035 let PIDNUM=val(C$(5:8))
00040 let C$=C$(9:len(C$))
00050 let USERNAME$=C$(1:pos(C$,":")-1)
00060 let M$=USERNAME$&" activating GOD"
00110 let CV$=":SDD:UDD:PER.STONEY:MPSTCV.DAT"
00112 let SL$=":SDD:UDD:PER.STONEY:MPSTSL.DAT"
00130 close
00140 enable handler SL_NOT_EXISTS, resume at 00130
00150 open #1:SL$ outin, direct, internal, shared,fixed 48
00160 map UN%*15;STAT%*10; integer*2 LAST,PID
00170 disable handler
00200 handler SL_NOT_EXISTS
00201   let RGEN_SL=-1
00210   create SL$ replace
00220   acl SL$,OWNERS$
00230   resume
00240 end handler
00250 enable handler NOT_IN_SL, resume at 00440
00300 let DRD=0
00310 let SHIP=0
00320 let SHIP=SHIP+1
00330 input #1 record SHIP data 00160
00340 if ltrm$(UN%)="" and DRD=0 then let DRD=SHIP
00341 if rtrm$(ltrm$(UN%))<>USERNAME$ then 00320
00342 if STAT%(2:2)="P" then
00343   enable handler JUST_RESUME, resume at 00350
00344   who PIDNUM into C$
00345   if pos(C$,":GALAXY.PR")>0 and pos(C$,USERNAME$)>0 then
00346     print "You can not be in space and enter the gates of heaven."
00347     goto 50020
00348   end if
00350   let PID=PIDNUM
00351   let STAT%(2:2)=" "
00352   output #1 record SHIP data 00160
00353   print "Your prayer has been answered by God.  You are not in space anymore."
00354 end if
00375 if STAT%(1:1)<>"%" then
00376   print "You are not GOD."
00377   goto 50000
00378 end if
00381 let STAT%(2:2)="g"
00382 output #1 record SHIP data 00160
00390 goto 00500
00400 handler NOT_IN_SL
00410   if DRD=0 then let DRD=SHIP
00420   resume
00430 end handler
00440 let UN%=USERNAME$
00441 let USER_GOD=-1
00442 if RGEN_SL<>-1 then
00443   print "How can you call on God if you've never played before?"
00444   goto 50020
00445 end if
00450 let STAT%="% "
00460 let SHIP=DRD
00470 output #1 record SHIP data 00160
00500 rem
00510 enable handler CV_NOT_EXISTS, resume at 00510
00520 open #3:CV$ outin, direct, internal, shared,fixed 100
00525 map ACTION%*80; integer LINK,TO,FROM,TYPE
00540 enable handler JUST_RESUME, resume at 00610
00550 let I=1
00560 input #3 record I data 00525
00570 if LINK>0 then
00580   let I=LINK
00590   goto 00560
00600 end if
00610 input #1 record SHIP data 00160
00620 let LAST=I
00625 let STAT%(2:2)="g"
00630 output #1 record SHIP data 00160
00840 disable handler
00850 handler CV_NOT_EXISTS
00860   create CV$ replace
00870   acl CV$,OWNERS$
00875   let RGEN_CV=-1
00880   resume
00890 end handler
00891 if RGEN_SL+RGEN_CV+USER_GOD<0 then
00892   if RGEN_SL<0 then print "%GOD-I-NSFC, New Ship File Created"
00893   if RGEN_CV<0 then print "%GOD-I-NCFC, New Conversation File Created"
00894   if USER_GOD<0 then print "%GOD-I-YANG, You Are Now God"
00895   linput noecho, bytes 1, prompt "== Press A Key":C$
00896   let RGEN_SL,RGEN_CV,USER_GOD=0
00897 end if
00899 goto 00980
00900 print chr$(12);VER$;tab(15);M$;tab(60);date$;" ";time$
00910 print
00920 let M$=""
00930 return
00945
00980 gosub 00900
01000 characteristics "ON","FKT"
01001 let PA$,AR$=""
01050 linput prompt "GOD> ":C$
01051 input #1 record SHIP data 00160
01052 let PID=PIDNUM
01053 let STAT%(1:2)="%g"
01060 let UC$=ltrm$(rtrm$(uprc$(C$)))
01100 if fkey<>0 then
01110   print chr$(25);" "
01120   if fkey=42 and UC$="" then 50000
01130   if fkey=34 then
01131     print "Line ignored."
01132     goto 01000
01133   end if
01150 end if
02000 if UC$="" then 01000
02010 let P=pos(UC$,"/")
02020 if P>0 then let PA$=ltrm$(rtrm$(UC$(P:len(UC$))))
02030 if P>0 then
02040   let PA$=ltrm$(rtrm$(UC$(P:len(UC$))))
02050   let UC$=ltrm$(rtrm$(UC$(1:P-1)))
02060 end if
02070 let P=pos(UC$," ")
02080 if P>0 then
02090   let AR$=ltrm$(rtrm$(UC$(P:len(UC$))))
02095   let UC$=ltrm$(rtrm$(UC$(1:P)))
02098 end if
03000 if len(UC$)>2 and LEFT$("EXPELL",len(UC$))=UC$ and len(UC$)<7 then 07000
03005 if len(UC$)>0 and LEFT$("TELL",len(UC$))=UC$ and len(UC$)<5 then 08200
03010 if len(UC$)>1 and LEFT$("SUSPEND",len(UC$))=UC$ and len(UC$)<8 then 07000
03020 if len(UC$)>0 and LEFT$("RESTORE",len(UC$))=UC$ and len(UC$)<8 then 07000
03030 if len(UC$)>1 and LEFT$("IMMORTALIZE",len(UC$))=UC$ and len(UC$)<12 then 08300
03040 if len(UC$)>0 and LEFT$("MORTALIZE",len(UC$))=UC$ and len(UC$)<10 then 08300
03060 if len(UC$)>2 and LEFT$("EXAMINE",len(UC$))=UC$ and len(UC$)<8 then 09000
03070 if len(UC$)>1 and LEFT$("BIGBANG",len(UC$))=UC$ and len(UC$)<8 then 09200
03082 if len(UC$)>1 and LEFT$("*SWAP",len(UC$))=UC$ and len(UC$)<6 then 09300
03084 if len(UC$)>2 and LEFT$("*CLI",len(UC$))=UC$ and len(UC$)<5 then 09300
03086 if len(UC$)>2 and LEFT$("*CHAIN",len(UC$))=UC$ and len(UC$)<7 then 09300
03990 if len(UC$)>1 and LEFT$("INFORMATION",len(UC$))=UC$ and len(UC$)<12 then 06200
03991 if len(UC$)>0 and LEFT$("GALAXY",len(UC$))=UC$ and len(UC$)<7 then 05020
03992 if len(UC$)>1 and LEFT$("PLAY",len(UC$))=UC$ and len(UC$)<5 then 05020
04000 if len(UC$)>1 and LEFT$("END",len(UC$))=UC$ and len(UC$)<4 then 50000
04001 if len(UC$)>2 and LEFT$("EXIT",len(UC$))=UC$ and len(UC$)<5 then 50000
04010 if len(UC$)>0 and LEFT$("QUIT",len(UC$))=UC$ and len(UC$)<5 then 50000
04020 if len(UC$)>1 and LEFT$("BYE",len(UC$))=UC$ and len(UC$)<4 then 50000
04030 if len(UC$)>1 and LEFT$("STOP",len(UC$))=UC$ and len(UC$)<5 then 50000
04050 if len(UC$)>0 and LEFT$("HELP",len(UC$))=UC$ and len(UC$)<5 then 06000
04055 if UC$="?" then 06000
04060 if len(UC$)>0 and LEFT$("ASSIST",len(UC$))=UC$ and len(UC$)<7 then 06000
04070 if UC$="CLS" or term$=chr$(12) then 00980
04100 if len(UC$)>1 and LEFT$("SMAIL",len(UC$))=UC$ then
04102   swap ":SDD:UDD:PER.STONEY:SMAIL.PR"
04105   let M$="Return from SMAIL"
04107   gosub 00900
04108   goto 01000
04109 end if
04110 if len(UC$)>1 and LEFT$("PED",len(UC$))=UC$ and len(UC$)<4 then
04111   print "PED Monitor --  Press E to Exit"
04112   cli "PED"
04113   let M$="Return from PED Monitor"
04114   gosub 00900
04115   goto 01000
04116 end if
04120 if len(UC$)>1 and LEFT$("CEO",len(UC$))=UC$ and len(UC$)<4 then
04121   cli "CEO"
04122   let M$="Return from CEO"
04123   gosub 00900
04124   goto 01000
04125 end if
04200 if UC$="CLI" then
04210   if AR$="" and PA$="" then
04215     print "Type BYE to return to GOD."
04220     cli
04222     let M$="Returning from CLI"
04225     goto 00980
04230   else
04231     cli AR$&PA$
04232     goto 01000
04235   end if
04236 end if
04250 if len(UC$)>1 and LEFT$("DELETE",len(UC$))=UC$ and len(UC$)<7 then
04251   cli "DEL "&AR$&PA$
04253   goto 01000
04254 end if
04260 if len(UC$)>1 and LEFT$("FILESTATUS",len(UC$))=UC$ and len(UC$)<11 then
04262   if AR$="" and PA$="" then let AR$="+"
04263   filestatus AR$&PA$
04266   goto 01000
04268 end if
04270 if len(UC$)>1 and LEFT$("FASS",len(UC$))=UC$ and len(UC$)<5 then
04271   cli "FASS "&AR$&PA$
04272   goto 01000
04273 end if
04280 if len(UC$)>1 and LEFT$("DIRECTORY",len(UC$))=UC$ and len(UC$)<10 then
04281   if pos(PA$,"/D") then directory i
04282   if pos(PA$,"/I") then directory ":SDD:UDD:"&USERNAME$
04283   if pos(PA$,"/G") then directory ":SDD:UDD:PER.STONEY"
04284   if AR$<>"" then directory AR$
04285   directory
04286   goto 01000
04287 end if
04290 if len(UC$)>1 and LEFT$("SED",len(UC$))=UC$ and len(UC$)<4 then
04291   cli "X SED "&AR$&PA$
04292   let M$="Returning From SED Editor"
04293   goto 00980
04294 end if
05000 print "Unknown command."
05010 print
05015 goto 01000
05020 let M$="Returning From GALAXY"
05021 print "Welcome to GALAXY, God..."
05022 input #1 record SHIP data 00160
05024 let STAT%(2:2)="G"
05025 output #1 record SHIP data 00160
05030 swap ":SDD:UDD:PER.STONEY:GALAXY.PR"
05032 input #1 record SHIP data 00160
05035 let STAT%(2:2)="g"
05037 output #1 record SHIP data 00160
05040 goto 00980
06000 let M$="HELP LISTING"
06010 gosub 00900
06020 print "BYE, EXIT, QUIT, STOP    -- Leave GOD"
06030 print "HELP, ASSIST, ?          -- This List"
06040 print "SMAIL, PED, CEO, SED     -- Other Applications"
06050 print "INFORMATION              -- Galaxy Configuration Files"
06060 print "TELL {username} [/All]   -- Send Messages To Users"
06070 print "RESTORE/SUSPEND/EXPELL   -- Set A User's Game Status"
06080 print "PLAY/GALAXY              -- Play Galaxy as GOD"
06090 print "EXAMINE {username}       -- Display User Information"
06092 print "IMMORTALIZE/MORTALIZE    -- Change User's God Status"
06093 print "BIGBANG                  -- Recreate everything"
06100 goto 01000
06200 let M$="Information Display"
06210 gosub 00900
06220 print "Ship Log File    --  ";SL$
06222 acl SL$ into C$
06223 if uprc$(OWNERS$)<>C$(1:len(OWNERS$)) then print "ACL Protections Do Not Match:  ";C$
06230 print "Converstion File --  ";CV$
06232 acl CV$ into C$
06233 if uprc$(OWNERS$)<>C$(1:len(OWNERS$)) then print "ACL Protections Do Not Match:  ";C$
06250 print "Data Files Permitted to: ";OWNERS$
06255 print
06260 print "GOD Granted:"
06261 acl v ":SDD:UDD:PER.STONEY:GOD+"
06265 print "GALAXY Granted:"
06267 acl v ":SDD:UDD:PER.STONEY:GALAXY+"
06490 print
06500 goto 01000
06510 enable handler JUST_RESUME, resume at 06570
06520 let USER=0
06530 let USER=USER+1
06540 input #1 record USER data 00160
06550 if ltrm$(rtrm$(UN%))=AR$ then return
06560 goto 06530
06562 handler JUST_RESUME
06564   resume
06566 end handler
06570 let USER=0
06580 return
07000 if AR$<>"" then 07009
07001 linput prompt "Which User: ":AR$
07002 let AR$=ltrm$(rtrm$(uprc$(AR$)))
07003 if AR$="" then 01000
07009 gosub 06510
07010 if USER=0 then
07012   print "User Not Found."
07014   goto 01000
07016 end if
07020 input #1 record USER data 00160
07030 if UC$(1:1)="E" then let STAT%(1:2)="X "
07040 if UC$(1:1)="S" then let STAT%(1:2)="@ "
07050 if UC$(1:1)="R" then let STAT%(2:2)="  "
07060 print "User ";rtrm$(UN%);" ";
07070 let C$="SuspendedRestored  Expelled"
07080 print C$(pos(C$,UC$(1:1)):pos(C$,UC$(1:1))+8)
07085 output #1 record USER data 00160
07090 goto 01000
07900 let NEWLAST=0
07920 goto 08090
08000 input #1 record SHIP data 00160
08005 enable handler JUST_RESUME, resume at 07900
08010 let NEWLAST=LAST
08011 if NEWLAST=0 then let NEWLAST=1
08020 input #3 record NEWLAST data 00525
08030 if LINK>0 then
08040   let NEWLAST=LINK
08050   goto 08020
08060 end if
08076 let LAST=NEWLAST+1
08080 if LAST>100 then let LAST=1
08090 let LINK=LAST
08091 disable handler
08093 if NEWLAST=0 then 08110
08100 output #3 record NEWLAST data 00525
08110 let LINK=0
08120 let FROM=SHIP
08130 let TYPE=XTYPE
08140 let TO=XTO
08150 let ACTION%=XACTION$
08160 output #3 record LAST data 00525
08170 output #1 record SHIP data 00160
08180 return
08200 if pos(PA$,"/A")>0 or AR$<>"" then 08220
08210 linput prompt "Tell Which User: ":AR$
08212 let AR$=ltrm$(rtrm$(uprc$(AR$)))
08215 if AR$="" then 01000
08220 gosub 06510
08225 if pos(PA$,"/A")=0 and USER=0 then
08226   print "User not found."
08227   goto 01000
08228 end if
08230 print "-----------------Enter Messages----Send A Blank Line To End------------"
08240 linput prompt ">":XACTION$
08241 if ltrm$(rtrm$(XACTION$))="" then 01000
08250 let XTO=USER
08255 let XTYPE=1
08260 gosub 08000
08270 goto 08240
08300 if AR$<>"" then 08320
08310 linput prompt "Which User: ":AR$
08312 let AR$=ltrm$(rtrm$(uprc$(AR$)))
08314 if AR$="" then 01000
08320 gosub 06510
08330 if USER=0 then
08340   print "User not found."
08345   goto 01000
08347 end if
08350 input #1 record USER data 00160
08355 if UC$(1:1)="I" then let STAT%(1:1)="%"
08356 if UC$(1:1)="M" then let STAT%(1:1)=" "
08360 output #1 record USER data 00160
08365 print rtrm$(UN%);" ";
08370 if UC$(1:1)="I" then print "is immortalized." else print "is a piddling mortal."
08380 goto 01000
09000 if AR$<>"" then 09020
09010 linput prompt "Examine whom: ":AR$
09011 let AR$=ltrm$(rtrm$(uprc$(AR$)))
09012 if AR$="" then 01000
09020 gosub 06510
09030 if USER=0 then
09032   print "User specified wasn't found."
09034   goto 01000
09040 end if
09050 input #1 record USER data 00160
09060 let M$=UN%&" User: "&str$(USER)
09070 gosub 00900
09075 print "Username:  ";UN%
09080 print "Status:    ";
09082 if STAT%(1:1)=" " then print "Normal Player  ";
09083 if STAT%(1:1)="@" then print "Suspended      ";
09085 if STAT%(1:1)="X" then print "Expelled       ";
09090 if STAT%(1:1)="%" then print "Immortal       ";
09100 if STAT%(2:2)="g" then print "IN HEAVEN    ";
09102 if STAT%(2:2)="G" then print "PLAYING GOD  ";
09104 if STAT%(2:2)="P" then print "In Galaxy    ";
09106 if STAT%(2:2)=" " then print "Not Playing  ";
09110 print
09120 print
09130 print "Record Count:  ";LAST
09140 print
09150 goto 01000
09200 linput noecho, bytes 1, prompt "Prompt a Big-Bang...?!?  Are you sure? (Y/N)":C$
09210 if C$(1:1)<>"Y" and C$(1:1)<>"y" then
09220   print "No."
09230   goto 01000
09240 end if
09250 print "YES!"
09260 enable handler JUST_RESUME, resume at 09270
09265 print "....and suddenly there was darkness and void as the universe"
09266 print "collapsed in on itself.  Not a thing remained."
09268 close
09269 delete CV$
09270 enable handler JUST_RESUME, resume at 09280
09275 delete SL$
09280 disable handler
09285 print "Let there be light...";
09290 let M$="And it was good."
09295 goto 00130
09300 if AR$<>"" then 09320
09301 linput prompt "USER: ":AR$
09302 let AR$=ltrm$(rtrm$(uprc$(AR$)))
09303 if AR$="" then 01000
09320 gosub 06510
09330 if USER=0 then
09340   print "User not found."
09350   goto 01000
09360 end if
09370 linput prompt "]":XACTION$
09380 if ltrm$(rtrm$(XACTION$))="" then 01000
09400 let XTYPE=0
09401 if UC$(1:2)="*S" then let XTYPE=2
09402 if UC$(1:3)="*CH" then let XTYPE=3
09403 if UC$(1:3)="*CL" then let XTYPE=4
09410 let XTO=USER
09415 gosub 08000
09417 print "Done."
09420 goto 01000
50000 let STAT%(2:2)=" "
50010 output #1 record SHIP data 00160
50020 close
50030 linput noecho, bytes 1, prompt "Press any key...":C$
50040 print chr$(13);chr$(11);
90000 end