@edit cmd-machine
1 99999 d
i
(
  The Machine
  Programmable Sex Machine
  [c] 1998-2001 Peter Torkelson under GPL
)
$def VERSION "0.7.0"
(
  0.7 10/09/01 - Added _program support.
                 Now uses wfcommand lib.
                 Support for wixxx filtering.
                 Debugging support added.
                 Firmware name support added.
                 Documentation, check that out! :]
                 Checks to see if the victim fell asleep.
                 *waitshutdown
                 *ifshutdown
                 restructured action engine a bit to make adding
                   commands esier
  0.6 9/08/99 - Added *queue and #queue and command-name translations
                 I have no clue what the above entry in the change log
                 means. -- Peter
  0.5 9/01/99 - Added *climax and *shutdown  
  0.4 8/26/98 - Added *random
  0.1 6/23/98 - Initial version started.

  Properties: NOTE: SEE #HELP DOCUMENTATION. IT IS MORE UP TO DATE.
 
  [ on player ]
  
  [ On room ]
 
  [ On Exit ]
  user: [str]                 - Current victim
  pid: [int]                  - pid of running program
  safeword: [bool]            - Did he safeword/abort?
  count: [int]                - count of uses
  log/[n]: [str]              - log of users

  [ On Exit or _program ]
  _startmsg: [str]            - Startup message
  _endmsg: [str]              - Shutdown message
  _escapemsg: [str]           - Shutdown message
  _resetmsg: [str]            - Shutdown message
  _safewordmsg: [str]         - Shutdown message
  _delay: [int]               - Default delay in seconds
  _duration: [int]            - Duration in seconds
  _levelduration#/[n]: [int]  - Seconds per level
  _[part]/actions#/[n]: [list] - Space delimited list of actions
  _[part]/[action]#/[n]: [str] - Text for this step

  Commands:

  machine #start             - God help you. :]
  machine #safeword          - Victim can abort
  machine #reset             - Other person can release victim this way
  machine #climax            - Notify the machine that you came
  machine #version           - Print out the machine version
)

( ----------------------------------------------------------------- $include )
$include $lib/wfcommand

( ----------------------------------------------------------------- VARS )
var cmd-option
var cmd-arg1
var cmd-arg2

var program_dbref
var debugging

var 1-action
var 1-step

var 2-action
var 2-step

var 3-action
var 3-step

var 4-action
var 4-step

var 5-action
var 5-step

var 6-action
var 6-step

var 7-action
var 7-step

var 8-action
var 8-step

var 9-action
var 9-step

var thread-names

var start-time
var stage-text
var shutdown

var duration
var delay

var my-location

var level

( ----------------------------------------------------------------- UTIL )
: tell-me me @ swap notify ;

: tell-room
    me @ name "%name" subst 
    me @ swap pronoun_sub strip
    my-location @ swap #-1 swap notify_except
;

: prop-tell-room ( d s -- )
    getprop
    dup if
        tell-room
    else
        pop
    then
;

: npop ( x1 .. xn n -- )
    dup
    if
        swap pop
        1 -
        npop
    else
        pop
    then
;


( ----------------------------------------------------------------- Funcs )
: keep-going? (run for one minute for testing)
    trigger @ "safeword" getprop
    if
        0 exit
    then

    me @ location my-location @ dbcmp not
    me @ awake? not or
    if
        0 exit
    then

    shutdown @
    if
        1-step @ 2 <
        2-step @ 2 < and
        3-step @ 2 < and
        4-step @ 2 < and
        5-step @ 2 < and
        6-step @ 2 < and
        7-step @ 2 < and
        8-step @ 2 < and
        9-step @ 2 < and
        if
            0 exit
        then
    else 
        systime start-time @ - duration @ > 
        if
            1 shutdown !
        then
    then

    1
;

var st-action
var st-stage
var st-name

: get-stage-prop
    program_dbref @

    "_actions/"
    st-action @ strcat 
    "#/" strcat
    st-stage @ intostr strcat 

    getprop
;

(
 This realy ugly peice of code picks the action by exploding the
 list of them, picking one, and deleting the rest off the stack.
)
: set-random-stage ( s -- )
    " " explode
    dup random swap %
    2 + pick
    st-action !
    npop
    1 st-stage !
; 

(
 This chooses a new stage to run
)
: reset-stage-branch

    ( if this is a branch out thread, follow it )
    st-action @ 1 strcut swap "*" strcmp 0 =
    if
        debugging @
        if
        ">> Following Branch: " st-name @ strcat ":" strcat st-action @ strcat
            tell-me
        then

        "_threads/" st-name @ strcat "-" strcat swap strcat
        program_dbref @ swap getprop
        set-random-stage

        ( recurse in case there is more than one branch )
        reset-stage-branch
    else
        pop
    then
;

: in-wixxx? ( s -- i )
    ( get their wixxx )
    me @ "_prefs/whatis/flags" getpropstr
    ( pad with spaces on either side )
    " " swap strcat " " strcat
    ( add the machine wixxx and pad the end again )
    me @ "_prefs/machine/wixxx" getpropstr strcat
    " " strcat
    ( pad search string the same way )
    swap " " swap strcat " " strcat
    ( see if it is in the string )
    instr

    ( make bool )
    not not
;

: stage-wixxx-ok? ( -- i )
    program_dbref @
    "_actions/" st-action @ strcat "#/wixxx" strcat 
    getpropstr
    dup
    if
        " " explode
        BEGIN
            dup
            WHILE

            debugging @
            if
                over ">> Checking for " swap strcat 
                " in wixxx for action " strcat 
                st-name @ strcat ":" strcat st-action @ strcat tell-me
            then

            1 - swap

            in-wixxx?
            if
                npop
                1 exit
            then
        REPEAT

        pop

        0 exit
    else
        ( not wixxx restricted )
        pop
    then

    1
;

: reset-stage  ( -- )
    ( start with the base thread )
    program_dbref @ "_threads/" st-name @ strcat getprop
    set-random-stage

    reset-stage-branch

    stage-wixxx-ok? not
    if
        ( find something else )
        reset-stage
    then

    get-stage-prop not
    if
        debugging @
        if
        ">> ERROR: Action " st-action @ strcat " is broken." strcat tell-me
        then
        reset-stage
    then
;

: stage-command-parse ( -- cmd arg )
    get-stage-prop "*" 1 strncmp 0 = not
    if
        "" "" exit
    then
   
    get-stage-prop " " instr
    dup not
    if
        pop get-stage-prop ""
        exit
    then 

    get-stage-prop swap strcut
    swap strip swap strip
;

var st-command
var st-args

(
 Actualy run a stage.
)
: run-stage ( action stage name ) 
    st-name !
    st-stage !
    st-action !

    ( thread not in use? ) 
    st-name @ not
    if
        0 0 exit
    then

    ( thread not running, restart it if we are not shutting down )
    ( don't check if the prop has run out if the stage is not started. )
    st-stage @ not ( not started )
    if 
        1
    else
        get-stage-prop not ( has ended )
    then
    if
        shutdown @ not
        if
            reset-stage
            debugging @
            if
            ">> Starting Action " st-name @ strcat ":" strcat st-action @ strcat
                tell-me
            then
        else
            "" 0 exit
        then
    then

    ( parse to see if this is a command )
    stage-command-parse st-args ! st-command !

    st-command @
    debugging @ and
    if
        ">> Command in " st-name @ strcat ":" strcat st-action @ strcat
          " : " strcat st-command @ strcat " args: " strcat st-args @ strcat 
          tell-me
    then

    ( run a command )
    st-command @ "*climax" strcmp 0 =
    if
        trigger @ "climax" getprop
        if
            st-args @ set-random-stage
            st-action @ st-stage @ st-name @ run-stage
        else
            st-action @ st-stage @ 1 + st-name @ run-stage
        then
        exit
    then

    st-command @ "*random" strcmp 0 =
    if
        st-args @ set-random-stage
        st-action @ st-stage @ st-name @ run-stage

        exit 
    then

    st-command @ "*ifshutdown" strcmp 0 =
    if
        shutdown @
        if
            ( if in shutdown, do random jump )
            st-args @ set-random-stage
            st-action @ st-stage @ st-name @ run-stage
        else
            ( skip this statement )
            st-action @ st-stage @ 1 + st-name @ run-stage
        then
        exit 
    then

    st-command @ "*shutdown" strcmp 0 =
    if
        1 shutdown !
        st-action @ st-stage @ 1 + st-name @ run-stage
        exit 
    then

    st-command @ "*waitshutdown" strcmp 0 =
    if
        shutdown @
        if
            ( ok, time to shutdown, advance this stage )
            st-action @ st-stage @ 1 + st-name @ run-stage
        else
            ( just return until we are in shutdown )
            st-action @ st-stage @
            exit
        then    
    then

    ( if not a pause, add the output )
    st-command @ "*" stringcmp 0 = not
    if
        stage-text @ 
        debugging @
        if
            "[" strcat st-name @ strcat ":" strcat st-action @ strcat
            ":" strcat st-stage @ intostr strcat "] " strcat
        then
        get-stage-prop strcat " " strcat stage-text !
    then

    st-stage @ 1 + st-stage ! ( next stage )

    st-action @
    st-stage @
;

: thread-name ( i -- s )
    thread-names @ " " explode
    dup 2 + rotate ( get the thread # on top )
    over over <
    if
        pop npop
        ""
        exit
    then
    1 + pick
    over 2 + -1 * rotate
    npop
;

: init-threads ( s -- )
    ""       1-action !
    0        1-step !
    ""       2-action !
    0        2-step !
    ""       3-action !
    0        3-step !
    ""       4-action !
    0        4-step !
    ""       5-action !
    0        5-step !
    ""       6-action !
    0        6-step !
    ""       7-action !
    0        7-step !
    ""       8-action !
    0        8-step !
    ""       9-action !
    0        9-step !
;

( ----------------------------------------------------------------- COMMANDS )
: do-help
    prog cmd-arg1 @ lib-help
;

: do-start
    (
    One at a time :]
    )
    trigger @ "pid" getprop
    ispid?
    if
        ">> The machine is already in operation. It must finish first." tell-me
        exit
    then

    trigger @ "pid" pid setprop

    (
    Debugging?
    )
    trigger @ "d" flag?
    if
        ">> Debugging enabled." tell-me
        1
    else
        0
    then
    debugging !

    (
    )
    ">> To abort: machine #safeword" tell-me
    ">> To tell the machine if you climax: machine #climax" tell-me
    
    (
    Save the location
    )
    me @ location my-location !

    (
    )
    trigger @ "safeword" 0 setprop
    trigger @ "climax" 0 setprop

    (
    Counter and Log
    )
    trigger @ "count" getprop
    atoi 1 + intostr
    dup trigger @ swap "count" swap setprop
    trigger @ swap "log/" swap strcat me @ name setprop

    (
    Record the name so we can use it on the desc
    )
    trigger @ "user" me @ name setprop

    (
    )
    1 level !
     
    (
    Initial pause
    )
    program_dbref @ "_delay" getprop atoi
    dup
    if
        delay !
    else
        pop    
    then

    program_dbref @ "_duration" getprop atoi
    dup
    if
        duration !
    else
        pop
    then

    systime start-time !
    0 shutdown !
    background

    program_dbref @ "_threads-" me @ "sex" getprop strcat getprop 
    dup not
    if
        "> I do not understand your gender!" tell-me
        pop
        exit
    then
    strip thread-names ! 

    init-threads
 
    (
    Startup Message
    )
    program_dbref @ "_startmsg" prop-tell-room
    
    delay @ sleep

    BEGIN
        keep-going?
        WHILE
 
        "" stage-text !
 
        1-action @ 1-step @ 1 thread-name run-stage 1-step ! 1-action !
        2-action @ 2-step @ 2 thread-name run-stage 2-step ! 2-action !
        3-action @ 3-step @ 3 thread-name run-stage 3-step ! 3-action !
        4-action @ 4-step @ 4 thread-name run-stage 4-step ! 4-action !
        5-action @ 5-step @ 5 thread-name run-stage 5-step ! 5-action !
        6-action @ 6-step @ 6 thread-name run-stage 6-step ! 6-action !
        7-action @ 7-step @ 7 thread-name run-stage 7-step ! 7-action !
        8-action @ 8-step @ 8 thread-name run-stage 8-step ! 8-action !
        9-action @ 9-step @ 9 thread-name run-stage 9-step ! 9-action !

        stage-text @ tell-room

        delay @ sleep
    REPEAT

    me @ location my-location @ dbcmp not
    me @ awake? not
    or
    if
        program_dbref @ "_escapemsg" prop-tell-room
    else
        trigger @ "safeword" getprop 
        if
            program_dbref @ "_safewordmsg" prop-tell-room
        else 
            program_dbref @ "_endmsg" prop-tell-room
        then
    then

    trigger @ "user" remove_prop
;

: do-climax
    "> Machine notified of your climax." tell-me
    trigger @ "climax" 1 setprop
;

: do-safeword
    "> Initiating emergency shutdown." tell-me
    trigger @ "safeword" 1 setprop
;

: do-version
    "> Machine MUF Version: " VERSION strcat " by WhiteFire" strcat tell-me
    "> Firmware Name: " program_dbref @ "_firmware/name" getpropstr strcat tell-me
    "> Firmware Version: " program_dbref @ "_firmware/version" getpropstr strcat
        tell-me
    "> Firmware Notes: " program_dbref @ "_firmware/notes" getpropstr strcat
        tell-me
;

: do-reset
    do-safeword
;


( ----------------------------------------------------------------- MAIN )

: main

    lib-command-parse ( #s1 s2=s4 )
    cmd-arg2 ! cmd-arg1 ! cmd-option !

    (
    Find the program
    )
    trigger @ "_program" getprop
    dup ok?
    if
        program_dbref !
    else
        pop
        trigger @ program_dbref !
    then

    (
    Defaults
    )
    60 duration !
    15 delay !

    cmd-option @ not
    cmd-arg1 and
    if
        cmd-arg1 @ cmd-option !
        0 cmd-arg1 !
    then
    (
    If no args, complain
    )
    cmd-option @ not
    if
        "> See machine #help for usage." tell-me
        exit
    then

    (
    Call apropriate command
    )
    cmd-option @ "version"        stringcmp 0 = if do-version exit then
    cmd-option @ "start"          stringcmp 0 = if do-start exit then
    cmd-option @ "cum"            stringcmp 0 = if do-climax exit then
    cmd-option @ "climax"         stringcmp 0 = if do-climax exit then
    cmd-option @ "safeword"       stringcmp 0 = if do-safeword exit then
    cmd-option @ "reset"          stringcmp 0 = if do-safeword exit then
    cmd-option @ "stop"           stringcmp 0 = if do-safeword exit then
    cmd-option @ "abort"          stringcmp 0 = if do-safeword exit then
    cmd-option @ "help"           stringcmp 0 = if do-help exit then

    "> \"#" cmd-option @ strcat 
        "\" is an unknown command. Try \"machine #help\" for help." strcat 
        tell-me
;

.
c
q