(* * LANGUAGE : ANS Forth * PROJECT : Forth Environments * DESCRIPTION : Find your way out of a maze. * CATEGORY : Game, text based. * AUTHOR : (c) 1983 by A. Clapman - Design and original Spectrum programming * AUTHOR : (c) 1996 by H. Bezemer - Structured design and 4tH programming * AUTHOR : 1997 mhx: restored to a Forth program. * LAST CHANGE : April 11, 1997, Marcel Hendrix *) NEEDS -miscutil NEEDS -terminal REVISION -adventur "─── Adventure Game Version 1.01 ───" PRIVATES : ECHO[ BEGIN 0. refill WHILE 2drop 0 2dup s" ]ECHO" compare 0<> WHILE POSTPONE sliteral POSTPONE type POSTPONE cr REPEATED 2drop ;P IMMEDIATE :ABOUT ECHO[ Extract from a time-traveller's diary discovered in the pyramid of Ikhotep, pharaoh of the ninth dynasty, on the planet Sirius B, in the dog star system. "I have been attempting to discover the secret of the pyramid for some months now. It is the only way I will be able to escape this barren planet. After my time-machine was destroyed by the warrior tribe I found my way to this dusty monument after consulting a man they regard as a wizard. He is in fact a fellow traveller in time and space exiled by the Time Lords to this lost planet. He has decided to stay and persue his black arts amoung the warrior folk. But he has told me of a time gate which will lead me back to the main time lanes and freedom. He said the gate was hidden within the pyramid. I have uncovered some clues but not enough to lead me to the final solution. I can only keep trying. But I feel that, for me at least, time is running out." The diary was found next to a small pile of oddly shaped bones deep within the heart of the pyramid. Can you find your way out of the pyramid and off the barren planet? You will find several rooms within the pyramid and several objects within those rooms which must be collected to solve the riddle of the ancient monument. The program uses the standard two word entry system and adjectives should not be entered. To move simply type in the direction you want to go, for example 'N' or 'north'. Other useful words are TAKE, GET, THROW, DROP, INVENTORY. Careful: use "HELMET TAKE" not "TAKE HELMET" Type "ADVENTURE" (without the quotes) to start. ]ECHO ; BASE @ DECIMAL : .string ( 'string -- ) @ .$ ;P : d" ( "str" -- c-addr ) &" DUP 1+ allocate ?allocate pack ;P 6 =: #flags PRIVATE \ Number of special cases 14 =: #mapped PRIVATE \ numbered locations on the map 0 =: stays PRIVATE \ cannot be moved 1 =: moves PRIVATE \ can be moved CREATE objects PRIVATE #mapped cells ALLOT CREATE flags PRIVATE #flags chars ALLOT CREATE map PRIVATE #mapped cells ALLOT CREATE default PRIVATE 3 , 4 , 2 , 16 , 13 , 12 , 11 , 10 , 15 , 14 , 5 , 0 , 7 , 0 , 0 VALUE north PRIVATE 0 VALUE south PRIVATE 0 VALUE west PRIVATE 0 VALUE east PRIVATE 0 VALUE level PRIVATE \ room where you are 0 VALUE object PRIVATE \ subject mentioned by player : initmap \ fills the map with values default map #mapped cells move flags #flags 0 fill ;p : CANNOT CR ." YOU CAN'T, IDIOT!!" ;p : DEAD CR ." YOU'RE DEAD!!" quit ;p : DUNNO CR ." I don't know what you mean." ;p : NOTHERE CR ." It isn't here!!" ;p : NOCARRY CR ." You aren't carrying it, stupid!!" ;p \ It would be nice to have a graphical editor / compiler for this.. CREATE locations PRIVATE \ map locations to directions d" a road leading west and east. Two things are pointing to the west." , 0 , 0 , -1 , 2 , d" a bend in the road." , 0 , 5 , 1 , 0 , d" a small dark shack." , 0 , 0 , 0 , 5 , d" a small dark shack." , 0 , 0 , 5 , 15 , d" a road leading north and south. There are shacks either side." , 2 , 6 , 3 , 4 , d" a road leading north. There is a pyramid south." , 5 , 7 , 0 , 0 , d" the entrance hall of the pyramid. There is a road north." , 6 , 12 , 8 , 9 , d" the embalming room." , 0 , 0 , 10 , 7 , d" the recreation room. An exit to the garden is east." , 0 , 13 , 7 , 16 , d" the room of ANKH." , 0 , 0 , 0 , 8 , d" a small triangular room." , 0 , 0 , 0 , 12 , d" a long oblong room" , 7 , 14 , 11 , 0 , d" the funeral parlour" , 9 , 0 , 0 , 0 , d" the treasure room. It has been looted. There is a smashed door north." , 12 , 0 , 0 , 0 , d" a small circular cave." , 0 , 0 , 4 , 0 , d" a small garden." , 0 , 0 , 9 , 0 , : room ( -- addr ) \ get address of room level 1- 5 cells * locations + ;p : set-possibilities ( 'room -- ) \ fill n-s-w-e variables cell+ @+ TO north @+ TO south @+ TO west @ TO east ;p \ A remarkably murky definition, but it's the cornerstone of this game :-( : except ( v flag# room# -- f ) \ make flag of exception level = >r chars flags + c@ = r> and ;p : north? north IF ." North" Tab emit THEN ;p : south? 0 2 12 except IF 0 TO south THEN south IF ." South" Tab emit THEN ;p : west? 0 3 8 except IF 0 TO west THEN west IF ." West" Tab emit THEN ;p : east? 0 0 4 except IF 0 TO east THEN east IF ." East" Tab emit THEN ;p : 'object ( n -- addr ) objects []cell @ ;P : showcontents ( n -- ) \ prints the appropriate strings cr Tab emit dup 'object 2 cells + .string bl emit 'object cell+ .string ;p : contents \ shows the contents of a room 0 #mapped 0 do map i cell[] @ level = IF 1+ i showcontents THEN loop 0= IF cr Tab emit ." None" THEN 0 3 8 except IF cr ." There is a small slot on the west wall." THEN 2 0 4 except IF cr ." The dragon doesn't like you so he kills you." DEAD THEN 0 0 4 except IF cr ." The dragon blocks a hole in the EAST wall." 2 flags c! THEN level 4 <> flags c@ 2 = and IF 0 flags c! THEN 1 0 4 except IF cr ." The dragon is dead." THEN 0 1 16 except IF cr ." There is something glistening at the top of the tree." THEN 1 1 16 except IF cr ." The tree is lying on the ground" THEN 1 2 12 except level 14 = or IF cr ." The door is smashed down" THEN ;p : map? ( n -- f ) map []cell @ -1 <> ;p : lastroom? level -1 <> IF exit THEN CR ." LASER BOLTS FLASH OUT FROM THE KILLO-ZAP GUNS FIXED TO THE ROAD!" CR 7 map? 8 map? and IF CR ." FRIZZLE!!" DEAD THEN 8 map? IF CR ." THE LEFT RAY IS REFLECTED BY THE MIRROR. THE RIGHT ONE ISN'T!!" DEAD THEN 7 map? IF CR ." THE RIGHT RAY IS REFLECTED BY THE REFLECTOR. THE LEFT ONE ISN'T!!" DEAD THEN CR ." BOTH THE RAYS ARE REFLECTED BY THE MIRROR AND THE REFLECTOR!!" CR ." YOU HAVE MANAGED TO ESCAPE ALIVE!!" CR quit ;p : .room lastroom? CR ." You are at " room .string \ show location room set-possibilities CR ." Directions you may proceed in:" CR Tab emit north? south? west? east? CR CR ." Things of interest here:" contents ;P : do-go ( val -- ) dup 0= IF drop CANNOT exit THEN TO level ;p : do-take \ take an object object map []cell @ -1 = IF cr ." YOU ARE ALREADY CARRYING IT!!" exit THEN object 0<> 0 map? and IF cr ." YOU HAVEN'T GOT ANYTHING TO CARRY IT IN!!" exit THEN object map []cell @ level <> IF NOTHERE exit THEN object 'object @ stays = IF CANNOT exit THEN object 0= IF -1 map ! cr ." YOU STRAP IT ON YOUR WRIST." exit THEN -1 object map []cell ! cr ." IT ZOOMS SAFELY INTO YOUR WATCH!" ;p : do-drop \ drop object object map? IF NOCARRY THEN level map object cell[] ! object 12 = IF flags 4 chars + c0! THEN ;p : do-saw \ saw tree object 3 <> flags 1 chars + c@ 1 = or IF CANNOT exit THEN 2 map? 6 map? or IF CANNOT exit THEN level 16 <> IF NOTHERE exit THEN flags 5 chars + c@ 0= IF cr ." The saw won't work without electricity!!" exit THEN flags 4 chars + c@ 0= IF cr ." The tree falls on your unprotected head. Crunch." DEAD THEN 1 flags 1 chars + c! cr ." The tree falls down on your safety helmet." cr ." An axe falls out of the top of the tree." level map 13 cell[] ! ;p : do-smash \ smash door object 5 <> IF CANNOT exit THEN 13 map? flags 2 chars + c@ 1 = or IF CANNOT exit THEN level 12 <> IF NOTHERE exit THEN cr ." Chop chop smash smash.. The door has been smashed down." 1 flags 2 chars + c! ;p : do-wear \ wear helmet object 12 <> IF CANNOT exit THEN 12 map? IF NOCARRY exit THEN 1 flags 4 chars + c! ;p : do-connect \ connect generator object 6 <> object 2 <> and IF CANNOT exit THEN map? IF NOCARRY exit THEN 6 map? 2 map? or IF CANNOT exit THEN 1 flags 5 chars + c! ;p : do-push \ push wall object 9 <> IF CANNOT exit THEN object map? IF NOCARRY exit THEN level 8 <> IF cr ." I can't see anywhere to insert it!!" exit THEN map object cell[] OFF cr ." The wall suddenly shakes and glides one side leaving a doorway west!!" 1 flags 3 chars + c! ;p : do-file \ file knife object 10 <> IF CANNOT exit THEN map? IF NOCARRY exit THEN 4 map? IF cr ." You haven't got anything to sharpen it on!!" exit THEN cr ." The knife turns extra sharp!!" 0 map 10 cell[] ! -1 map 11 cell[] ! ;p : do-kill \ kill dragon object 1 <> 11 map? or IF CANNOT exit THEN level 4 <> IF NOTHERE exit THEN flags c@ 1 = IF cr ." The poor thing is already dead ..." exit THEN 1 flags c! cr ." Squelch. The dagger sinks to the hilt in the dragon." cr ." It's dead. Poor thing." ;p : do-list \ shows the inventory cr ." You are carrying:" 0 #mapped 0 do map i cell[] @ -1 = IF cell+ i showcontents THEN loop 0= IF cr Tab emit ." Nothing" THEN ;p : OBJECT: ( attr1 name attr2 # -- ) CREATE DUP , objects []cell HERE SWAP ! , , , DOES> @ TO object ;P WORDLIST CONSTANT PRIVATE \ Here's where the user commands go. SET-CURRENT : go ; : move ; : run ; : walk ; : stop quit ; : help .help ; : north north do-go ; : n north do-go ; : south south do-go ; : s south do-go ; : west west do-go ; : w west do-go ; : east east do-go ; : e east do-go ; : get do-take ; : take do-take ; : steal do-take ; : drop do-drop ; : throw do-drop ; : leave do-drop ; : saw do-saw ; : cut do-saw ; : fell do-saw ; : chop do-smash ; : smash do-smash ; : axe do-smash ; : wear do-wear ; : connect do-connect ; : insert do-push ; : push do-push ; : sharpen do-file ; : file do-file ; : kill do-kill ; : stab do-kill ; : knife do-kill ; : invent do-list ; : objects do-list ; : inventory do-list ; : list do-list ; \ attribute1 object attr2 # name d" wrist" d" watch" moves 0 OBJECT: watch d" magenta, firebreathing" d" dragon" stays 1 OBJECT: dragon d" mobile electricity" d" generator" moves 2 OBJECT: generator d" Canadian Redwood" d" tree" stays 3 OBJECT: tree d" granite" d" slab" moves 4 OBJECT: slab d" thick wooden" d" door" stays 5 OBJECT: door d" electric" d" saw" moves 6 OBJECT: saw d" purple" d" mirror" moves 7 OBJECT: mirror d" green" d" reflector" moves 8 OBJECT: reflector d" 10 pence" d" coin" moves 9 OBJECT: coin d" butter" d" knife" moves 10 OBJECT: knife d" razor sharp" d" dagger" moves 11 OBJECT: dagger d" safety" d" helmet" moves 12 OBJECT: helmet d" sharp" d" axe" moves 13 OBJECT: axe FORTH DEFINITIONS : EVAL-REST BEGIN >in @ #tib @ < WHILE bl word count SEARCH-WORDLIST 0<> IF execute ELSE #tib @ >in ! DUNNO THEN REPEAT ;P : ADVENTURE PAGE initmap 2 TO level BEGIN -1 TO object cr ." COMMAND> " query eval-rest .room AGAIN ; CR BASE ! .ABOUT -adventur DEPRIVE (* End of File *)