0 GOTO5000
390 E$="ROOM SERCH"
391 QF=0
392 IFVAL(QB$(QF))<>PRTHENQF=QF+1:IFQF<=QBTHENGOTO392:ELSEGOTO394
393 A$=QB$(QF):GOTO5212
394 OPEN"QROOM"FORINPUTAS1
395 IFEOF(1)THENCLOSE:PINT'FORCED ERROR
396 INPUT#1,A$:IFVAL(A$)<>PRTHENGOTO395
397 CLOSE:GOTO5212
400 E$="!SAY"
401 IF(INSTR(CM$,GV$(2))<1ANDGV$(2)>"")ORMID$(RA$,VAL(GV$(1))+1,1)="1"THENGOTO5390
402 A$=GV$(3):FORI=1TOLEN(A$):B$=MID$(A$,I,1):IFB$="*"THENPRINT:ELSEPRINTB$;
403 NEXT:PRINT:GOSUB1000
404 GOTO5390
410 E$="!DJUMP"
411 IFGV=2ANDVAL(GV$(2))>1THENRP=VAL(GV$(2))
415 PR=VAL(GV$(1)):GOTO5200
420 E$="GETABLE ROOM JUMP"
421 RP=PR:PR=VAL(GV$(2))
422 GOTO5200
430 E$="POTION"
431 A=PH:B=PG:C=VAL(GV$(2)):D=VAL(GV$(3)):PH=PH+C:PG=PG+D
432 PRINT"HEALTH-";A;" TO ";PH
433 PRINT"ABILITY-";B;" TO ";PG
435 IFVAL(GV$(2))<0THENBEEP:PRINT"POISON!"
436 IFVAL(GV$(3))<0THENBEEP:PRINT"YOUR ABILITY IS LESSENED"
437 FORI=UFTOPS:PS$(I)=PS$(I+1):NEXT:PS=PS-1
439 GOSUB1000:GOTO5300
440 E$="INFO GET"
441 PRINTGV$(2);:INPUTFO$(VAL(GV$(1))):GOTO5390
445 E$="INFO OUT"
446 PRINTGV$(2);" ";FO$(VAL(GV$(1))):GOTO5390
450 E$="INV.ACCESS"
451 T=VAL(GV$(1))+1
452 IFGV=2ANDGV$(2)>""THENT$=STR$(VAL(GV$(2))):T$=RIGHT$(T$,LEN(T$)-1):GOTO454
453 IFMID$(RA$,T,1)="0"THENT$="1":ELSET$="0"
454 RA$=LEFT$(RA$,T-1)+T$+RIGHT$(RA$,LEN(RA$)-T):GOTO5390
455 E$="RND ROOM JUMP"
456 IFMID$(RA$,VAL(GV$(1))+1,1)="1"ORRND(3)*100>VAL(GV$(3))THENGOTO5390
457 IFGV=4ANDVAL(GV$(4))>0THENRP=VAL(GV$(4))
458 PR=VAL(GV$(2))
459 GOTO5200
460 E$="INFO JUMP"
461 IFFO$(2)<>GV$(2)THENGOTO5390
462 PR=VAL(GV$(1))
463 IFGV=3ANDVAL(GV$(3))>0THENRP=VAL(GV$(3))
464 GOTO5200
465 E$="INFO SAY"
466 IFINSTR(GV$(1),FO$(2))THENPRINTGV$(2)
467 GOTO5390
470 E$="INFO PUT"
471 FO$(VAL(GV$(1)))=GV$(2)
472 GOTO5390
480 E$="END"
481 CLS:PRINT@125,"FAREWELL NOBEL ADVENTURER!!!!!!":FORI=155TO125STEP-1:SOUND1000+RND(3)*3000,5:PRINT@I," ";:NEXT:MENU
490 E$="RETURN"
491 PR=RP:GOTO5200
495 E$="INFO COPY"
496 T=VAL(GV$(1))
497 IFT>=0THEN FO$(VAL(GV$(2)))=FO$(T):GOTO5390
498 T=-T:T$=MID$(RA$,T+1,1)
499 FO$(VAL(GV$(2)))=T$:GOTO5390
500 E$="ACTOR"
501 IFMID$(RA$,VAL(GV$(1))+1,1)="1"THENGOTO5390
505 IFMF=0THENFORI=0TOGV:M$(I)=GV$(I):NEXT:MF=RI
510 T=INT(10*RND(3)*VAL(M$(3))/PG)
515 PH=PH-T:IFT>0THENPRINT"YOU ARE HURT";T;"POINTS>HEALTH=";PH
516 IFPH<0THENPRINT"YOUR DEAD!":END
517 M$(2)=STR$(VAL(M$(2))-10*RND(3)):IFVAL(M$(2))<1THENGOTO640
520 GOTO5250
600 E$="OBJECT"
610 IFMF=0THENPRINT"WOOSH!!!":GOSUB1000:GOTO5300
615 IF(M$(4)>""ORGV$(4)>"")ANDGV$(4)<>M$(4)THENPRINT"IT DID'ENT WORK!":GOSUB1000:GOTO5300
620 A=VAL(GV$(2)):B=VAL(GV$(3)):C=VAL(M$(2))
625 E=INT(A*RND(3)-RND(3)*(B-PG))
626 IFE<0THENPRINT"OUCH! YOU HURT YOURSELF ";E;" POINTS":PH=PH+E:GOTO5300
628 C=INT(C-E):M$(2)=STR$(C)
630 IFC>0THENPRINT"YOU DID";E;"POINTS DAMAGE":PRINTC;"POINTS LEFT TO DO!":GOSUB1000:GOTO5300
640 FORI=MFTORS-1:RS$(I)=RS$(I+1):NEXT:RS=RS-1:MF=0:PRINT"DONE!!!":SOUND3000,5
644 A=VAL(M$(1))+1:IFA=1THENGOTO5391
645 RA$=LEFT$(RA$,A-1)+"1"+RIGHT$(RA$,LEN(RA$)-A)
650 F=0:GOTO5391
900 REM ERROR TRAP
901 BEEP:PRINTE$;" ERROR":PRINT"TO ROOM ";PR;"  FROM ROOM ";RP
902 IFMO=1ANDPR=1ANDRP=1THENCM$="EDIT1":RESUME4000
903 IFMO=1THENRESUME5199
904 END
1000 FORII=0TO300:NEXT:RETURN
1001 RETURN
1002 KY$=INKEY$:IFKY$=""THENGOTO1002
1003 RETURN
1005 FORII=ITOQB-1:QB$(II)=QB$(II+1):NEXT:BEEP:BEEP:RETURN
1010 A$=CM$:CM$=""
1011 I=LEN(A$)
1012 IFMID$(A$,I,1)<>" "THENCM$=MID$(A$,I,1)+CM$:I=I-1:IFI>0THENGOTO1012
1013 RETURN
3000 E$=">GET"
3010 GOSUB1010
3020 I=0
3021 IFINSTR(RS$(I),CM$)=0THENI=I+1:IFI<=RSTHEN3021:ELSEPRINT"CANT FIND WHAT YOU WANT.":GOSUB1000:GOTO5300
3022 IFPS>19THENPRINT"YOU CANT CARRY ANY MORE!":GOSUB1000:GOTO5300
3023 IFRF=0THENPRINT"YOU FUMBLED":GOTO5300
3025 RI=I:F=1:GOTO5350
3030 T$=STR$(VAL(GV$(0))):T=INSTR(GG$,RIGHT$(T$,LEN(T$)-1))
3031 IFT=0THENPRINT"YOU CANT GET THAT!":GOSUB1000:GOTO5300:ELSEIFMID$(RA$,VAL(GV$(1))+1,1)="1"THENPRINT"NOT HERE!":GOSUB1000:GOTO5300
3035 PS$(PS)=RS$(I):PS=PS+1
3036 IFMF>ITHENMF=MF-1
3040 FORII=ITORS-1
3041 RS$(II)=RS$(II+1):NEXT:RS=RS-1
3042 T=VAL(GV$(1))+1:IFT>1THENRA$=LEFT$(RA$,T-1)+"1"+RIGHT$(RA$,LEN(RA$)-T)
3045 PRINT"GOT THE ";CM$:GOSUB1000:GOTO5300
3100 E$="USE"
3110 GOSUB1010
3120 I=0
3121 IFINSTR(PS$(I),CM$)=0THENI=I+1:IFI<=PSTHENGOTO3121:ELSEPRINT"BUT YOU DONT HAVE THAT!":GOSUB1000:GOTO5300
3122 UF=I:GV=1:A$=PS$(I):A=INSTR(A$,".")
3125 F=2:GOTO5361
3200 E$="DROP"
3201 IFPS=0THENGOTO5300:ELSEF=1
3203 FORI=0TOPS-1:A$=PS$(I):A=LEN(A$)-1:C$=""
3205 FORJ=ATO1STEP-1:B$=MID$(A$,J,1)
3210 IFB$="."THENPRINTRIGHT$(C$+"<>",F*(LEN(C$)+2));:J=0:ELSEC$=B$+C$
3212 IFJ=0ANDD$=C$ANDF=0THENRS=RS+1:RS$(RS)=PS$(I):FORK=ITOPS-1:PS$(K)=PS$(K+1):NEXT:I=K:PS=PS-1:PRINT"DROPED THE ";C$;
3215 NEXT:NEXT:PRINT
3220 IFF=0THENGOTO3200:ELSED$="":INPUT"DROP WHAT>";D$:IFD$=""THENGOTO5300
3221 F=0:GOTO3203
3300 E$="HELP"
3301 CLS:PRINT"At the COMAND> prompt you may":PRINT"'GET' an object in the room":PRINT"'Use' an object you have gotten"
3302 PRINT"or 'DROP' and object-in which case that object is lost"
3303 PRINT"'DROP' will show you what you have":PRINT"Often you will find out more about a    room if you type a lone '?'";
3310 GOSUB1002
3311 CLS:PRINT"'GET' and 'USE' format is":PRINT"'GET' OR 'USE' followed by a word that  you think will be recognized"
3312 PRINT"Some things dont have to be gotten      just 'door' if there is a door will let you through that door"
3313 PRINT"if there is an active charactor in the  area some options might be hidden";
3320 GOSUB1002
3326 CLS:PRINT@45,"'ME?' WILL GIVE PLAYER STAT":PRINT@130,"'SAVE GAME' WILL":PRINT@208,"GUESS IT?-SAVE THE GAME"
3330 GOSUB1002:GOTO5200
3400 E$="SAVE"
3401 KILL"QPLAY.DO"
3405 OPEN"QPLAY.DO"FOR OUTPUTAS1
3410 PRINT#1,PR:PRINT#1,RP:PRINT#1,PH:PRINT#1,PG:PRINT#1,PS:FORI=0TOPS-1:PRINT#1,PS$(I):NEXT
3415 PRINT#1,RA$:FORI=0TO10:PRINT#1,FO$(I):NEXT
3420 CLOSE
3421 IFMO=0THENGOTO3030
3422 KILL"QBUF.DO"
3423 OPEN"QBUF.DO"FOROUTPUTAS1
3424 PRINT#1,QM
3425 FORI=0TOQB:PRINT#1,QB$(I):NEXT
3426 CLOSE
3430 PRINT"GAME SAVED":PRINT"HIT 'C' TO CONTINUE"
3435 GOSUB1002
3440 IFKY$="C"THENGOTO5199
3445 MENU
3500 E$="MAKE OBJECT"
3505 A$="":INPUT"WARNING MAKE CAN BOMB PROGRAM           WILL PUT IN CURRENT ROOM  (NULL TO EXIT)MAKE>";A$
3510 IFA$=""THENGOTO5250
3520 RS=RS+1:RS$(RS)=A$:GOTO5250
4000 E$="EDIT"
4001 QI=0:A=VAL(MID$(CM$,5,20))
4002 IFVAL(QB$(QI))<>ATHENQI=QI+1:ELSEGOTO4020
4003 IFQI<=QBTHENGOTO4002
4004 BEEP:PRINT"ROOM NOT IN BUFFER"
4005 OPEN"QROOM"FORINPUTAS1
4006 IFEOF(1)THENCLOSE:GOTO4009
4007 INPUT#1,A$:IFVAL(A$)=ATHENPRINT"ROOM IN PERM MEMORY!":CLOSE:GOSUB1000:GOTO4009
4008 GOTO4006
4009 INPUT"ADD ROOM TO BUFFER?(Y)";A$:IFA$<>"Y"THENGOTO5300
4010 IFQB>=QMTHENPRINT"BUFFER FULL!":GOSUB1000:GOTO5300:ELSEQB=QB+1:QI=QB:QB$(QB)=RIGHT$(STR$(A),LEN(STR$(A))-1)
4020 A$=QB$(QI):T1=40:CLS:PRINT@240,"ARROW KEYS CONTROL CURSOR               'DEL' LETTER   'ESC' RETURNS TO PROGRAM";
4021 PRINT@40,A$;"  "
4022 T1$=MID$(A$,T1-39,1)
4025 T$="":T$=INKEY$:PRINT@T1,"*":GOSUB1001:PRINT@T1,T1$:GOSUB1001:IFT$=""THENGOTO4025
4026 IFASC(T$)=29ANDT1>40THENT1=T1-1:GOTO4021
4027 IFASC(T$)=28ANDT1<250ANDT1-39<=LEN(A$)THENT1=T1+1:GOTO4021
4028 IFASC(T$)=27THENGOTO4050
4029 IFASC(T$)=8THENGOTO4040
4030 IFASC(T$)=30THENIFT1>79THENT1=T1-40:GOTO4021:ELSEBEEP
4031 IFASC(T$)=31THENIFT1<LEN(A$)THENT1=T1+40:GOTO4021:ELSEBEEP
4035 IFASC(T$)<32ORASC(T$)>126THENBEEP:GOTO4025
4036 IFT1=40THENA$=T$+A$
4037 IFT1>40THENA$=MID$(A$,1,T1-40)+T$+MID$(A$,T1-39,250)
4038 T1=T1+1
4039 GOTO4021
4040 IFT1=40THENA$=MID$(A$,2,250)
4041 IFT1>40THENA$=MID$(A$,1,T1-40)+MID$(A$,T1-38,250)
4042 GOTO4021
4050 QB$(QI)=A$
4055 CLS:GOTO5200
4100 E$="LIST"
4101 CLS
4110 PF=0:PRINT:PRINT"LIST ALL TO PRINTER(Y)? ";:GOSUB1002:PRINTKY$:IFKY$="Y"THENPF=1
4112 IFPF<>1THENPRINT"TO SELECTIVLY PRINT TYPE 'P' AT LIST":PRINT"TO DELETE TYPE 'D' AT LIST"
4114 PRINT"<HIT KEY>":GOSUB1002:CLS
4115 CLS:PRINT"ROOMS IN BUFFER":FORI=0TOQB:PRINTVAL(QB$(I));"<>";:NEXT:PRINT
4116 LE=0:A$="":INPUT"LIST START/END/NULL TO EXIT ";A$,B$:IFA$=""THENGOTO5250:ELSE:LS=VAL(A$):IFB$=""THENLE=LS:ELSE:LE=VAL(B$):CLS
4117 IFPF=1THENPRINT"WORKING TO PRINT!!"
4120 FORI=0TOQB:T=VAL(QB$(I)):IFT>LEORT<LSTHENGOTO4130
4121 IFPF=1THENLPRINTQB$(I):GOTO4130
4122 PRINTQB$(I):PRINT"<HIT KEY>":GOSUB1002
4123 IFKY$="P"ANDPF<>2THENLPRINT"BUF>";QB$(I)
4124 IFKY$="D"THENPRINT"SURE YOU WANT TO DELETE(Y)?";:GOSUB1002:PRINTKY$:IFKY$="Y"THENGOSUB1005:I=I-1:QB=QB-1
4125 IFKY$="S"THENPRINT"SURE YOU WANT TO SAVE(Y)?";:GOSUB1002:PRINTKY$:IFKY$="Y"THENOPEN"QROOM"FORAPPENDAS1:PRINT#1,QB$(I):CLOSE:GOSUB1005:I=I-1:QB=QB-1
4130 NEXT
4140 IFPF<>1THENPRINT"FOLLOWING IN PERM FILE"
4141 IFPF=1THENLPRINT:LPRINT"FOLLOWING IN PERM MEMORY!":LPRINT
4145 OPEN"QROOM"FORINPUTAS1
4150 IFEOF(1)THENCLOSE:PRINT"<HIT KEY>":GOSUB1002:GOTO4115
4155 INPUT#1,A$
4156 IFVAL(A$)>LEORVAL(A$)<LSTHENGOTO4150
4160 IFPF=1THENLPRINTA$:GOTO4170
4165 PRINTA$:PRINT"<HIT KEY>":GOSUB1002:IFKY$="P"ANDPF<>2THENLPRINT"PERM>";A$
4170 GOTO4150
4200 E$="BUF SORT"
4201 PRINT"SORTING BUFFER"
4202 FORI=QBTO1STEP-1
4203 T=ABS(I):T1=0
4204 FORJ=0TOT
4205 IFVAL(QB$(J))>T1THENT1=VAL(QB$(J)):T2=J
4206 NEXT
4207 T$=QB$(I):QB$(I)=QB$(T2):QB$(T2)=T$
4208 NEXT
4210 BEEP:GOTO5250
4250 E$="COMMAND ROOM JUMP"
4251 INPUT"ROOM TO JUMP>";PR
4252 GOTO5200
4500 GOTO5300
5000 CLS:PRINT@55,"QUEST":PRINT@90,"COPYRIGHT 1987":PRINT@128,"BY BRUCE GREENBERG":PRINT@170,"CIS#76606,3613":GOSUB1001
5002 REM    BRUCE GREENBERG
5010 MAXFILES=1
5011 E$="CANT DIM":ONERRORGOTO900
5012 CLEAR(6000)
5013 DIMRS$(20),GV$(20),FO$(10):
5014 GG$=".3.4.6."'GG$ HAS GETABLE ROTINE#'S
5020 ONERRORGOTO5030
5025 RESTORE:READA$:MO=0:GOTO5100
5030 RESUME5031
5031 MO=1
5035 ONERRORGOTO5040
5036 OPEN"QROOM"FORINPUTAS1
5037 CLOSE:GOTO5050
5040 RESUME5041
5041 OPEN"QROOM"FOROUTPUTAS1:CLOSE
5050 ONERRORGOTO5060
5051 OPEN"QBUF"FORINPUTAS1
5052 INPUT#1,QM:E$="CANT DIM/FILL BUF":ONERRORGOTO900
5053 DIMQB$(QM):QB=0:QB$(0)=""
5054 IFEOF(1)THENCLOSE:QB=QB-1:GOTO5100
5055 INPUT#1,QB$(QB):QB=QB+1:GOTO5054
5060 RESTORE5061
5061 CLOSE:OPEN"QBUF"FOROUTPUTAS1
5062 BEEP:INPUT"MAX BUFFER SIZE";QM:
5063 PRINT#1,QM:CLOSE:RUN
5100 ONERRORGOTO5110
5101 OPEN"QPLAY"FORINPUTAS1:INPUT#1,PR:INPUT#1,RP:INPUT#1,PH:INPUT#1,PG:INPUT#1,PS:I=0
5102 IFI<PSTHENINPUT#1,PS$(I):I=I+1:GOTO5102
5103 INPUT#1,RA$:FORI=0TO10:INPUT#1,FO$(I):NEXT
5104 CLOSE:GOTO5120
5110 CLOSE:IFPR>0THENE$="TROUBLE LOADING":RESUME 900:ELSERESUME 5111
5111 ONERRORGOTO900:E$="CANT MAKE QPLAY FILE"
5112 OPEN"QPLAY"FOROUTPUTAS1
5113 PRINT#1,1:PRINT#1,1:PRINT#1,1000:PRINT#1,50:PRINT#1,0
5114 A$="":FORI=1TO200:A$=A$+"0":NEXT:PRINT#1,A$:FORI=0TO10:PRINT#1,"":NEXT
5115 CLOSE:GOTO5100
5120 ONERROR GOTO900
5121 GOTO5200
5199 INPUT"WHAT ROOM TO JUMP";PR
5200 E$="ROOM JUMP":IFMO=1THENGOTO5203
5201 RESTORE
5202 READA$:IFVAL(A$)<>PRTHENGOTO5202:ELSEGOTO5212
5203 GOTO390
5212 E$="ROOM STRING"
5213 RS=0:MF=0:B=1:RF=0
5215 A=INSTR(A$,"/")
5216 RS$(RS)=MID$(A$,1,A-1):A$=MID$(A$,A+1,250)
5217 IFLEN(A$)<=1THEN5220
5218 RS=RS+1:GOTO5215
5220 T$=MID$(RS$(0),LEN(STR$(PR)),250):IFT$=""THENCM$="":GOTO5300
5221 PRINTT$
5250 E$="COMAND"
5255 CM$="":INPUT"COMAND>";CM$
5260 IFINSTR(CM$,"GET")THENGOTO3000
5265 IFINSTR(CM$,"USE")THENGOTO3100
5270 IFINSTR(CM$,"DROP")THENGOTO3200
5275 IFINSTR(CM$,"HELP")THENGOTO3300
5280 IFINSTR(CM$,"SAVE GAME")THENGOTO3400
5285 IFINSTR(CMS$,"MAKE")THENGOTO3500
5290 IFLEFT$(CM$,4)="EDIT"ANDMOTHENGOTO4000
5291 IFCM$="LIST"ANDMOTHENGOTO4100
5292 IFCM$="ROOM?"THENPRINT"IN 'ROOM' ";PR:GOTO5250
5293 IFCM$="SORT!"THENGOTO4200
5294 IFCM$="ROOM!"THENGOTO4250
5295 IFCM$="ME?"THENPRINT"HEALTH IS>";PH:PRINT"SKILL IS>";PG:GOTO5250
5300 REM ME
5310 RI=1:F=0:RF=1
5315 E$="ROOM LOOP"
5316 IFLEFT$(RS$(RI),1)="!"THENGOTO5350
5320 IFINSTR(RS$(RI),CM$)=0ORCM$=""THENGOTO5390
5321 TT=INSTR(RS$(RI),"."):IFTT>0ANDTT<LEN(RS$(RI))THENRP=VAL(MID$(RS$(RI),TT+1,10))
5325 PR=VAL(RS$(RI))
5330 GOTO5200
5350 E$="SUB CODE"
5360 GV=1:A$=RS$(RI):A=INSTR(A$,"."):IFA=0THENIFF=1THENGOTO3030
5361 GV$(0)=MID$(A$,2,A-1)
5365 B=INSTR(MID$(A$,A+1,250),".")+A
5370 GV$(GV)=MID$(A$,A+1,B-A-1)
5375 IFB=LEN(A$)THENIFF=0ORF=2THENGOTO6000:ELSEIFF=1THENGOTO3030
5380 A=B:GV=GV+1
5385 GOTO5365
5390 RI=RI+1
5391 IFRI>RSTHENGOTO5250
5395 GOTO5315
6000 REMGOSUBS
6001 E$="SUB JUMP"
6002 SB=VAL(GV$(0))
6003 IFF=2THENGOTO6020
6010 T$=STR$(VAL(GV$(0))):IFINSTR(GG$,RIGHT$(T$,LEN(T$)-1))THENGOTO5390
6020 ON SB GOTO 400,410,420,430,500,600,440,445,450,460,465,470,480,490,495,455
6021 E$="UNDEFINED ROTINE":GOTO900