@prog sesame
1 99999 d
1 i
( Filter: Sesame filter.
          Listens for a phrase and sets a property to the current systime.
          [Hope to do moveto, call and lock sometime.]
  Lock:   Sesame lock
          Checks for a valid phrase and time on the player.
`
 sayfilter here timer property-suffix timeout-secs phrase -- Set timed phrase
 sayfilter succ You hear a click as you speak.            -- Set succ type mess
 sayfilter osucc hears a click as %s speaks.              -- Set osucc type mess
 sayfilter here clear                                     -- Clear settings
`
 The reason you are asked to provide a property name is to allow you to stack
 sesames, and also to prevent other builders' sesames clashing. It is recommend
 you use a propname like cavern_10293, for a lock which leads from room #10293
 to a cavern.
`
)
$define abs dup 0 < if 0 swap - then $enddef
: add-item ( n db ch message keyword -- n "Done." "" 1 )
  pop
( n db ch timeout_prop_phrase_thing )
  "_say/ch/n/" 5 pick intostr "n" subst rot "ch" subst swap
( n db "_say/ch/n/" timeout_prop_phrase_thing )
  dup " " instr dup not if
( n db "_say/ch/n/" timeout_prop_phrase_thing i )
    pop pop pop pop
( n )
    "** sayfilter here sesame <timeout-secs> <property> <phrase> **" "" 1 exit
  then
( n db "_say/ch/n/" timeout_prop_phrase_thing i )
  1 - strcut 1 strcut swap pop swap
( n db "_say/ch/n/" prop_phrase_thing timeout )
  4 pick 4 pick "timeout" strcat rot 0 addprop
( n db "_say/ch/n/" prop_phrase_thing )
  dup " " instr dup not if
( n db "_say/ch/n/" prop_phrase_thing 0 )
    pop pop pop pop
( n )
    "** sayfilter here sesame <timeout-secs> <property> <phrase> **" "" 1 exit
  then
( n db "_say/ch/n/" prop_phrase_thing 5 )
  1 - strcut 1 strcut swap pop swap
( n db "_say/ch/n/" phrase_thing prop )
  4 pick 4 pick "prop" strcat rot 0 addprop
( n db "_say/ch/n/" phrase_thing )
  swap "phrase" strcat swap 0 addprop
( n )
  "** Done **" "" 1
;
: set-osucc ( n db ch message keyword -- n "Done." "" 1 )
  pop
( n db ch osucc )
  "_say/ch/n/" 5 pick intostr "n" subst rot "ch" subst swap
( n db "_say/ch/n/" osucc )
  swap "osucc" strcat swap 0 addprop
( n )
  "** Done **" "" 1
;
: set-succ ( n db ch message keyword -- n "Done." "" 1 )
  pop
( n db ch succ )
  "_say/ch/n/" 5 pick intostr "n" subst rot "ch" subst swap
( n db "_say/ch/n/" succ )
  swap "succ" strcat swap 0 addprop
( n )
  "** Done **" "" 1
;
: take-item ( n db ch message keyword -- n "Done." "" 1 )
  pop pop
( n db ch )
  "_say/ch/n/" 4 pick intostr "n" subst swap "ch" subst
( n db "_say/ch/n/" )
  over over "phrase"  strcat remove_prop
  over over "timeout" strcat remove_prop
  over over "succ"    strcat remove_prop
  over over "osucc"   strcat remove_prop
            "prop"    strcat remove_prop
( n )
  "** Done **" "" 1
;
: check-lock ( -- 0/1 )  ( This scans all _say/here/n  +/prop and +/timeout )
  1 begin
( 1 )
    "_say/here/" over intostr strcat
( 1 "_say/here/1" )
    loc @ over propdir? while
( 1 "_say/here/1" [0/1] )
    dup "/prop" strcat loc @ swap getpropstr
( 1 "_say/here/1" [prop] )
    dup not if pop pop 1 + continue then
( 2 continue )
( 1 "_say/here/1" [prop] )
    "_say/sesame/" swap strcat me @ swap getpropstr atoi
( 1 "_say/here/1" metime )
    swap "/timeout" strcat loc @ swap getpropstr atoi
( 1 metime heretimedelta )
    dup not if pop pop 1 + continue then
( 2 continue )
( 1 metime heretimedelta )
    systime swap -
( 1 metime heretime )
    > if pop 1 exit then   ( Success )
( 1 exit-success )
( 1 )
    1 +
  repeat
( 1 "_say/here/1" [0/1] )
  pop pop 0 (Fail, I think.)
;
: sesame ( n db ch message -- n db ch message' 0/2 )
         ( -- 0/1 ) ( Forgotten which way round locks go.. :P )
    depth 1 = if check-lock exit then
( n db ch message )
    3 pick loc @ dbcmp not if
      3 pick owner me @ dbcmp if
        pop pop pop ">> Sesame is room-based only." "" 1 exit
      then
      0 exit
    then
    command @ "sayfilter" strcmp if
( n db ch message )
      "_say/ch/n/" 5 pick abs intostr "n" subst 3 pick "ch" subst
( n db ch message "_say/ch/n/" )
      dup "phrase" strcat
( n db ch message "_say/ch/n/" "_say/ch/n/phrase" )
      5 pick swap getpropstr dup if
( n db ch message "_say/ch/n/" [phrase] [[phrase]] )
        3 pick swap instring if
( n db ch message "_say/ch/n/" )
         5 pick 0 < if
           4 pick over "osucc" strcat getpropstr dup not if pop else
                me @ swap pronoun_sub
                loc @ me @ rot
                me @ name " " strcat swap strcat
                notify_except
            then
            4 pick over "succ" strcat getpropstr dup not if pop else
                me @ swap notify
            then
          then
          "prop" strcat 4 pick swap getpropstr "_say/sesame/" swap strcat
( n db ch message _say/sesame/prop )
          me @ swap systime intostr 0 addprop
( n db ch message )
          2 exit
        else pop then
( n db ch message )
      else pop pop then
( n db ch message )
      0
    else
( n db ch message )
      dup " " instr dup if 1 - strcut 1 strcut swap pop else pop "" then swap
( n db ch message command )
      dup "timer" strcmp not if add-item  exit then
      dup "clear" strcmp not if take-item exit then
      dup "osucc" strcmp not if set-osucc exit then
      dup "succ"  strcmp not if set-succ  exit then
( n db ch message command )
      swap dup if " " swap else dup then
( n db ch command_message 0 )
      strcat strcat 0
    then
;
164 lines displayed.
.
c
q
@register #me sesame=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=3
@propset $tmp/prog1=str:/_/de:A scroll containing a spell called sesame
@propset $tmp/prog1=str:/_help/1#:30
@propset $tmp/prog1=str:/_help/1#/1:-------------------------------------------------------------------------------
@propset $tmp/prog1=str:/_help/1#/10:  sayfilter here clear                           -- Clear settings
@propset $tmp/prog1=str:/_help/1#/11:  @lock exit = #99157  (or whatever sayfilter says sesame is)
@propset $tmp/prog1=str:/_help/1#/12:`
@propset $tmp/prog1=str:/_help/1#/13:eg: sayfilter here timer 10 please_10256 please
@propset $tmp/prog1=str:/_help/1#/14:    sayfilter here succ The librarian smiles, agreeing to allow you through.
@propset $tmp/prog1=str:/_help/1#/15:`
@propset $tmp/prog1=str:/_help/1#/16: <Secs> is time someone's saying the keyword takes to expire
@propset $tmp/prog1=str:/_help/1#/17: <prop> is the property-suffix which will be used to store the player's time.
@propset $tmp/prog1=str:/_help/1#/18: <phrase> is anything after the first two. Case sensitive.
@propset $tmp/prog1=str:/_help/1#/19:`
@propset $tmp/prog1=str:/_help/1#/2:One of the very few filters which only works as a room filter.
@propset $tmp/prog1=str:/_help/1#/20: You can stack these filters, and I might institute list-handling so you only
@propset $tmp/prog1=str:/_help/1#/21:  need one someday, along with program-calling and verbal movetos.
@propset $tmp/prog1=str:/_help/1#/22:`
@propset $tmp/prog1=str:/_help/1#/23: The reason you are asked to provide a property name is to allow you to stack
@propset $tmp/prog1=str:/_help/1#/24: sesames, and also to prevent other builders' sesames clashing. It is recommend
@propset $tmp/prog1=str:/_help/1#/25: you use a propname like cavern_10293, for a lock which leads from room #10293
@propset $tmp/prog1=str:/_help/1#/26: to a cavern.
@propset $tmp/prog1=str:/_help/1#/27:`
@propset $tmp/prog1=str:/_help/1#/28:Thanks for the idea, Cormad.
@propset $tmp/prog1=str:/_help/1#/29:`
@propset $tmp/prog1=str:/_help/1#/3:This locks an exit until someone says a key phrase, when they are allowed to
@propset $tmp/prog1=str:/_help/1#/30:    - Warwick, 3/July/94
@propset $tmp/prog1=str:/_help/1#/4: go through.
@propset $tmp/prog1=str:/_help/1#/5:`
@propset $tmp/prog1=str:/_help/1#/6:  sayfilter here fadd sesame                     -- Registers filter here
@propset $tmp/prog1=str:/_help/1#/7:  sayfilter here timer <secs> <prop> <phrase>    -- Sets lock-trigger
@propset $tmp/prog1=str:/_help/1#/8:  sayfilter succ You hear a click as you speak.  -- Set succ type mess
@propset $tmp/prog1=str:/_help/1#/9:  sayfilter osucc hears a click as %s speaks.    -- Set osucc type mess