mirror of
https://github.com/PDP-10/its.git
synced 2026-02-27 01:09:49 +00:00
The Logo Adventure game written by Don Hopkins
a2deh directory added for the Logo Adventure Game
This commit is contained in:
Alexey-Slyusar
4
Makefile
4
Makefile
@@ -26,8 +26,8 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \
|
||||
draw wl taa tj6 budd sharem ucode rvb kldcp math as imsrc gls demo \
|
||||
macsym lmcons dmcg hack hibou agb gt40 rug maeda ms kle aap common \
|
||||
fonts zork 11logo kmp info aplogo bkph bbn pdp11 chsncp sca music1 \
|
||||
moon teach ken lmio1 llogo chsgtv clib sys3 lmio turnip mits_s rab \
|
||||
stan_k bs cstacy
|
||||
moon teach ken lmio1 llogo a2deh chsgtv clib sys3 lmio turnip \
|
||||
mits_s rab stan_k bs cstacy
|
||||
DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
|
||||
chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
|
||||
xfont maxout ucode moon acount alan channa fonts games graphs humor \
|
||||
|
||||
348
src/a2deh/adv.logo
Normal file
348
src/a2deh/adv.logo
Normal file
@@ -0,0 +1,348 @@
|
||||
;;; Don Hopkins's Adventure game
|
||||
;;; adapted for PDP-10 ITS LISP LOGO
|
||||
;;; by Alexey Slyusar
|
||||
;;; to load code, type in LLOGO prompt:
|
||||
;;; ?READFILE ADV LOGO DSK A2DEH
|
||||
|
||||
;;; ver 0.15
|
||||
;; Overall orchestration and init the world procedures
|
||||
|
||||
TO ADVENTURE
|
||||
01 CURSORPOS 'C
|
||||
05 CR
|
||||
10 PR [$ WELCOME TO LOGO ADVENTURE $] ;the $$ characters at the beginning and
|
||||
15 CR ;at the end of lists are needed to
|
||||
20 PR [$ WRITTEN BY DON HOPKINS $] ;prevent the interpreter from unwanted
|
||||
30 PR [$ ADAPTED FOR PDP-10 ITS LLOGO$] ;evaluating atoms inside the list.
|
||||
35 PR [$ BY ALEXEY SLYUSAR $] ;e.g. LISP LOGO evaluates PR [YOU'LL BE GLAD]
|
||||
40 PR [$ TYPE HELP FOR HELP $] ;as YOU (QUOTE LL) BE GLAD, and treat [FOO. BAR]
|
||||
50 CR ;as dotted pair, etc.
|
||||
60 INIT ;So such syntax as PR [$YOU'LL$ BE GLAD]
|
||||
70 LOOK ;is used to get YOU'LL BE GLAD printed properly.
|
||||
END
|
||||
|
||||
TO INIT
|
||||
10 MAKE "ITEMS" [[1 0 SWORD] [1 0 HATCHET] [1 0 SHIELD] [2 100 GOLD] [2 100 DIAMOND] [2 50 AMULET] [3 0 SCREWDRIVER] [4 0 MACHINE] [0 100 WAND] [5 200 CROWN]]
|
||||
20 MAKE "RMOVES" [[0 2 3 0] [0 0 4 1] [1 4 0 0] [2 0 0 3] [0 0 0 0]]
|
||||
30 MAKE "RNAMES" [[YOU ARE IN THE WEAPON $SHOP.$] [THIS IS THE $VAULT.$] [THIS ROOM IS THE $TOOLSHED.$] [THIS IS THE ALTAR $ROOM.$] [YOU ARE IN A SECRET INCANTING $ROOM.$]]
|
||||
40 MAKE "RNUM" 1
|
||||
; INITITEMS :ITEMS 1 ; instead of using the inititems procedure, the auxiliary procedures for creating items declared explicitly.
|
||||
END
|
||||
|
||||
;; Actions
|
||||
|
||||
TO LOOK
|
||||
10 PR ITEM :RNUM :RNAMES
|
||||
20 PITEMS :RNUM
|
||||
30 CMD
|
||||
END
|
||||
|
||||
ERASE PRIMITIVE GET ;temporary erasing built-in LISP LOGO GET primitive to resolve the name conflict issue.
|
||||
TO GET :ITEM
|
||||
10 TEST EQUAL :ITEM "EVERYTHING"
|
||||
20 IFT GETALLITEMS :ITEMS
|
||||
30 IF IHAVE? :ITEM PR (SE [YOU ALREADY HAVE] PERIOD :ITEM) CMD STOP
|
||||
40 IF NOT HERE? :ITEM SEENO :ITEM STOP
|
||||
50 PUTITEM :ITEM (- 1 )
|
||||
60 PR SE :ITEM "$TAKEN.$"
|
||||
70 CMD
|
||||
END
|
||||
|
||||
TO GETALL
|
||||
10 GETALLITEMS :ITEMS
|
||||
END
|
||||
|
||||
TO GETALLITEMS :I
|
||||
10 IF :I = [] CMD STOP
|
||||
20 TEST :RNUM = ITEMLOC LAST FIRST :I
|
||||
30 IFT PUTITEM LAST FIRST :I (- 1)
|
||||
40 IFT PR SE LAST FIRST :I "$TAKEN.$"
|
||||
50 GETALLITEMS BF :I
|
||||
END
|
||||
|
||||
TO TAKE :THING
|
||||
10 GET :THING
|
||||
END
|
||||
|
||||
TO DROPALL
|
||||
10 DROPALLITEMS :ITEMS
|
||||
END
|
||||
|
||||
TO DROP :ITEM
|
||||
10 TEST EQUAL :ITEM "EVERYTHING"
|
||||
20 IFT DROPALLITEMS :ITEMS STOP
|
||||
30 IF NOT IHAVE? :ITEM PR SE [$YOU'RE$ NOT CARYING THE] WORD :ITEM "$!$" CMD STOP
|
||||
40 PUTITEM :ITEM :RNUM PR SE :ITEM "$DROPPED.$"
|
||||
50 CMD
|
||||
END
|
||||
|
||||
TO DROPALLITEMS :I
|
||||
10 IF EQUAL :I NIL CMD STOP
|
||||
20 TEST EQUAL (ITEMLOC LAST FIRST :I) ( - 1 )
|
||||
30 IFT PUTITEM LAST FIRST :I :RNUM
|
||||
40 IFT PR SE LAST FIRST :I "$DROPPED.$"
|
||||
50 DROPALLITEMS BF :I
|
||||
END
|
||||
|
||||
; Movements
|
||||
|
||||
TO N
|
||||
10 MOVEDIR 1
|
||||
END
|
||||
|
||||
TO E
|
||||
10 MOVEDIR 2
|
||||
END
|
||||
|
||||
ERASE ABBREVIATION S ;temporary erasing built-in LISP LOGO S abbreviation to resolve the name conflict issue.
|
||||
TO S
|
||||
10 MOVEDIR 3
|
||||
END
|
||||
|
||||
TO W
|
||||
10 MOVEDIR 4
|
||||
END
|
||||
|
||||
TO MOVEDIR :DIR
|
||||
10 MAKE "TRYMOVE" ITEM :DIR ITEM :RNUM :RMOVES
|
||||
20 TEST :TRYMOVE = 0
|
||||
30 IFT PR [$YOU CAN'T GO THAT WAY.$]
|
||||
40 IFT CMD STOP
|
||||
50 PR "$OK.$"
|
||||
60 MAKE "RNUM" :TRYMOVE
|
||||
70 LOOK
|
||||
END
|
||||
|
||||
; Special actions
|
||||
|
||||
TO WAVE :ITEM
|
||||
10 IF NOT IHAVE? :ITEM PR (SE [YOU ARE HOLDING NO] PERIOD :ITEM) CMD STOP
|
||||
20 IF NOT :ITEM = "WAND" NOTHING
|
||||
30 IF AND NOT :RNUM = 4 NOT :RNUM = 5 PR [NOTHING $HAPPENS.$] CMD STOP
|
||||
40 PR [$POOF! THE SCENE CHANGES!$]
|
||||
50 IF :RNUM = 4 MAKE "RNUM" 5 ELSE MAKE "RNUM" 4
|
||||
60 LOOK
|
||||
END
|
||||
|
||||
ERASE PRIMITIVE FIX ;temporary erasing built-in LISP LOGO FIX primitive to resolve the name conflict issue.
|
||||
TO FIX :ITEM
|
||||
10 IF IHAVE? :ITEM PR [YOU HAVE TO DROP IT TO FIX $IT!$] CMD STOP
|
||||
20 IF NOT HERE? :ITEM SEENO :ITEM STOP
|
||||
30 IF NOT :ITEM = "MACHINE" PR [$YOU CAN'T FIX THAT!$] CMD STOP
|
||||
40 IF NOT ITEMLOC "WAND" = 0 PR [THE MACHINE IS NOT $BROKEN!$] CMD STOP
|
||||
50 IF NOT IHAVE? "SCREWDRIVER" PR [$YOU DON'T HAVE THE APPROPRIATE TOOLS TO$] PR [FIX IT] CMD STOP
|
||||
60 PR [YOU FIX THE MACHINE WITH YOUR TRUSTY]
|
||||
70 PR [$SCREWDRIVER.$ UPON BEING $FIXED,$ THE]
|
||||
80 PR [MACHINE STARTS UP AND PRODUCES A $WAND!$]
|
||||
90 PUTITEM "WAND" 4
|
||||
100 CMD
|
||||
END
|
||||
|
||||
ERASE PRIMITIVE EXAMINE ;temporary erasing built-in LISP LOGO EXAMINE primitive to resolve the name conflict issue.
|
||||
TO EXAMINE :ITEM
|
||||
10 IF NOT HERE? :ITEM PR (SE [I SEE NO] :ITEM [$HERE!$]) CMD STOP
|
||||
20 IF :ITEM = "WAND" PR [IT BEARS A FADED $INSCRIPTION:$] PR [$"??VE ME AND YOU'LL BE GLAD."$] CMD STOP
|
||||
30 IF NOT :ITEM = "MACHINE" PR (SE [I SEE NOTHING SPECIAL ABOUT THE] PERIOD :ITEM) CMD STOP
|
||||
40 IF NOT 0 = ITEMLOC "WAND" PR [IT SEEMS TO BEAR THE MARKS OF A HASTY] PR [REPAIR $JOB.$] CMD STOP
|
||||
50 PR [IT IS $BROKEN!$ YOU COULD FIX IT WITH]
|
||||
60 PR [THE RIGHT $TOOL.$]
|
||||
70 CMD
|
||||
END
|
||||
|
||||
;; Items inventory, cmd, help, score procedures section
|
||||
|
||||
TO PITEMS :LOC
|
||||
10 PITEMS2 :LOC :ITEMS
|
||||
END
|
||||
|
||||
TO PITEMS2 :LOC :I
|
||||
10 IF :I = [] STOP
|
||||
20 IF FIRST FIRST :I = :LOC PRINT LAST FIRST :I
|
||||
30 PITEMS2 :LOC BF :I
|
||||
END
|
||||
|
||||
TO CMD
|
||||
10 CR
|
||||
20 TYPE "COMMAND"
|
||||
; toplevel isn't a command in LLOGO but rather an operation
|
||||
; and returns value. So we cannot use it as originally intended,
|
||||
; so we should use STOP after each CMD invocation to interrupt
|
||||
; evaluation process.
|
||||
;30 TOPLEVEL
|
||||
END
|
||||
|
||||
TO GAME
|
||||
10 OP "ADVSAVE"
|
||||
END
|
||||
|
||||
TO ITEMLOC2 :ITEM :I
|
||||
10 IF :I = [] OP 0
|
||||
20 IF LAST FIRST :I = :ITEM OP FIRST FIRST :I
|
||||
30 OP ITEMLOC2 :ITEM BF :I
|
||||
END
|
||||
|
||||
TO PUTITEM :ITEM :LOC
|
||||
10 MAKE "ITEMS" PUTITEM2 :ITEM :LOC :ITEMS
|
||||
END
|
||||
|
||||
TO PUTITEM2 :ITEM :LOC :LIST
|
||||
10 IF :LIST = [] OP []
|
||||
20 IF LAST FIRST :LIST = :ITEM OP FPUT FPUT :LOC BF FIRST :LIST BF :LIST
|
||||
30 OP FPUT FIRST :LIST PUTITEM2 :ITEM :LOC BF :LIST
|
||||
END
|
||||
|
||||
TO SETIT :THING
|
||||
10 MAKE "IT" :THING
|
||||
20 OP :THING
|
||||
END
|
||||
|
||||
TO SEENO :I
|
||||
10 PR SE [I SEE NO] SE :I "HERE"
|
||||
20 CMD
|
||||
END
|
||||
|
||||
TO EVERYTHING
|
||||
10 OP "EVERYTHING"
|
||||
END
|
||||
|
||||
TO IHAVE? :ITEM
|
||||
10 OP EQUAL (- 1) ITEMLOC :ITEM
|
||||
END
|
||||
|
||||
TO ITEMLOC :ITEM
|
||||
10 OP ITEMLOC2 :ITEM :ITEMS
|
||||
END
|
||||
|
||||
TO PERIOD :WORD
|
||||
10 OP WORD :WORD "$.$"
|
||||
END
|
||||
|
||||
TO IT
|
||||
10 OP :IT
|
||||
END
|
||||
|
||||
TO HERE? :ITEM
|
||||
10 LOCAL "LOC"
|
||||
20 MAKE "LOC" ITEMLOC :ITEM
|
||||
30 OP OR (- 1) = :LOC :RNUM = :LOC
|
||||
END
|
||||
|
||||
TO INVENT
|
||||
10 PITEMS (- 1)
|
||||
20 CMD
|
||||
END
|
||||
|
||||
TO HELP
|
||||
01 CURSORPOS 'C
|
||||
10 CR
|
||||
100 PR [TO $MOVE,$ TYPE]
|
||||
110 PR [$N, E, S, W,$]
|
||||
120 PR [$FOR NORTH, SOUTH, EAST, WEST$]
|
||||
130 CR
|
||||
140 PR [TYPE LOOK TO SEE WHAT ROOM YOU]
|
||||
150 PR [$ARE IN.$ YOU CAN GET AND DROP $ITEMS.$]
|
||||
160 PR [INVENT SHOWS YOUR $INVENTORY.$]
|
||||
170 PR [THE WORD $"IT"$ MEANS THE LAST THING YOU]
|
||||
180 PR [REFERRED $TO.$]
|
||||
190 CR
|
||||
200 PR [THERE ARE SOME SPECIAL THINGS YOU CAN]
|
||||
210 PR [$DO,$ LIKE SAYING EXAMINE $SOMETHING.$]
|
||||
220 CR
|
||||
230 PR [TYPE SCORE TO SEE YOUR $SCORE,$ AND]
|
||||
240 PR [DONE TO $QUIT.$]
|
||||
250 PR [$GOOD LUCK!$]
|
||||
255 CR
|
||||
260 CMD
|
||||
END
|
||||
|
||||
|
||||
TO SCORE
|
||||
10 PR SE [YOUR SCORE IS] SCORE2 :ITEMS [$POINTS.$]
|
||||
20 CMD
|
||||
END
|
||||
|
||||
TO NOTHING
|
||||
10 PR [NOTHING $HAPPENS.$]
|
||||
20 CMD
|
||||
END
|
||||
|
||||
TO DONE
|
||||
10 IF NOT :RNUM = 5 NOTHING STOP CMD
|
||||
20 MAKE "SCORE" SCORE2 :ITEMS
|
||||
30 IF :SCORE = 0 NOTHING STOP CMD
|
||||
40 PR SE [YOUR SCORE IS] :SCORE
|
||||
50 IF :SCORE = 550 PR [$PERFECT!$] ELSE PRINT [$THERE'S MORE TREASURE, THOUGH.$]
|
||||
60 DONE
|
||||
END
|
||||
|
||||
TO SCORE2 :LIST
|
||||
10 IF :LIST = [] OP 0
|
||||
20 IF NOT FIRST FIRST :LIST = (- 1) OP SCORE2 BF :LIST
|
||||
30 OP SUM ITEM 2 FIRST :LIST SCORE2 BF :LIST
|
||||
END
|
||||
|
||||
|
||||
;MAKE "STARTUP" [ADVENTURE]
|
||||
|
||||
;;; auxiliary procedures declared explicitly.
|
||||
|
||||
to amulet
|
||||
10 OP SETIT "AMULET"
|
||||
end
|
||||
|
||||
to crown
|
||||
10 OP SETIT "CROWN"
|
||||
end
|
||||
|
||||
to diamond
|
||||
10 OP SETIT "DIAMOND"
|
||||
end
|
||||
|
||||
to gold
|
||||
10 OP SETIT "GOLD"
|
||||
end
|
||||
|
||||
to hatchet
|
||||
10 OP SETIT "HATCHET"
|
||||
end
|
||||
|
||||
to machine
|
||||
10 OP SETIT "MACHINE"
|
||||
end
|
||||
|
||||
to screwdriver
|
||||
10 OP SETIT "SCREWDRIVER"
|
||||
end
|
||||
|
||||
to shield
|
||||
10 OP SETIT "SHIELD"
|
||||
end
|
||||
|
||||
to sword
|
||||
10 OP SETIT "SWORD"
|
||||
end
|
||||
|
||||
to wand
|
||||
10 OP SETIT "WAND"
|
||||
end
|
||||
|
||||
;; Terrapin C64 Logo primitives emulation
|
||||
|
||||
to item :i :l
|
||||
10 if :i = 1 op first :l
|
||||
20 output item (:i - 1) butfirst :l
|
||||
end
|
||||
|
||||
|
||||
;; Original Don Hopkins's inititems procedure
|
||||
|
||||
;TO INITITEMS :I :F
|
||||
; IF :I = [] STOP
|
||||
; TEST :F = 1
|
||||
; IFT DEFINE LAST FIRST :I LPUT LPUT WORD "" LAST FIRST :I [OP SETIT] [[]]
|
||||
; IFF DEFINE LAST FIRST :I []
|
||||
; INITITEMS BF :I :F
|
||||
;END
|
||||
|
||||
ADVENTURE
|
||||
|
||||
Reference in New Issue
Block a user