Commit 2e73eb7d authored by Jesse McGrew's avatar Jesse McGrew
Browse files

Cleaned up PICK-ONE and PICK-ONE-R, and made them testable.

parent 425817d4b63f
......@@ -2750,25 +2750,32 @@ Args:
Returns:
A random element from the table."
<ROUTINE PICK-ONE (TABL "AUX" LENGTH CNT RND S MSG)
<SET LENGTH <GET .TABL 0>>
<SET CNT <GET .TABL 1>>
<REPEAT ()
<PUT ,TEMPTABLE .S <GET .TABL <+ .CNT .S>>>
<SET S <+ .S 1>>
;<PROG () <TELL "IN LOOP: S IS NOW: "> <PRINTN .S> <TELL CR>>
<COND (<G? <+ .S .CNT> .LENGTH> <RETURN>)>>
;<PROG () <TELL "S IS CURRENTLY: "> <PRINTN .S> <TELL CR>>
<SET RND <- <RANDOM .S> 1>>
;<PROG () <TELL "RND IS CURRENTLY: "> <PRINTN .RND> <TELL CR>>
<SET MSG <GET ,TEMPTABLE .RND>>
<PUT .TABL <+ .CNT .RND> <GET .TABL .CNT>>
<PUT .TABL .CNT .MSG>
<ROUTINE PICK-ONE (TABL "AUX" (LENGTH <GET .TABL 0>) (CNT <GET .TABL 1>) OCNT RND S MSG)
;"Choose a random table element between CNT and LENGTH"
<SET RND <RANDOM-IN-RANGE .CNT .LENGTH>>
<SET MSG <GET .TABL .RND>>
;"Increase CNT"
<SET OCNT .CNT>
<SET CNT <+ 1 .CNT>>
<COND (<G? .CNT .LENGTH> <SET CNT 2>)>
;"If that finishes the table, reset and exit"
<COND (<G? .CNT .LENGTH>
<PUT .TABL 1 2>
<RETURN .MSG>)>
;"Otherwise, move the item we just picked below CNT"
<COND (<N=? .RND .OCNT>
<PUT .TABL .RND <GET .TABL .OCNT>>
<PUT .TABL .OCNT .MSG>)>
<PUT .TABL 1 .CNT>
<RETURN .MSG>>
<DEFAULT-DEFINITION RANDOM-IN-RANGE
<DEFMAC RANDOM-IN-RANGE ('LO 'HI)
<COND (<TYPE? .LO LVAL GVAL FIX FALSE CONSTANT>
<FORM - <FORM + .LO <FORM RANDOM <FORM + <FORM - .HI .LO> 1>>> 1>)
(ELSE
<FORM BIND ((?LO .LO))
<FORM - <FORM + '.?LO <FORM RANDOM <FORM + <FORM - .HI '.?LO> 1>>> 1>>)>>>
;"Returns a random element from a table, possibly repeating.
Args:
......@@ -2777,9 +2784,8 @@ Args:
Returns:
A random element from the table."
<ROUTINE PICK-ONE-R (TABL "AUX" MSG RND)
<SET RND <RANDOM <GET .TABL 0>>>
<SET MSG <GET .TABL .RND>>
<RETURN .MSG>>
<SET RND <RANDOM-IN-RANGE 1 <GET .TABL 0>>>
<GET .TABL .RND>>
;"The game can override this with SETG. It doesn't go through DARKNESS-F, since
it has to be a constant on V3."
......
<VERSION ZIP>
<GLOBAL RANDOM-IN-RANGE-IMPL <>>
<REPLACE-DEFINITION RANDOM-IN-RANGE
<DEFMAC RANDOM-IN-RANGE ("ARGS" A) <FORM APPLY ',RANDOM-IN-RANGE-IMPL !.A>>
<ROUTINE RIR-RETURN-LO (LO HI)
.LO>
<ROUTINE RIR-RETURN-HI (LO HI)
.HI>
>
<INSERT-FILE "testing">
<OBJECT STARTROOM
(IN ROOMS)
(DESC "Start Room")
(LDESC "Ldesc.")
(FLAGS LIGHTBIT)>
<OBJECT APPLE
(IN STARTROOM)
(DESC "apple")
(SYNONYM APPLE)
(ACTION APPLE-F)
(FLAGS TAKEBIT)>
<ROUTINE APPLE-F ()
<COND (<VERB? EXAMINE>
<PRINT <PICK-ONE ,APPLE-MESSAGES>>
<CRLF>)
(<VERB? TAKE>
<PRINT <PICK-ONE-R <REST ,APPLE-MESSAGES 2>> ;"pretend the 2 at the start of the table is a length word">
<CRLF>)>>
<CONSTANT APPLE-MESSAGES-INIT
<LTABLE
2
"You're not hungry."
"That's a mealy one."
"Bad season for apples."
"Not after last time."
"Come on.">>
<CONSTANT APPLE-MESSAGES-SIZE <+ 1 <ZGET ,APPLE-MESSAGES-INIT 0>>>
<CONSTANT APPLE-MESSAGES <ITABLE ,APPLE-MESSAGES-SIZE>>
<TEST-SETUP ()
<COPY-TABLE ,APPLE-MESSAGES-INIT ,APPLE-MESSAGES ,APPLE-MESSAGES-SIZE>
<MOVE ,WINNER ,STARTROOM>>
<TEST-CASE ("PICK-ONE from start of remaining items")
<SETG RANDOM-IN-RANGE-IMPL ,RIR-RETURN-LO>
;"picks each item in order, starting with the first"
<COMMAND [EXAMINE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "That's a mealy one.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Bad season for apples.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Not after last time.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Come on.|">
;"repeats the same as before:"
<COMMAND [EXAMINE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "That's a mealy one.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Bad season for apples.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Not after last time.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Come on.|">
>
<TEST-CASE ("PICK-ONE from end of remaining items")
<SETG RANDOM-IN-RANGE-IMPL ,RIR-RETURN-HI>
;"picks the last item, then each item in order starting with the first"
<COMMAND [EXAMINE APPLE]>
<EXPECT "Come on.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "That's a mealy one.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Bad season for apples.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Not after last time.|">
<COMMAND [EXAMINE APPLE]>
;"picks the last item again, then repeats in order"
<EXPECT "Not after last time.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Come on.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "That's a mealy one.|">
<COMMAND [EXAMINE APPLE]>
<EXPECT "Bad season for apples.|">
>
<TEST-CASE ("PICK-ONE-R from start of remaining items")
<SETG RANDOM-IN-RANGE-IMPL ,RIR-RETURN-LO>
;"always picks the first item"
<COMMAND [TAKE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [TAKE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [TAKE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [TAKE APPLE]>
<EXPECT "You're not hungry.|">
<COMMAND [TAKE APPLE]>
<EXPECT "You're not hungry.|">
>
<TEST-GO ,STARTROOM>
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment