PIRATE.bas


Title: PIRATE
Description: The Pirate Interpreter: Run ALL the Scott Adams and Brian Howarth Adventures! RELIVE the Golden AGE of 8-BIT Adventuring. All info is in the comments. MUST HAVE SmallBASIC GAME #3.

Category: Games
Copyright: joeydoa
Email: joeydoa@yahoo.com
Created: November 9, 2003
Version: 1.0
Sbver: SmallBASIC


''' The Pirate Interpreter by joeydoa 11/2003
'' Written over a period of 2-3 months (120-200 hours)
'' If you like this port I really need some cash!
'' I''m a former P/A, getting my second degree to be a
'' public school teacher and have been unemployed for two years.
'' So, a mealsey $3 to show your appreciation would help me out!
'' Simply dash a check to:
'' Joseph Whitton
'' 1360 Azalea Road
'' Mobile, AL 36693
'' and THANK YOU!
'' Now the History:
'' Derived from the BASIC listing by Scott Adams published in Byte
'' As well as the dissasembly of the TRS-80 Adams Interpreter.
'' Pirate''s Adventure #2 is built-in! If you want to play the other
'' Scott Adams adventures you need to download this file:
'' -> ftp://ftp.ifarchive.org/if-archive/scott-adams/AdamsGames.zip
'' unzip it and send it to the ram of your ebookman, palm or PDA
'' Also, you can play Brian Howarth''s adventures, same process ->
'' download this file from:
'' -> ftp://ftp.ifarchive.org/if-archive/scott-adams/mysterious.tar.gz
'' unzip and send it to the RAM of your device.
'' *SAVE & LOAD are fully supported. This is version 1.0
'' *SINCE SCROLL AND WINDOWING IS NOT SUPPORTED SIMPLY HIT ENTER
'' TO REDISLAY THE SCREEN!
'' *The wraparound is set at 39 characters (for the ebookman but can
'' be easily changed in the MSGROUTINE.)
'' Have FUN and enjoy/RELIVE the golden days of 8 bit adventuring!
'' *BTW THE QUEST1.DAT & QUEST2.DAT (QUESTPROBE SCOTT ADAMS) &
'' ADV13.DAT HAVE BEEN FORMATTED INCORRECTLY AND WILL NOT RUN!
'' ***I WILL REFORMAT THESE AND REUP THEM TO IF-ARCHIVE - I''LL POST
'' A NOTE WHEN THEY ARE AVAILABLE! THX.
'' Any comments/bugs report to joeydoa@yahoo.com (thank you)

'' HEADER
'' 0 UNKNOWN
'' 1 NUMBER OF ITEMS
'' 2 NUMBER OF ACTIONS
'' 3 NUMBER OF NOUNS AND VERBS (ONE LIST IS PADDED)
'' 4 NUMBER OF ROOMS
'' 5 MAXIMUM A PLAYER CAN CARRY
'' 6 STARTING ROOM
'' 7 TOTAL TREASURES (*)
'' 8 WORD LENGTH (ONLY SEEN 3,4 OR 5)
'' 9 TIME LIGHT SOURCE LASTS. THIS COUNTS DOWN EVERY TIME ITEM 9 IS
'' IN GAME. BRIAN HOWARTHS GAMES ALLOW -1 FOR NEVER RUN DOWN. WHEN
'' IT RUNS OUT THE LIGHT ITEM (9) IS DUMPED IN ROOM 0 AND A LOOK
'' DONE. MESSAGES VARY BETWEEN INTERPRETERS AND INCLUDE THINGS
'' LIKE ''YOUR LIGHT IS FLICKERING AND DYING'' AS WELL AS
'' ''LIGHT RUNS OUT IN %D TURNS''.
'' 10 NUMBER OF MESSAGES
'' 11 ROOM YOU MUST PUT TREASURE IN TO SCORE POINTS. NOT ALL GAMES USE
'' THE TREASURE SYSTEM FOR SCORING
'' ???? 12 UNKNOWN

'' ITEM IN INVENTORY

Const CARRIED=255
Const DARKBIT=15
Const LIGHTOUTBIT=16

'' CARRYING NOTHING
WEIGHT=0
Dim SIT(500),COND(500,5),ACT(500,2),NNVERB(200,1)
Dim MAP(100,6),DESC(200),MESS(200),ITEM(200),ITEMLOC(200)
Dim ITEMSYM(200), ACTCODE(4)
Dim PARAM(10),BITFLAG(100),ACTCODE(4),NT$(2),NV(2)
Dim FULLNOUN(1),RFLAG(2)
Const LIGHTREFILL=XLIGHT

'' DON''T KNOW HOW USED YET
Dim ROOMSAVE(100),COUNTERS(100)
CCOUNTER = 90

Cls
Print " ";CAT(1);"THE PIRATE INTERPRETER";CAT(0)
Print
Print " DERIVED FROM"
Print " THE SCOTT ADAMS INTERPRETER"
?:? " ";CAT(3);"PORTED BY JOEYDOA";CAT(0)
? " NOVEMBER 2003"
?:?
?"DO YOU WISH TO PLAY THE BUILT-IN"
Input " PIRATE''S ADVENTURE";IP
IF LEFT(UCASE$(IP),1)="Y" Then
ADVNAME="adv02.dat"
GAMENAME="adv02.sav"
Input "DO YOU WISH TO LOAD A SAVED GAME";DYP
GoSub GAMEINIT
If LOWER(DYP)="y" Then
If !EXIST(GAMENAME) Then
GoTo GAMELOADED
ENDIF
LOADGAME
Else
GoTo GAMELOADED
ENDIF
ENDIF
LABEL RETRYADV:
? "WHICH SCOTT ADAMS ADVENTURE?":?
? Files("adv*.dat")
? Files("quest*.dat")
? Files("sampl*.dat")
?:? "OR BRIAN HOWARTH ADVENTURE?":?
? Files("?_*.dat")
?:INPUT "WHICH ADVENTURE";IP
FHAND=FREEFILE
ADVNAME=IP
If
!EXIST(ADVNAME) Then GoTo RETRYADV
Open ADVNAME FOR INPUT AS #FHAND

''HEADER
INPUT #FHAND;UNK
INPUT #FHAND;XITEM
INPUT #FHAND;XACT
INPUT #FHAND;XNV
INPUT #FHAND;XROOM
INPUT #FHAND;XCARRY
INPUT #FHAND;SROOM
INPUT #FHAND;XTRES
INPUT #FHAND;WORDLEN
INPUT #FHAND;XLIGHT
LANTERN=XLIGHT
INPUT #FHAND;XMESS
INPUT #FHAND;XTRESRM

''ACTIONS
FOR I=0 TO XACT
INPUT #FHAND;SIT(I)
FOR II=0 TO 4
INPUT #FHAND;COND(I,II)
NEXT II
INPUT #FHAND;ACT(I,0)
Input #FHAND;ACT(I,1)
NEXT
I

''NOUNS AND VERBS
FOR X =0 TO XNV
FOR Y=0 TO 1
INPUT #FHAND;NNVERB(X,Y)
TEMPLEN=Len(NNVERB(X,Y))
TEMP=NNVERB(X,Y)
NNVERB(X,Y)=Mid(TEMP,2,TEMPLEN-2)
NEXT Y
NEXT
X

'' ROOM DESCRIPTIONS AND EXITS
FOR I=0 TO XROOM
FOR II=0 TO 5
INPUT #FHAND;MAP(I,II)
NEXT II
INPUT #FHAND;DESC(I)
TEMPLEN=Len(DESC(I))
TEMP=DESC(I)
DESC(I)=Mid(TEMP,2,TEMPLEN-2)
XT=Chr(13)
TEMP=TRANSLATE(DESC(I),XT," ")
DESC(I)=TEMP
NEXT
I

''MESSAGES
FOR I=0 TO XMESS
INPUT #FHAND;MESS(I)
TEMPLEN=Len(MESS(I))
TEMP=MESS(I)
MESS(I)=Mid(TEMP,2,TEMPLEN-2)
XT=Chr(13)
TEMP=TRANSLATE(MESS(I),XT," ")
MESS(I)=TEMP
NEXT
X

''ITEMS & LOCATIONS
For I=0 TO XITEM
Input #FHAND;ITEM(I)," ",ITEMLOC(I)
TEMPLEN=Len(Item(I))
TEMP=Item(I)
Item(I)=Mid(TEMP,2,TEMPLEN-2)
XT=Chr(13)
TEMP=TRANSLATE(Item(I),XT," ")
Item(I)=TEMP
NEXT
I

CLOSE #FHAND

Input "DO YOU WISH TO LOAD A SAVED GAME";DYW
If
LOWER(Left(DYW,1))="y" Then
TEMP=Len(ADVNAME)
GAMENAME=Mid(ADVNAME,1,TEMP-4)
GAMENAME=GAMENAME+".sav"
If !EXIST(GAMENAME) Then
MYLOC=SROOM
GoTo GAMELOADED
ENDIF
LOADGAME
Else
''STARTING LOCATION
MYLOC=SROOM
GoTo GAMELOADED
ENDIF

LABEL GAMEINIT:
'' HEADER STATEMENT
READ UNK,XITEM,XACT,XNV,XROOM,XCARRY,SROOM,XTRES,WORDLEN,XLIGHT,XMESS,XTRESRM
''DATA 5724,66,177,79,26,6,1,2,3,150,88,1
DATA 5724,66,177,79,26,6,1,2,3,30,88,1
LANTERN=XLIGHT

For
I=0 TO XACT
READ SIT(I)
FOR II=0 TO 4
READ COND(I,II)
NEXT II
READ ACT(I,0),ACT(I,1)
Next
I
DATA 80,422,342,420,340,0,16559,8850
DATA 80,462,482,460,0,0,15712,1705
DATA 100,521,552,540,229,220,203,8700
DATA 3,483,0,0,0,0,15712,0
DATA 100,284,308,0,0,0,8626,0
DATA 100,28,663,403,40,0,8700,0
DATA 100,48,20,660,740,220,9055,10902
DATA 100,28,20,0,0,0,3810,0
DATA 100,8,700,720,0,0,10868,0
DATA 100,48,40,640,400,300,9055,8305
DATA 19,524,0,0,0,0,9778,9450
DATA 40,104,886,0,0,0,4411,0
DATA 80,242,502,820,80,240,9321,10109
DATA 100,8,140,80,500,0,10262,8850
DATA 25,421,846,420,200,0,5162,0
DATA 100,129,120,0,0,0,6508,0
DATA 50,242,982,820,440,240,9321,8850
DATA 35,483,69,0,0,0,15705,0
DATA 7,483,249,0,0,0,15706,0
DATA 50,484,1073,1086,0,0,17661,9150
DATA 50,204,1086,0,0,0,16711,0
DATA 10,209,1040,1060,300,1100,10872,10050
DATA 10,208,1040,1060,89,0,10867,0
DATA 100,483,8,0,0,0,15719,10200
DATA 100,8,0,0,0,0,10200,0
DATA 100,104,308,0,0,0,8626,0
DATA 80,462,282,280,1160,0,1422,0
DATA 80,342,482,480,260,0,18725,9300
DATA 30,483,1212,252,480,1200,18825,0
DATA 20,483,1203,0,0,0,18900,0
DATA 25,1234,483,63,0,0,15733,0
DATA 100,328,1260,180,320,0,10860,11400
DATA 1223,107,100,61,0,0,10507,8164
DATA 7530,404,242,63,903,0,2829,0
DATA 5570,163,203,160,180,0,10870,1264
DATA 6170,183,180,160,0,0,10914,11400
DATA 6300,104,0,0,0,0,900,0
DATA 1529,442,465,440,0,0,7914,0
DATA 1529,442,462,0,0,0,760,9150
DATA 183,322,180,0,0,0,8170,9600
DATA 1538,262,242,0,0,0,1800,0
DATA 1538,262,245,260,0,0,7914,0
DATA 5888,262,242,0,0,0,1800,0
DATA 5888,262,245,0,0,0,1950,0
DATA 6188,262,245,541,260,560,2155,7950
DATA 5888,261,0,0,0,0,2400,0
DATA 4088,561,0,0,0,0,2400,0
DATA 4088,263,0,0,0,0,2713,0
DATA 4088,562,580,109,100,249,2303,8700
DATA 4088,249,562,108,900,240,6203,8700
DATA 4088,248,562,0,0,0,6600,0
DATA 4068,103,69,0,0,0,646,0
DATA 4068,103,68,0,0,0,6600,0
DATA 5887,342,0,0,0,0,2550,0
DATA 5887,362,0,0,0,0,2713,0
DATA 5887,382,0,0,0,0,2100,0
DATA 159,382,320,0,0,0,8170,9600
DATA 6187,342,362,0,0,0,2550,0
DATA 6187,345,362,541,360,380,8303,10164
DATA 3461,503,0,0,0,0,19051,3300
DATA 3750,0,0,0,0,0,9900,0
DATA 1528,0,0,0,0,0,9900,0
DATA 4108,1143,1012,0,0,0,646,0
DATA 1271,0,0,0,0,0,2853,0
DATA 4510,66,0,0,0,0,2720,0
DATA 4950,0,0,0,0,0,9750,0
DATA 5114,0,0,0,0,0,10650,0
DATA 7092,592,0,0,0,0,2745,0
DATA 185,284,140,0,0,0,8156,10564
DATA 4098,1054,0,0,0,0,647,17550
DATA 4098,1053,0,0,0,0,647,17400
DATA 4083,322,0,0,0,0,647,0
DATA 4095,762,0,0,0,0,647,0
DATA 195,782,921,0,0,0,2727,0
DATA 195,762,261,0,0,0,2727,0
DATA 6900,0,0,0,0,0,9450,0
DATA 1526,602,0,0,0,0,2723,0
DATA 1541,621,602,640,520,600,7853,8364
DATA 195,782,661,0,0,0,2727,0
DATA 7092,623,583,303,643,20,8700,0
DATA 7092,0,0,0,0,0,3750,0
DATA 200,722,220,0,0,0,10554,9600
DATA 195,762,61,0,0,0,2727,0
DATA 1223,104,120,61,0,0,10507,8164
DATA 1526,523,520,0,0,0,7914,0
DATA 195,762,340,0,0,0,8126,8464
DATA 195,782,360,0,0,0,8157,10564
DATA 7530,404,242,1053,89,0,17250,0
DATA 0,0,0,0,0,0,0,0
DATA 5868,103,200,69,60,0,4553,8700
DATA 5868,68,0,0,0,0,494,0
DATA 1546,146,0,0,0,0,4800,0
DATA 1546,802,141,140,840,0,8302,17100
DATA 2746,841,840,140,0,0,8302,4950
DATA 3496,802,0,0,0,0,811,0
DATA 3496,841,840,140,0,0,811,8302
DATA 7366,822,820,240,400,0,5305,9300
DATA 5861,503,0,0,0,0,2100,0
DATA 8411,503,500,140,0,0,5433,10800
DATA 192,742,400,0,0,0,8170,9600
DATA 201,404,88,420,240,242,8170,8071
DATA 201,404,89,120,0,0,8170,9600
DATA 7530,404,245,0,0,0,2737,0
DATA 7530,404,912,0,0,0,2738,0
DATA 7530,404,89,80,740,420,10539,8762
DATA 7530,404,88,80,740,120,10539,9062
DATA 7671,0,0,0,0,0,6000,0
DATA 4553,903,0,0,0,0,6300,0
DATA 1350,0,0,0,0,0,6000,0
DATA 1510,62,60,0,0,0,7914,0
DATA 5860,63,1254,1240,0,0,8064,4500
DATA 201,404,88,420,0,0,8170,9600
DATA 218,284,360,0,0,0,8170,9600
DATA 1539,482,242,0,0,0,1800,0
DATA 1539,482,480,0,0,0,7904,16800
DATA 194,682,300,0,0,0,8170,9600
DATA 174,140,464,0,0,0,8751,0
DATA 174,140,0,0,0,0,9051,0
DATA 7800,444,940,921,954,0,10548,8014
DATA 3495,1203,0,0,0,0,19050,0
DATA 7800,424,994,980,921,0,10553,7264
DATA 8250,104,0,0,0,0,10505,9150
DATA 7800,464,148,1140,921,1154,10553,7264
DATA 1541,643,640,0,0,0,7914,0
DATA 163,104,40,0,0,0,8170,9600
DATA 6300,44,0,0,0,0,15456,0
DATA 4534,583,0,0,0,0,4650,0
DATA 6187,702,541,0,0,0,2713,16050
DATA 5887,702,0,0,0,0,2713,0
DATA 5887,0,722,0,0,0,2100,0
DATA 198,1022,480,0,0,0,8170,9600
DATA 216,2,24,40,0,0,8170,9600
DATA 1510,44,60,40,80,85,7801,10800
DATA 1532,302,208,300,0,0,7914,0
DATA 1532,302,209,0,0,0,2813,0
DATA 1532,305,0,0,0,0,10518,7564
DATA 8411,843,840,140,0,0,10914,0
DATA 165,1122,500,0,0,0,8170,9600
DATA 1392,0,0,0,0,0,6000,0
DATA 6300,284,0,0,0,0,16350,0
DATA 8582,0,0,0,0,0,17700,0
DATA 7800,921,209,302,200,0,8814,0
DATA 7950,0,0,0,0,0,2700,0
DATA 5908,621,1143,1000,0,0,4553,0
DATA 5266,0,0,0,0,0,1800,0
DATA 6300,342,0,0,0,0,18450,0
DATA 1200,0,0,0,0,0,17185,450
DATA 6300,124,0,0,0,0,16350,0
DATA 9450,208,1040,1060,0,0,10919,0
DATA 6300,184,242,0,0,0,3600,0
DATA 7800,921,140,0,0,0,7410,0
DATA 6300,24,0,0,0,0,18300,0
DATA 158,82,60,0,0,0,8170,9600
DATA 4510,63,0,0,0,0,300,0
DATA 3450,0,0,0,0,0,2700,0
DATA 6300,0,0,0,0,0,450,0
DATA 163,22,100,0,0,0,8170,9600
DATA 8100,0,0,0,0,0,2836,0
DATA 4650,0,0,0,0,0,128,0
DATA 1538,563,560,0,0,0,7914,0
DATA 5860,1253,63,1220,1234,0,17153,4500
DATA 4060,63,0,0,0,0,730,6900
DATA 4574,1223,0,0,0,0,18000,0
DATA 4103,903,0,0,0,0,730,0
DATA 4575,1243,0,0,0,0,10631,0
DATA 5860,1233,63,0,0,0,494,0
DATA 4125,1243,0,0,0,0,730,0
DATA 2550,0,0,0,0,0,2700,0
DATA 8850,0,0,0,0,0,2832,0
DATA 4063,22,0,0,0,0,647,0
DATA 4092,742,0,0,0,0,647,0
DATA 9676,0,0,0,0,0,20163,0
DATA 5250,0,0,0,0,0,2832,0
DATA 1578,462,0,0,0,0,760,9150
DATA 10063,0,0,0,0,0,2837,0
DATA 8250,0,0,0,0,0,17103,0
DATA 9450,209,1040,1060,300,1100,10872,17100
DATA 4050,0,0,0,0,0,11514,20250
'' VERB/NOUN PAIRING
For X=0 TO XNV
For Y=0 TO 1
READ NNVERB(X,Y)
Next Y
Next
X
'' ADDED SPACE TO NULL
DATA "AUT","ANY","GO","NORTH","*CLI","SOUTH","*WAL","EAST"
DATA "*RUN","WEST","*ENT","UP","*PAC","DOWN","*FOL","."
DATA "SAY","PAS","SAI","HAL","GET","BOO","*TAK","BOT"
DATA "*CAT","*RUM","*PIC","WIN","*REM","GAM","*WEA","MON"
DATA "*PUL","PIR","FLY","ARO","DRO","BAG","*REL","*DUF"
DATA "*THR","TOR","*LEA","OFF","*GIV","MAT","DRI","YOH"
DATA "*EAT","30","INV","LUM","SAI","RUG","LOO","KEY"
DATA "*EXA","INV","*WAT","DUB","REA","SAI","LIS","FIS"
DATA ".","ANC","SCO","SHA","SAV","PLA","KIL","CAV"
DATA "*ATT","SIG","LIG","DOO",".","CHE","OPE","PAR"
DATA "*SHA","HAM","UNL","NAI","HEL","BOA",".","*SHI"
DATA ".","SHE","SWI","CRA","QUI","WAT","BUI","*SAL"
DATA "*MAK","LAG","WAK","*TID","SET","PIT","CAS","SHO"
DATA "DIG","*BEA","BUR","MAP","FIN","PAC","JUM","BON"
DATA "EMP","HOL","WEI","SAN"," ","BOX","BRE","SNE"
DATA "*SMA","CRA",".","*SAC"," ","PIE","WAI","KEE"
DATA "FEE","FLO"," ","*JET"," ","STA","CLO","*UPS"
DATA "*SHU","PAT"," ","*HIL"," ","YOH"," ","AWA"
DATA " ","*BUN"," ","PIE"," ","NOT"," ","FLY"
DATA " ","DES"," ","CRO"," ","SNA"," ","TRE"
'' ROOMS
FOR I=0 TO XROOM
FOR II=0 TO 5
READ MAP(I,II)
NEXT II
READ DESC(I)
NEXT
I
DATA 0,0,0,0,0,0," "
DATA 0,0,0,0,0,0,"FLAT IN LONDON"
DATA 0,0,0,0,0,1,"ALCOVE"
DATA 0,0,4,2,0,0,"SECRET PASSAGEWAY"
DATA 0,0,0,3,0,0,"MUSTY ATTIC"
DATA 0,0,0,0,0,0,"*I''M OUTSIDE AN OPEN WINDOW ON THE LEDGE OF A VERY TALL BUILDING"
DATA 0,0,8,0,0,0,"SANDY BEACH ON A TROPICAL ISLE"
DATA 0,12,13,14,0,11,"MAZE OF CAVES"
DATA 0,0,14,6,0,0,"MEADOW"
DATA 0,0,0,8,0,0,"GRASS SHACK"
DATA 10,24,10,10,0,0,"*I''M IN THE OCEAN"
DATA 0,0,0,0,7,0,"PIT"
DATA 7,0,14,13,0,0,"MAZE OF CAVES"
DATA 7,14,12,19,0,0,"MAZE OF CAVES"
DATA 0,0,0,8,0,0,"*I''M AT THE FOOT OF A CAVE RIDDEN HILL, A PATHWAY LEADS ON UP TO THE TOP"
DATA 17,0,0,0,0,0,"TOOL SHED"
DATA 0,0,17,0,0,0,"LONG HALLWAY"
DATA 0,0,0,16,0,0,"LARGE CAVERN"
DATA 0,0,0,0,0,14,"*I''M ON TOP OF A HILL. BELOW IS PIRATES ISLAND. ACROSS THE SEA WAY OFF IN THE DISTANCE I SEE TREASURE ISLAND"
DATA 0,14,14,13,0,0,"MAZE OF CAVES"
DATA 0,0,0,0,0,0,"*I''M ABOARD PIRATE SHIP ANCHORED OFF SHORE"
DATA 0,22,0,0,0,0,"*I''M ON THE BEACH AT *TREASURE* ISLAND"
DATA 21,0,23,0,0,0,"SPOOKY OLD GRAVEYARD FILLED WITH PILES OF EMPTY AND BROKEN RUM BOTTLES"
DATA 0,0,0,22,0,0,"LARGE BARREN FIELD"
DATA 10,6,6,6,0,0,"SHALLOW LAGOON. TO THE NORTH IS THE OCEAN"
DATA 0,0,0,23,0,0,"SACKED AND DESERTED MONASTARY"
DATA 0,0,0,0,0,0,"*WELCOME TO NEVER NEVER LAND"
'' MESSAGES
FOR I=0 TO XMESS
READ MESS(I)
NEXT
I
DATA ""
DATA "THERE''S A STRANGE SOUND"
DATA "THE BOOK IS IN BAD CONDTION BUT I CAN MAKE OUT THE TITLE: `TREASURE ISLAND`. THERE''S A WORD WRITTEN IN BLOOD IN THE FLYLEAF: `YOHO` AND A MESSAGE: `LONG JOHN SILVER LEFT 2 TREASURES ON TREASURE ISLAND`"
DATA "NOTHING HAPPENS"
DATA "THERE''S SOMETHING THERE ALL RIGHT. MAYBE I SHOULD"
DATA "THAT''S NOT VERY SMART"
DATA "I MAY NEED TO SAY A MAGIC WORD HERE!"
DATA "EVERYTHING SPINS AROUND AND SUDDENLY I''M ELSEWHERE..."
DATA "TORCH IS LIT"
DATA "I WAS WRONG, I GUESS ITS NOT A MONGOOSE CAUSE THE SNAKES BIT IT!"
DATA "I''M SNAKE BIT"
DATA "PARROT ATTACKS SNAKES AND DRIVES THEM OFF"
DATA "PIRATE WON''T LET ME"
DATA "ITS LOCKED"
DATA "ITS OPEN"
DATA "THERE ARE A SET OF PLANS IN IT"
DATA "NOT WHILE I''M CARRYING IT"
DATA "CROCS STOP ME"
DATA "SORRY I CAN''T"
DATA "WRONG GAME YOU SILLY GOOSE!"
DATA "I DON''T HAVE IT"
DATA "PIRATE GRABS RUM AND SCUTTLES OFF CHORTLING"
DATA "...I THINK ITS ME, HEE HEE."
DATA "ITS NAILED TO THE FLOOR!"
DATA "YOHO HO AND A ..."
DATA "NO, SOMETHING IS MISSING!"
DATA "IT WAS A TIGHT SQUEEZE!"
DATA "SOMETHING WON''T FIT"
DATA "SINCE NOTHING IS HAPPENING"
DATA "I SLIPPED AND FELL..."
DATA "SOMETHING FALLS OUT"
DATA "THEY''RE PLANS TO BUILD THE JOLLY ROGER (A PIRATE SHIP!) YOU''LL NEED: HAMMER, NAILS, LUMBER, ANCHOR, SAILS, AND A KEEL."
DATA "I''VE NO CONTAINER"
DATA "IT SOAKS INTO THE GROUND"
DATA "TOO DRY, FISH VANISH."
DATA "PIRATE AWAKENS AND SAYS `AYE MATEY WE BE CASTING OFF SOON` HE THEN VANISHES!"
DATA "WHAT A WASTE..."
DATA "I''VE NO CREW"
DATA "PIRATE SAYS: `AYE MATEY WE BE NEEDING A MAP FIRST`."
DATA "AFTER A DAY AT SEA WE SET ANCHOR OFF OF A SANDY BEACH. ALL ASHORE WHO''S GOING ASHORE..."
DATA "TRY: `WEIGH ANCHOR`"
DATA "THERE''S A MAP IN IT"
DATA "ITS A MAP TO TREASURE ISLAND. AT THE BOTTOM IT SAYS: `30 PACES THEN DIG!`"
DATA "* WELCOME TO ADVENTURE NUMBER 2: `PIRATE ADVENTURE` BY ALEXIS & SCOTT ADAMS, DEDICATED: TED HEEREN & PAUL SHARLAND. REMEMBER YOU CAN ALWAYS ASK FOR `HELP`."
DATA "ITS EMPTY"
DATA "I''VE NO PLANS!"
DATA "OPEN IT?"
DATA "GO THERE?"
DATA "I FOUND SOMETHING!"
DATA "I DIDN''T FIND ANYTHING"
DATA "I DON''T SEE IT HERE"
DATA "OK I WALKED OFF 30 PACES."
DATA "CONGRATULATIONS !!! BUT YOUR ADVENTURE IS NOT OVER YET..."
DATA "READING EXPANDS THE MIND"
DATA "THE PARROT CRYS:"
DATA "`CHECK THE BAG MATEY`"
DATA "`CHECK THE CHEST MATEY`"
DATA "FROM THE OTHER SIDE!"
DATA "OPEN THE BOOK!"
DATA "THERE''S MULTIPLE EXITS HERE!"
DATA "CROCS EAT FISH AND LEAVE"
DATA "I''M UNDERWATER, I GUESS I DON''T SWIM WELL. BLUB BLUB..."
DATA "`PIECES OF EIGHT`"
DATA "ITS STUCK IN THE SAND"
DATA "OK"
DATA "PIRATE SAYS: `AYE ME BUCKEROO, WE BE WAITING FOR THE TIDE TO COME IN!`"
DATA "THE TIDE IS OUT"
DATA "THE TIDE IS COMING IN"
DATA "ABOUT 20 POUNDS. TRY: `SET SAIL`"
DATA "`TIDES BE A CHANGING MATEY`"
DATA "NOTE HERE SAYS: `I BE LIKING PARROTS, THEY BE SMART MATEY!`"
DATA "PIRATE FOLLOWS ME ASHORE AS IF EXPECTING SOMETHING"
DATA "CLIMB STAIRS..."
DATA "GOT ANYTHING TO EAT MATEY?"
DATA "PARROT ATTACKS CROCS BUT IS BEATEN OFF"
DATA "BIRD FLYS OFF LOOKING VERY UNHAPPY"
DATA "PARROT ATE A CRACKER."
DATA "YUMMY"
DATA "I HEAR NOTHING NOW"
DATA "PIRATE SAYS: `FIRST YEE BE GETTING THAT ACCURSED THING OFF ME SHIP!`"
DATA "READ IT?"
DATA "ASK FOR ADVENTURE NUMBER 3: `MISSION IMPOSSIBLE` AT YOUR FAVORITE COMPUTER DEALER. IF THEY DON''T CARRY `ADVENTURE` HAVE THEM CALL: 1-305-862-6917 TODAY! `ADVENTURE` ALSO SUPPORTS LOWER CASE!"
DATA "I''M NOT FEELING DESTRUCTIVE!"
DATA "`CHECK THE BOOK, MATEY!`"
DATA "ALL RIGHT, POOF THE GAME IS DESTROYED!"
DATA "I SEE NOTHING SPECIAL"
DATA "I DON''T KNOW WHERE TO LOOK!"
DATA "ITS STUCK"
DATA ""
'' ITEMS: TEXT/LOCATION
FOR I=0 TO XITEM
READ ITEM(I),ITEMLOC(I)
NEXT
I

CONST LIGHTSRC=9

DATA "FLIGHT OF STAIRS",1
DATA "OPEN WINDOW",2
DATA "BOOKS IN A BOOKCASE",2
DATA "LARGE BLOOD SOAKED BOOK/BOO/",0
DATA "BOOKCASE WITH SECRET PASSAGE BEYOND",0
DATA "PIRATE''S DUFFEL BAG/BAG/",4
DATA "SIGN SAYS: ''BRING *TREASURES* HERE, SAY: SCORE''",1
DATA "EMPTY BOTTLE/BOT/",0
DATA "UNLIT TORCH/TOR/",4
DATA "LIT TORCH/TOR/",0
DATA "MATCHES/MAT/",0
DATA "SMALL SHIP''S KEEL AND MAST",6
DATA "WICKED LOOKING PIRATE",9
DATA "TREASURE CHEST/CHE/",9
DATA "MONGOOSE/MON/",8
DATA "RUSTY ANCHOR/ANC/",24
DATA "GRASS SHACK",8
DATA "MEAN AND HUNGRY LOOKING CROCODILES",11
DATA "LOCKED DOOR",11
DATA "OPEN DOOR WITH HALL BEYOND",0
DATA "PILE OF SAILS/SAI/",17
DATA "FISH/FIS/",10
DATA "*DUBLEONS*/DUB/",25
DATA "DEADLY MAMBA SNAKES",25
DATA "PARROT/PAR/",9
DATA "BOTTLE OF RUM/BOT/",1
DATA "RUG/RUG/",0
DATA "RING OF KEYS/KEY/",0
DATA "OPEN TREASURE CHEST/CHE/",0
DATA "SET OF PLANS/PLA/",0
DATA "RUG",1
DATA "CLAW HAMMER/HAM/",15
DATA "NAILS/NAI/",0
DATA "PILE OF PRECUT LUMBER/LUM/",17
DATA "TOOL SHED",17
DATA "LOCKED DOOR",16
DATA "OPEN DOOR WITH PIT BEYOND",0
DATA "PIRATE SHIP",0
DATA "ROCK WALL WITH NARROW CRACK IN IT",18
DATA "NARROW CRACK IN THE ROCK",17
DATA "SALT WATER",10
DATA "SLEEPING PIRATE",0
DATA "BOTTLE OF SALT WATER/BOT/",0
DATA "RUM BOTTLE SMASHED INTO PIECES. SIGN ''OPPOSITE OF LIGHT IS UNLIGHT''",4
DATA "SAFETY SNEAKERS/SNE/",1
DATA "MAP/MAP/",0
DATA "SHOVEL/SHO/",15
DATA "MOULDY OLD BONES/BON/",0
DATA "SAND/SAN/",6
DATA "BOTTLES OF RUM/BOT/",0
DATA "*RARE STAMPS*/STA/",0
DATA "LAGOON",6
DATA "THE TIDE IS OUT",24
DATA "THE TIDE IS COMING IN",0
DATA "WATER WINGS/WIN/",15
DATA "FLOTSAM AND JETSAM",0
DATA "MONASTARY",23
DATA "WOODEN BOX/BOX/",0
DATA "DEAD SQUIRREL",0
DATA "SIGN IN THE SAND SAYS: ''WELCOME TO PIRATES ISLAND, WATCH OUT FOR THE TIDE!''",6
DATA "SACK OF CRACKERS/CRA/",1
DATA "NOTE/NOT/",0
DATA "SMALL ADVERTISING FLYER/FLY/",0
DATA "BURNT OUT TORCH/TOR/",0
DATA "",0
DATA "",0
DATA "",0
''STARTING LOCATION
MYLOC=SROOM
Return

'' VERSION / ADVENTURE # / MAGIC #
'' DATA 408,2,828

LABEL GAMELOADED:
'' SEPARATE SYNONYM FROM ITEM DESCRIPTION
For I=0 TO XITEM
For II=1 TO Len(ITEM(I))
If MID$(ITEM(I),II,1)="/" THEN
ITEMSYM(I)=UCASE$(MID$(ITEM(I),II+1,Len(ITEM(I))-II-1))
ITEM(I)=LEFT$(ITEM(I),II-1)
ENDIF
Next II
Next
I

''CURSOR=0
'' DISPLAY
Dim ITEMSG(50)
CT=0
GAMESTART=1
GoSub
LOOK

LABEL PARSING:
While TRUE


LABEL GETINPUT:
'' FOR CORRECT TAKE/DROP
DONEACT=0
'' TP$ HOLDS RAW INPUT
'' NT$(0)=VERB, NT$(1)=VERB
'' WAKE UP IF ASLEEP
TKS=TICKSPERSEC
Input"TELL ME WHAT TO DO";TP$
TP$=UCASE$(TP$)
'' HACK FOR REDISLAY WITH EMPTY RETURN FOR EBBOOKMAN
'' SINCE THE CHARACTOR POSITION LOCATOR AND VIEWPORTS
'' DON''T WORK
If Len(TP$)="" Then
GoSub LOOK
GoTo GETINPUT
ENDIF
K=0:NT$(0)="":NT$(1)=""
'' DO LENGTH OF STRING
'' K$ EQUALS NEXT STRING CHARACTER:
'' IF SPACE SET K TO 1 AND DO NEXT WORD
For X=1 TO Len(TP$)
WORD$=MID$(TP$,X,1)
If WORD$=" " Then
K=1
GoTo NXTLBL1
ENDIF
'' FILL VERB OR NOUN IF K IS 0 OR 1
FULLNOUN(K)=NT$(K)+WORD$
NT$(K)=LEFT$(NT$(K)+WORD$,WORDLEN)
'' GOT BOTH WORDS NOW, RUN THRU EM
LABEL NXTLBL1:
Next X
For X=0 to 1
NV(X)=0
If NT$(X)="" Then GoTo NXTLBL3
'' XNV = TOTAL # OF VERBS AND NOUNS
'' CHECK EACH WORD AGAINST LIST
'' CHOP OFF ASTERIK
For Y=0 to XNV
K$=NNVERB(Y,X)
If LEFT$(K$,1)="*" Then K$=Mid(K$,2)
''IF ITS A GO DIRECTION THEN CHOP OFF WORDLEN
If X=1 and Y<7 Then K$=LEFT$(K$,WORDLEN)
'' GET THE VALUE OF THE WORD
If NT$(X)=K$ Then
NV(X)=Y
GoTo NXTLBL2
ENDIF
Next Y
GoTo NXTLBL3
'' MATCHING UP ACTION WORD PAIR ALL *WORDS ARE CHAINED
'' TO AN ORIGIN WORD
LABEL NXTLBL2:
If LEFT$(NNVERB(NV(X),X),1)="*" Then
NV(X)=NV(X)-1
GoTo NXTLBL2
ENDIF
LABEL NXTLBL3:
Next X
'' CHECK FOR NONSENSE INPUT
'' IF 1) NO VERB MATCH OR
'' 2) NO NOUN MATCH THEN SET F
For II=0 TO 1
RFLAG(II)=0
Next II
RFLAG(0)=NV(0)<1
RFLAG(1)=Len(NT$(1))>0 and NV(1)<1
'' LIGHT ROUTINE
If DWALK Then
If ITEMLOC(9)<>CARRIED AND ITEMLOC(9)<>MYLOC Then PRINT"I CAN''T SEE, ITS TOO DARK!"
ENDIF
'' RESET NOUN VERB HOLDER NT$(X) / NV(0)=VERB NV(1)=NOUN

''XXXXXXXXXXXXXXXXX
''GO HACK

''If NV(0)=1 and NV(1)<7 Then '' GoTo GOHACK
'' F=0
GH=0
If NT$(0) = "N" OR NT$(0) = "NOR" THEN
IF NT$(1) = "" THEN
NV(0) = 1
NV(1) = 1
GH=1
ENDIF
ENDIF
IF NT$(0) = "S" OR NT$(0) = "SOU" THEN
IF NT$(1) = "" THEN
NV(0) = 1
NV(1) = 2
GH=1
ENDIF
EndIF
If NT$(0) = "E" OR NT$(0) = "EAS" THEN
IF NT$(1) = "" THEN
NV(0) = 1
NV(1) = 3
GH=1
ENDIF
ENDIF
If NT$(0) = "W" OR NT$(0) = "WES" THEN
IF NT$(1) = "" THEN
NV(0) = 1
NV(1) = 4
GH=1
ENDIF
ENDIF
If NT$(0) = "U" OR NT$(0) = "UP" THEN
IF NT$(1) = "" THEN
NV(0) = 1
NV(1) = 5
GH=1
ENDIF
ENDIF
If NT$(0) = "D" OR NT$(0) = "DOW" THEN
If NT$(1) = "" THEN
NV(0) = 1
NV(1) = 6
GH=1
ENDIF
ENDIF

If BITFLAG(DARKBIT)=1 THEN
IF ITEMLOC(9)<>MYLOC AND ITEMLOC(9)<>CARRIED THEN
IF NV(0) = 1 AND NV(1) > 0 AND NV(1) < 7 THEN
IF DWALK > 0 THEN
PRINT "I FELL DOWN AND BROKE MY NECK."
PRINT
PRINT "GAME OVER."
END
ELSE
DWALK = 1
PRINT "DANGEROUS TO MOVE IN THE DARK!"
TIMING
PRINT "OK. "
TIMING
ENDIF
ENDIF
ENDIF
ENDIF

If GH=1 Then GoTo GOHACK

If
(NV(0)>=0 AND NV(1)=0) OR (NV(0)>0 AND NV(1)>0) Then
GOSUB VERBACTION
FF=0
ENDIF


''GO ROUTINE HACK
LABEL GOHACK:
FLAGDIR=0
If NV(0) = 1 THEN
IF NV(1) > 0 AND NV(1) < 7 THEN
SAVEROOM = 1000
IF NV(1) = 1 AND MAP(MYLOC, 0) > 0 THEN SAVEROOM=MAP(MYLOC, 0):FLAGDIR=1
IF NV(1) = 2 AND MAP(MYLOC, 1) > 0 THEN SAVEROOM=MAP(MYLOC, 1):FLAGDIR=1
IF NV(1) = 3 AND MAP(MYLOC, 2) > 0 THEN SAVEROOM=MAP(MYLOC, 2):FLAGDIR=1
IF NV(1) = 4 AND MAP(MYLOC, 3) > 0 THEN SAVEROOM=MAP(MYLOC, 3):FLAGDIR=1
IF NV(1) = 5 AND MAP(MYLOC, 4) > 0 THEN SAVEROOM=MAP(MYLOC, 4):FLAGDIR=1
IF NV(1) = 6 AND MAP(MYLOC, 5) > 0 THEN SAVEROOM=MAP(MYLOC, 5):FLAGDIR=1
If FLAGDIR=1 Then
IF SWAPROOM <> 1000 THEN
MYLOC = SAVEROOM
CDONE = 1
DONEACT=1
VBFND = 0
NNFND = 0
PRINT "OK."
GoSub VERBACTION
GoSub LOOK
FF=0
FLAGDIR=0
If DONEACT=1 Then GOSUB AUTOMATIC
GoTo GETINPUT
ENDIF
Else
PRINT "I CAN''T GO IN THAT DIRECTION"
GoTo GETINPUT
ENDIF
ENDIF
ENDIF

''If FF=0 AND CONCHECK=1 AND !RFLAG(0) AND GH=0 Then
If FF=0 AND CONCHECK=0 AND !RFLAG(0) AND GH=0 Then

If NV(0) <> 10 AND NV(0) <> 18 Then
PRINT "I CAN''T DO THAT...YET"
GoTo GETINPUT
ENDIF
ENDIF
If RFLAG(0) AND RFLAG(1) THEN
If NV(0) <> 10 AND NV(0) <> 18 Then
PRINT "I MUST BE STUPID,":?"I JUST DON''T UNDERSTAND WHAT YOU MEAN."
GoTo GETINPUT
ENDIF
ENDIF


''If RFLAG(0) AND NV(1)<1
'' Print "HUH?"
'' GoTo GETINPUT
If RFLAG(1) AND !RFLAG(0) Then
Print "I DON''T KNOW WHAT ";CHR(132);FULLNOUN(1);CHR(132);" IS"
GoTo GETINPUT
ElseIf RFLAG(0)
Print "I DON''T KNOW HOW TO ";CHR(132);FULLNOUN(0);CHR(132);" SOMETHING"
''Print "YOU USE WORD(S) I DON''T KNOW!"
GoTo GETINPUT
ENDIF


''ENDIF


If NV(0) = 10 AND DONEACT = 0 THEN GOSUB TAKEOBJ
If NV(0) = 18 AND DONEACT = 0 THEN GOSUB DROPOBJ
If DONEACT=1 Then GOSUB AUTOMATIC
Wend

LABEL LOOK:
Cls

''LIGHT HOUSEKEEPING
IF BITFLAG(DARKBIT)=0 OR ITEMLOC(9)=MYLOC OR ITEMLOC(9)=CARRIED THEN
DWALK = 0
ENDIF

''TRACK CHARACTER POSITION
CHARPOS=0
''LINE POSITION
LNPOS=0
''RESET DISPLAY FLAG
REDRAW=0

If
BITFLAG(DARKBIT)=1 AND ITEMLOC(9)!=255 AND ITEMLOC(9)!=MYLOC THEN
Print "IT''S TOO DARK TOO SEE."
LNPOS=LNPOS+1
GoTo LOOKRET
ENDIF

If
Len(DESC(MYLOC))>0 Then
TEMP=UCASE$(MID$(DESC(MYLOC),1,1))
Else
TEMP=" "
ENDIF
If TEMP<>"*" THEN
MSG="I''M IN A "
MSGXFER=MSG+DESC(MYLOC)+". "
CHARPOS=Len(MSGXFER)
If CHARPOS>39 Then
MSGROUTINE
Else
Print MSGXFER;
CHARPOS=CHARPOS+Len(MSGXFER)
ENDIF
ElseIf TEMP="*" THEN
MSGXFER=MID$(DESC(MYLOC),2,Len(DESC(MYLOC))-1)+". "
CHARPOS=Len(MSGXFER)
If CHARPOS>39 Then
MSGROUTINE
Else
Print MSGXFER;
CHARPOS=CHARPOS+Len(MSGXFER)
ENDIF
ENDIF
LNPOS=LNPOS+1
MSG="VISIBLE ITEMS:"
VI=1
CHARPOS=CHARPOS+Len(MSG)
If
CHARPOS>40 THEN
PRINT
LNPOS=LNPOS+1
CHARPOS=0
ENDIF
Print MSG
Print
LNPOS=LNPOS+2
II=0
MSGXFER=""
While (II<=XITEM)
If ITEMLOC(II)=MYLOC Then
MSGXFER=MSGXFER+Item(II)+". "
ENDIF
II=II+1
Wend

If
Len(MSGXFER)<>0 Then
MSGROUTINE
ENDIF

''If CHARPOS>0 Then
'' LNPOS=LNPOS+1
''ENDIF

FF=0
For
I=0 TO 5
If MAP(MYLOC,I)<>0 Then FF=1
Next
I
If
FF<>0 THEN
If CHARPOS=0 THEN
Print:Print Tab(5);
LNPOS=LNPOS+2
Else
Print:Print:Print Tab(5);
LNPOS=LNPOS+3
ENDIF
Print "SOME OBVIOUS EXITS ARE: "
Print Tab(10);
CHARPOS=0
ELSE
GoTo LOOKRET
ENDIF
If MAP(MYLOC, 0) <> 0 Then
PRINT "NORTH ";
''CHARPOS=CHARPOS+6
ENDIF
If MAP(MYLOC, 1) <> 0 Then
Print "SOUTH ";
''CHARPOS=CHARPOS+6
ENDIF
If MAP(MYLOC, 2) <> 0 Then
Print "EAST ";
''CHARPOS=CHARPOS+5
ENDIF
If MAP(MYLOC, 3) <> 0 Then
Print "WEST ";
''CHARPOS=CHARPOS+5
ENDIF
If MAP(MYLOC, 4) <> 0 Then
Print "UP ";
''CHARPOS=CHARPOS+3
ENDIF
If MAP(MYLOC, 5) <> 0 Then
Print "DOWN";
''CHARPOS=CHARPOS+4
ENDIF

If
CHARPOS>0 Then
''LNPOS=LNPOS+1
?
ENDIF
LABEL LOOKRET:
'' TRS-80 BAR
'' ADJUST
''LNPOS=LNPOS+1
YWAY=LNPOS*9
For
I=0 TO 6
LINE 0,YWAY+I,199,YWAY+I COLOR 0
NEXT
I


''MOVE CURSOR
?:?:?

If
GAMESTART=1 Then
GAMESTART=0
NV(0)=0
NV(1)=0
GoSub AUTOMATIC
ENDIF
Return

LABEL AUTOMATIC:
For
Y=0 TO XITEM
CT=Y
IF INT(SIT(Y)\150)=0 THEN
RANDOMIZE TIMER
RVAL=INT(RND*100)
IF INT(SIT(Y) MOD 150)>RVAL THEN
GOSUB MESSAGING
ENDIF
ENDIF
NEXT Y

If
LANTERN=1 THEN BITFLAG(LIGHTOUTBIT)=1
If
LANTERN>0 AND LANTERN<25 Then
If ITEMLOC(9)=MYLOC OR ITEMLOC(9)=CARRIED THEN PRINT "YOUR LIGHT IS FLICKERING..."; LANTERN; " MORE MOVES":?"UNTIL IT GOES OUT."
''TIMING
''GoSub LOOK
EndIF
If ITEMLOC(9)=CARRIED OR ITEMLOC(9)=MYLOC THEN LANTERN=LANTERN-1
If
LANTERN<0 Then
LANTERN=0
BITFLAG(DARKBIT)=1
GoSub LOOK
ENDIF
''GOSUB LOOK
RETURN

LABEL MESSAGING:
CONT=0

LABEL CONTLOOP:

For
I=0 TO 9
PARAM(I)=0
Next
I

CDONE=1
CPTR=0
AC=0

While (AC<5) '''''''''''''''''''' FOUR ACTION LOOP THING
CV=Int(COND(CT,AC) MOD 20)
DV=Int(COND(CT,AC)\20)
If CV=0 Then
PARAM(CPTR)=DV
CPTR=CPTR+1
ENDIF
If CV=1 THEN
If ITEMLOC(DV)!=CARRIED Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=2 THEN
If ITEMLOC(DV)!=MYLOC THEN
CDONE=0
''Return
ENDIF
ENDIF
If CV=3 Then
If ITEMLOC(DV)!=CARRIED && ITEMLOC(DV)!=MYLOC Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=4 Then
If MYLOC!=DV Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=5 Then
If ITEMLOC(DV)=MYLOC Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=6 Then
If ITEMLOC(DV)=CARRIED Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=7 Then
If MYLOC=DV Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=8 Then
If BITFLAG(DV)=0 Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=9 Then
If BITFLAG(DV)=1 Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=10 Then
CNTCARRY
If WEIGHT=0 Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=11 Then
CNTCARRY
If WEIGHT<>0 Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=12 Then
If (ITEMLOC(DV)=CARRIED) OR (ITEMLOC(DV)=MYLOC) Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=13 Then
If ITEMLOC(DV)=0 Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=14 THEN
If ITEMLOC(DV)<>0 Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=15 THEN
If CCOUNTER>DV THEN
CDONE=0
''Return
ENDIF
ENDIF
If CV=16 THEN
If CCOUNTER<=DV THEN
CDONE=0
''Return
ENDIF
ENDIF
If CV=17 THEN
If ITEMLOC(DV)!=ITEM(DV) Then
CDONE=0
''Return
ENDIF
ENDIF
If CV=18 THEN
If ITEMLOC(DV)=ITEM(DV) THEN
CDONE=0
''Return
ENDIF
ENDIF
'' FOR BRIAN HOWARTH ADVENTURES
If CV=19 THEN
If CCOUNTER!=DV THEN
CDONE=0
''Return
ENDIF
ENDIF
AC=AC+1
Wend

If
CDONE=1 Then
GoSub ACTIONS
DONEACT=1
ENDIF
If CONT>0 THEN
IF INT(SIT(CT+1)\150)=0 THEN
IF INT(SIT(CT+1) MOD 150)=0 THEN
CONT=2
CT=CT+1
Else
CONT=0
ENDIF
Else
CONT=0
ENDIF
ENDIF

IF
CONT>1 Then GOTO CONTLOOP

Return

LABEL ACTIONS:
''ACTION ALGORITHM CALC
ACTCODE(0) = Int(ACT(CT,0) \ 150)
ACTCODE(1) = Int(ACT(CT,0) MOD 150)
ACTCODE(2) = Int(ACT(CT,1) \ 150)
ACTCODE(3) = Int(ACT(CT,1) MOD 150)

AC=0
PPTR=0
While (AC<4)
If (ACTCODE(AC)>=1 && ACTCODE(AC)<52) Then
MSGXFER=MESS(ACTCODE(AC))
If Len(MSGXFER)>39 Then
MSGROUTINE
Else
Print MESS(ACTCODE(AC))
ENDIF
TIMING
ElseIf (ACTCODE(AC)>101)
MSGXFER=MESS(ACTCODE(AC)-50)
If Len(MSGXFER)>39 Then
MSGROUTINE
Else
Print MESS(ACTCODE(AC)-50)
ENDIF
TIMING
Else
''If ACTCODE(AC)=0 Then
'' AC=AC
''ENDIF
IF ACTCODE(AC)=52 Then
CNTCARRY
IF WEIGHT=XCARRY THEN
PRINT "I''VE TOO MUCH TO CARRY."
PRINT "TRY -TAKE INVENTORY-"
Else ''IF ITEMLOC(PARAM(PPTR))=MYLOC THEN
ITEMLOC(PARAM(PPTR))=CARRIED
CNTCARRY
PPTR=PPTR+1
REDRAW=1
ENDIF
ENDIF
If ACTCODE(AC)=53 Then
REDRAW=1
ITEMLOC(PARAM(PPTR))=MYLOC
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=54 Then
REDRAW=1
MYLOC=PARAM(PPTR)
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=55 Then
'' If ITEMLOC(PARAM(PPTR))=MYLOC Then
ITEMLOC(PARAM(PPTR))=0
REDRAW=1
PPTR=PPTR+1
'' ENDIF
ENDIF
If ACTCODE(AC)=56 Then
BITFLAG(DARKBIT)=1
ENDIF
If ACTCODE(AC)=57 Then
BITFLAG(DARKBIT)=0
ENDIF
If ACTCODE(AC)=58 Then
BITFLAG(PARAM(PPTR))=1
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=59 Then
'' If ITEMLOC(PARAM(PPTR))=MYLOC Then
ITEMLOC(PARAM(PPTR))=0
REDRAW=1
PPTR=PPTR+1
'' ENDIF
ENDIF
If ACTCODE(AC)=60 Then
BITFLAG(PARAM(PPTR))=0
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=61 Then
Print "I AM DEAD."
TIMING
BITFLAG(DARKBIT)=0
MYLOC=XROOM
GoSub AUTOMATIC
GoSUB LOOK
ENDIF
If ACTCODE(AC)=62 Then
'' I=PARAM(PPTR)
'' PPTR=PPTR+1
'' ITEMLOC(PARAM(PPTR))=PARAM(PPTR+1)
ITEMLOC(PARAM(PPTR))=PARAM(PPTR+1)
REDRAW=1
PPTR=PPTR+2
ENDIF
If ACTCODE(AC)=63 THEN
Print "THE GAME IS NOW OVER."
TIMING
GoTo ADVEXIT
ENDIF
If ACTCODE(AC)=64 Then
GoSub LOOK
ENDIF
If ACTCODE(AC)=65 Then
GoSub CALCSCORE
Print "I''VE STORED ";SCORE;" TREASURES."
Print "ON A SCALE OF 0 TO 100, THAT RATES ";
Print Int((SCORE*100)/XTRES)
If SCORE=XTRES Then
Print "WELL DONE."
GoTo ADVEXIT
'' goto doneit
ENDIF
ENDIF
If ACTCODE(AC)=66 Then
II=0
FF=0
Print "I AM CARRYING THE FOLLOWING:"
MSGXFER=""
While (II<=XITEM)
If ITEMLOC(II)=CARRIED Then
MSGXFER=MSGXFER+Item(II)+". "
FF=1
ENDIF
II=II+1
Wend
If (FF=0) Then
Print "NOTHING."
Else
MSGROUTINE
PRINT
ENDIF
ENDIF
If ACTCODE(AC)=67 Then
BITFLAG(0)=1
ENDIF
If ACTCODE(AC)=68 Then
BITFLAG(0)=0
ENDIF
If ACTCODE(AC)=69 Then
XLIGHT=LIGHTREFILL
If (ITEM(LIGHTSRC)=MYLOC) Then
REDRAW=1
ITEM(LIGHTSRC)=CARRIED
LANTERN=XLIGHT
BITFLAG(LIGHTOUTBIT)=0
ENDIF
ENDIF
If ACTCODE(AC)=70 THEN
''Cls
ENDIF
If ACTCODE(AC)=71 Then
TEMP=Len(ADVNAME)
GAMENAME=Mid(ADVNAME,1,TEMP-4)
GAMENAME=GAMENAME+".sav"
SAVEGAME
Print "OK."
EndIF
If ACTCODE(AC)=72 Then
''SWAP1=ITEMLOC(PPTR)
''SWAP2=ITEMLOC(PPTR+1)
''If (ITEMLOC(SWAP1)=MYLOC || ITEMLOC(SWAP2)=MYLOC) Then
SWAP ITEMLOC(PARAM(PPTR)),ITEMLOC(PARAM(PPTR+1))
REDRAW=1
PPTR=PPTR+2
ENDIF
If ACTCODE(AC)=73 THEN
CONT=1
ENDIF
If ACTCODE(AC)=74 THEN
If (ITEMLOC(PARAM(PPTR))=MYLOC) Then
REDRAW=1
ITEMLOC(PARAM(PPTR))=CARRIED
PPTR=PPTR+1
ENDIF
ENDIF
''CHANGED
If ACTCODE(AC)=75 Then
I1=PARAM(PPTR)
I2=PARAM(PPTR+1)
If (ITEMLOC(PARAM(PPTR))=MYLOC) Then
REDRAW=1
ITEMLOC(I1)=ITEMLOC(I2)
If (ITEMLOC(I1)=MYLOC) Then
REDRAW=1
ENDIF
PPTR=PPTR+2
ENDIF
ENDIF
If ACTCODE(AC)=76 Then
GoSub LOOK
ENDIF
If ACTCODE(AC)=77 THEN
If (CCOUNTER>=0) Then
CCOUNTER=CCOUNTER-1
ENDIF
ENDIF
If ACTCODE(AC)=78 Then
Print CCOUNTER
ENDIF
If ACTCODE(AC)=79 Then
CCOUNTER=PARAM(PPTR)
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=80 Then
SWAP MYLOC,ROOMSAVE(35)
''T=MYLOC
''MYLOC=SAVEROOM
''SAVEROOM=T
REDRAW=1
ENDIF
If ACTCODE(AC)=81 THEN
T=PARAM(PPTR)
C1=CCOUNTER
CCOUNTER=COUNTERS(T)
COUNTERS(T)=C1
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=82 Then
CCOUNTER=CCOUNTER+PARAM(PPTR)
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=83 Then
CCOUNTER=CCOUNTER-PARAM(PPTR)
If (CCOUNTER< -1) Then
CCOUNTER=-1
ENDIF
PPTR=PPTR+1
ENDIF
If ACTCODE(AC)=84 Then
Print FULLNOUN(1)
ENDIF
If ACTCODE(AC)=85 THEN
Print FULLNOUN(1)
ENDIF
If ACTCODE(AC)=86 Then
Print
ENDIF
If ACTCODE(AC)=87 Then
''Changed this to swap location<->roomflag(x)
''not roomflag 0 and x

SWAP MYLOC,ROOMSAVE(PARAM(PPTR))
REDRAW=1
PPTR=PPTR+1
ENDIF

If ACTCODE(AC)=88 THEN
TIMING
ENDIF
If ACTCODE(AC)=89 Then
PPTR=PPTR+1
''SAGA draw picture n
''Spectrum Seas of Blood - start combat ?
''Poking this into older spectrum games causes a crash
ENDIF
ENDIF
AC=AC+1
Wend
If
REDRAW=1 Then
GoSub LOOK
REDRAW=0
ENDIF
Return

LABEL VERBACTION:

CT = -1
CONCHECK=0


While CT CT=CT+1
'' NORMAL VERBS
IF Int(SIT(CT) \ 150) = NV(0) THEN
IF Int(SIT(CT) MOD 150) = NV(1) THEN
CONCHECK=1
GOSUB MESSAGING
ENDIF
EndIF
Wend
'' ANY VERBS

If
DONEACT = 0 Then
CT=-1
While CT
CT=CT+1
IF Int(SIT(CT) \ 150) = NV(0) THEN
IF Int(SIT(CT) MOD 150) = 0 Then
GoSub MESSAGING
ENDIF
ENDIF
Wend
ENDIF
RETURN

LABEL TAKEOBJ:

ITEMTAKEN=0
FOR
X=0 TO XITEM
IF ITEMLOC(X)=MYLOC THEN
TEMPOBJ=UCASE$(ITEM(X))
CP=INSTR(TEMPOBJ,NT$(1))
IF CP>0 THEN
TEMPWORD=MID(TEMPOBJ,CP,3)
ENDIF
IF TEMPWORD=NT$(1) AND LEN(ITEMSYM(X)) > 1 OR NT$(1)=ITEMSYM(X) THEN
IF CP>0 Then
CNTCARRY
IF WEIGHT THEN
ITEMLOC(X)=CARRIED
PRINT "OK."
TIMING
CNTCARRY
DONEACT=1
ITEMTAKEN=1
Exit
ENDIF
IF WEIGHT=XCARRY THEN
ITEMTAKEN=2
EXIT
ENDIF
ENDIF
ENDIF
IF TEMPWORD = NT$(1) AND LEN(ITEMSYM(X)) = 1 THEN ITEMTAKEN = 3
ENDIF
NEXT X

IF
ITEMTAKEN=3 Then
If FF=0 AND CONCHECK=1 AND !RFLAG(0) AND !RFLAG(1) AND GH=0 Then
PRINT "I CAN''T DO THAT...YET"
Else
Print "IT IS BEYOND MY POWER TO DO THAT."
ENDIF
ENDIF

IF
ITEMTAKEN=2 THEN PRINT "I AM ALREADY CARRYING TOO MUCH."
IF
ITEMTAKEN=0 THEN PRINT "I DON''T SEE THAT HERE."
RETURN

LABEL DROPOBJ:

CARRYING=0
TEMPWORD=""

FOR
X=0 TO XITEM
IF ITEMLOC(X)=CARRIED Then
TEMPOBJ=UCASE$(Item(X))
CP=InStr(TEMPOBJ,NT$(1))
If CP>0 Then TEMPWORD=Mid(TEMPOBJ,CP,3)
If TEMPWORD=NT$(1) AND LEN(ITEMSYM(X))>1 OR NT$(1)=ITEMSYM(X) Then
If CP>0 Then
NT$(1)=ITEMSYM(X)
ITEMLOC(X)=MYLOC
Print "OK."
''GOSUB CALCSCORE
DONEACT=1
CNTCARRY
CARRYING=1
TIMING
Exit
Else
IF TEMPWORD=NT$(1) AND LEN(ITEMSYM(X))=0 THEN
PRINT "IT IS BEYOND MY POWER TO DO THAT."
CARRYING=1
ENDIF
ENDIF
ENDIF
TEMPWORD=""
ENDIF
If CARRYING=1 THEN Exit
NEXT
X
IF
CARRYING=0 THEN
PRINT "I AM NOT CARRYING THAT."
ENDIF
Return

LABEL CALCSCORE:

II=0
SCORE=0
While (II<=XITEM)
If (ITEMLOC(II)=XTRESRM) && (LEFT$(ITEM(II))="*") Then
SCORE=SCORE+1
ENDIF
II=II+1
Wend
Return

LABEL ADVEXIT:
PAUSE

FUNC
TIMING()
A=TIMER
WHILE TIMER RECT 189,0,199,15,0 FILLED
RECT 189,0,199,15,15 FILLED
Wend

END

End

FUNC
CNTCARRY()
CC=0
WEIGHT=0
While CC<=XITEM
If ITEMLOC(CC)=CARRIED Then
WEIGHT=WEIGHT+1
ENDIF
CC=CC+1
Wend

End

FUNC
MSGROUTINE()
DIM MLINE(500)
MSGLN=LEN(MSGXFER)
For
I=1 TO MSGLN
MLINE(I)=MID(MSGXFER,I,1)
Next
I
EPOS=39
SPOS=1
MSGTRUE=1
WHILE MSGTRUE=1
While MLINE(EPOS)<>" "
EPOS=EPOS-1
WEND
FOR I=SPOS TO EPOS
If MLINE(I)=Chr(10) Then
MLINE(I)=Chr(32)
ENDIF
PRINT MLINE(I);
NEXT I
Print
LNPOS=LNPOS+1
EPOS=EPOS+1
SPOS=EPOS
EPOS=EPOS+39
IF EPOS>=MSGLN THEN
FOR II=SPOS TO MSGLN
PRINT MLINE(II);
NEXT II
Print
LNPOS=LNPOS+1
MSGTRUE=0
ENDIF
Wend
CHARPOS=0
End

FUNC
LOADGAME

FHAND=FreeFile
Open GAMENAME For Input AS #FHAND
For
SG=0 TO 100
INPUT #FHAND;ROOMSAVE(SG)
Next
SG
For
SG=0 TO 100
INPUT #FHAND;COUNTERS(SG)
Next
SG
For
SG=0 TO 100
INPUT #FHAND;BITFLAG(SG)
Next
SG
For
SG=0 TO 200
INPUT #FHAND;ITEMLOC(SG)
Next
SG
INPUT #FHAND;CCOUNTER
INPUT #FHAND;WEIGHT
INPUT #FHAND;SAVEROOM
INPUT #FHAND;MYLOC
Input #FHAND;LANTERN
Close #FHAND
GoTo
GAMELOADED
End

FUNC
SAVEGAME

FHAND=FreeFile
If
EXIST(GAMENAME) Then
Kill GAMENAME
ENDIF
Open GAMENAME For OUTPUT AS #FHAND
For
SG=0 TO 100
Print #FHAND,ROOMSAVE(SG)
Next
SG
For
SG=0 TO 100
Print #FHAND,COUNTERS(SG)
Next
SG
For
SG=0 TO 100
Print #FHAND,BITFLAG(SG)
Next
SG
For
SG=0 TO 200
Print #FHAND,ITEMLOC(SG)
Next
SG
Print #FHAND,CCOUNTER
Print #FHAND,WEIGHT
Print #FHAND,SAVEROOM
Print #FHAND,MYLOC
Print #FHAND,LANTERN
Close #FHAND

End

'