@edit cmd-machine 1 99999 d i ( The Machine Programmable Sex Machine [c] 1998-2001 Peter Torkelson under GPL ) $def VERSION "0.8.0" ( 0.8.0 10/12/01 - Added better parts detection, and *ifpart. Added Queued event support and _machine_props. *ifwixxx *!if - negitive versions of all if commands. continued cleaning up the main action parsing engine, eliminated a lot of reduntant code, and again made it esier to add commands. made the main loop not pause if there is no output, this fixed a lot of odd double-delays that can happen in rare situations. Not terribly elegant a fix, but to do better would take a massive rewrite of a lot of the system. V2.0 ;] !wixxx flag support Interactive mode. #wixxx replaced _duration with _max_poses #speed support 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 _[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 ( ----------------------------------------------------------------- defs ) $define custom-body-prop "_prefs/machine/action-#" program_dbref @ intostr strcat "/custom-body" strcat $enddef ( ----------------------------------------------------------------- VARS ) ( command line stuff ) var cmd-option var cmd-arg1 var cmd-arg2 ( dbrefs of data sources ) var program_dbref var runtime_dbref ( flags ) var debugging var shutdown ( current stage data ) var st-action var st-stage var st-name ( breakdown of stage line, command, condition, and args ) var st-command var st-args var st-args-1 var st-args-other ( gathered stage text ) var stage-text ( lists ) var thread-names var body-parts ( overall run timing ) var start-time var pose-count var max-poses var delay var interactive ( misc ) var event_type var person_starting var my-location ( per-thread data store ) 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 ( ----------------------------------------------------------------- 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 ; ( ------------------------------------------------------ parts/wizz Funcs ) : inset? ( s s -- i ) ( pad set ) " " strcat " " swap strcat ( pad test string ) swap " " strcat " " swap strcat ( test ) instr ( make bool ) not not ; : in-wixxx? ( s -- i ) me @ "_prefs/whatis/flags" getpropstr strip " " strcat me @ "_prefs/machine/wixxx" getpropstr strcat inset? ; : in-parts? ( s -- i ) body-parts @ inset? ; : 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 ; : stage-bang-wixxx-ok? ( -- i ) me @ "_prefs/machine/wixxx" getpropstr dup if " " explode BEGIN dup WHILE 1 - swap 1 strcut swap "!" stringcmp 0 = if debugging @ if ">> Checking against !" over strcat " in wixxx for action " strcat st-name @ strcat ":" strcat st-action @ strcat tell-me then program_dbref @ "_actions/" st-action @ strcat "#/wixxx" strcat getpropstr " " strcat program_dbref @ "_actions/" st-action @ strcat "#/wixxx-other" strcat getpropstr strcat inset? if npop 0 exit then else pop then REPEAT pop else ( no custom wixxx ) pop then 1 ; : stage-parts-ok? ( -- i ) program_dbref @ "_actions/" st-action @ strcat "#/parts" strcat getpropstr dup if " " explode BEGIN dup WHILE debugging @ if over ">> Checking for " swap strcat " in body parts for action " strcat st-name @ strcat ":" strcat st-action @ strcat tell-me then 1 - swap in-parts? not if npop 0 exit then REPEAT pop else ( not parts restricted ) pop then 1 ; ( ----------------------------------------------------------------- Funcs ) : keep-going? (run for one minute for testing) runtime_dbref @ "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 @ > ) pose-count @ max-poses @ >= if 1 shutdown ! then then 1 ; : 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 ; : reset-stage ( -- ) ( start with the base thread ) program_dbref @ "_threads/" st-name @ strcat getprop set-random-stage reset-stage-branch stage-wixxx-ok? not stage-parts-ok? not stage-bang-wixxx-ok? not or or 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 arg1 argother ) 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 dup dup ":" instr dup not if pop pop "" "" exit else 1 - strcut 1 strcut swap pop strip swap strip swap then ; ( Actualy run a stage. ) ( commands set this to branch ) var st-branch ( commands set this to skip to the next line in an action. ) var st-skip ( commands set this if they want to output text. ) var st-text : stage-commands st-command @ "*random" strcmp 0 = if st-args @ st-branch ! exit then st-command @ "*ifwixxx" strcmp 0 = if 1 st-skip ! st-args-1 @ if st-args-1 @ in-wixxx? if st-args-other @ st-branch ! then then exit then st-command @ "*printifwixxx" strcmp 0 = if st-args-1 @ if st-args-1 @ in-wixxx? if st-args-other @ st-text ! exit then then 1 st-skip ! exit then st-command @ "*!printifwixxx" strcmp 0 = if st-args-1 @ if st-args-1 @ in-wixxx? not if st-args-other @ st-text ! exit then then 1 st-skip ! exit then st-command @ "*!ifwixxx" strcmp 0 = if 1 st-skip ! st-args-1 @ if st-args-1 @ in-wixxx? not if st-args-other @ st-branch ! then then exit then st-command @ "*ifpart" strcmp 0 = if 1 st-skip ! st-args-1 @ if st-args-1 @ in-parts? if st-args-other @ st-branch ! then then exit then st-command @ "*printifpart" strcmp 0 = if st-args-1 @ if st-args-1 @ in-parts? if st-args-other @ st-text ! exit then then 1 st-skip ! exit then st-command @ "*!printifpart" strcmp 0 = if st-args-1 @ if st-args-1 @ in-parts? not if st-args-other @ st-text ! exit then then 1 st-skip ! exit then st-command @ "*!ifpart" strcmp 0 = if 1 st-skip ! st-args-1 @ if st-args-1 @ in-parts? not if st-args-other @ st-branch ! then then exit then st-command @ "*climax" strcmp 0 = st-command @ "*ifclimax" strcmp 0 = or if runtime_dbref @ "climax" getprop if st-args @ st-branch ! else 1 st-skip ! then exit then st-command @ "*printifclimax" strcmp 0 = if runtime_dbref @ "climax" getprop if st-args @ st-text ! else 1 st-skip ! then exit then st-command @ "*!printifclimax" strcmp 0 = if runtime_dbref @ "climax" getprop not if st-args @ st-text ! else 1 st-skip ! then exit then st-command @ "*!ifclimax" strcmp 0 = if runtime_dbref @ "climax" getprop not if st-args @ st-branch ! else 1 st-skip ! then exit then st-command @ "*ifshutdown" strcmp 0 = if shutdown @ if st-args @ st-branch ! else 1 st-skip ! then exit then st-command @ "*!ifshutdown" strcmp 0 = if shutdown @ not if st-args @ st-branch ! else 1 st-skip ! then exit then st-command @ "*shutdown" strcmp 0 = if 1 shutdown ! 1 st-skip ! exit then ; : 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-other ! st-args-1 ! st-args ! st-command ! 0 st-skip ! "" st-branch ! get-stage-prop st-text ! st-command @ debugging @ and if ">> Command in " st-name @ strcat ":" strcat st-action @ strcat " : " strcat st-command @ strcat st-args-1 @ if " condition: " strcat st-args-1 @ strcat " args: " strcat st-args-other @ strcat else " args: " strcat st-args @ strcat then tell-me then ( run a command ) stage-commands ( these two commands need special handling ) st-command @ "*waitshutdown" strcmp 0 = if shutdown @ if 1 st-skip ! else ( just return until we are in shutdown ) st-action @ st-stage @ exit then then ( pause ) st-command @ "*" stringcmp 0 = if st-stage @ 1 + st-stage ! ( next stage ) st-action @ st-stage @ exit then ( one of the if statments want to jump to another action ) st-branch @ if ( switch to the a random action from the args ) st-branch @ set-random-stage ( run the first instruction in that action ) st-action @ st-stage @ st-name @ run-stage exit then ( advance to the next instruction and parse it ) st-skip @ if st-action @ st-stage @ 1 + st-name @ run-stage exit then ( Not a command ... add stuff to the stage text. ) stage-text @ debugging @ if "[" strcat st-name @ strcat ":" strcat st-action @ strcat ":" strcat st-stage @ intostr strcat "] " strcat then st-text @ strcat " " strcat stage-text ! ( advance this action to the next stage ) st-stage @ 1 + st-stage ! ( return the current action and stage in action for storage in the thread ) 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 ! ; : sleep-or-wait interactive @ if BEGIN runtime_dbref @ "pose" getprop not runtime_dbref @ "safeword" getprop not and WHILE 2 sleep ( be fairly responsive, but don't idle thrash ) REPEAT runtime_dbref @ "pose" 0 setprop else ( "> Pause." tell-me ) delay @ sleep then ; ( ----------------------------------------------------------------- CMD UTIL ) var current-set var matched-sex var matched-species : get-species ( -- s ) ( species_prop redirect handling ) me @ "species_prop" getpropstr dup if me @ swap getpropstr else pop me @ "species" getpropstr then ; : modify-current-set ( s -- ) strip " " explode BEGIN dup WHILE ( next ) 1 - swap 1 strcut swap "+" stringcmp 0 = if ( add to set ) dup current-set @ inset? not if current-set @ " " strcat swap strcat current-set ! else pop then else ( remove from set ) current-set @ " " strcat swap " " strcat "" swap subst strip current-set ! then REPEAT pop ; : generate-threads "" thread-names ! program_dbref @ "_all_threads" getpropstr " " explode BEGIN dup WHILE ( next ) 1 - swap dup current-set @ inset? if thread-names @ if " " swap strcat then thread-names @ swap strcat thread-names ! else pop then REPEAT pop ; : detect-threads program_dbref @ "_default_thread" getpropstr " " strcat program_dbref @ "_default_body_parts" getpropstr strcat strip current-set ! ( backwards compatability with pre-0.8 code ) current-set @ not if program_dbref @ "_threads-" me @ "sex" getprop strcat getprop dup not if pop 0 exit then strip thread-names ! thread-names @ body-parts ! 2 exit then ( custom bodypart list ) me @ custom-body-prop getpropstr strip dup if current-set ! generate-threads current-set @ body-parts ! 3 exit else pop then 0 matched-sex ! 1 BEGIN program_dbref @ "_gender_match#/" 3 pick intostr strcat getpropstr dup WHILE ( split into pattern and results ) dup ":" instr 1 - strcut 1 strcut swap pop swap me @ "sex" getprop tolower swap smatch if modify-current-set debugging @ if "> Matched gender pattern: " program_dbref @ "_gender_match#/" 4 pick intostr strcat getpropstr strcat tell-me then 1 matched-sex ! else pop then 1 + REPEAT pop pop 1 BEGIN program_dbref @ "_species_match#/" 3 pick intostr strcat getpropstr dup WHILE ( split into pattern and results ) dup ":" instr 1 - strcut 1 strcut swap pop swap get-species tolower swap smatch if modify-current-set debugging @ if "> Matched species pattern: " program_dbref @ "_species_match#/" 4 pick intostr strcat getpropstr strcat tell-me then 1 matched-species ! else pop then 1 + REPEAT pop pop generate-threads current-set @ body-parts ! matched-sex @ ; ( ---------------------------------------------------------------- print-list ) var full-set $def the-count 1-step ( save a variable ) : pad ( s i -- s ) swap " " strcat swap strcut pop ; : print-list "" st-text ! 0 the-count ! full-set @ " " explode BEGIN dup WHILE over the-count @ 1 + the-count ! ( ha ha ha ha! ) dup current-set @ inset? if "[*] " else "[ ] " then swap strcat the-count @ 4 % not if st-text @ swap strcat tell-me "" st-text ! else 20 pad st-text @ swap strcat st-text ! then 1 - swap pop REPEAT st-text @ tell-me ; ( ----------------------------------------------------------------- COMMANDS ) : do-help prog cmd-arg1 @ lib-help ; : do-start ( One at a time :] ) runtime_dbref @ "pid" getprop ispid? if "> The machine is already in operation. It must finish first." tell-me exit then runtime_dbref @ "pid" pid setprop ( Save the location ) me @ location my-location ! ( ) runtime_dbref @ "safeword" 0 setprop runtime_dbref @ "climax" 0 setprop runtime_dbref @ "pose" 0 setprop ( Counter and Log ) runtime_dbref @ "count" getprop atoi 1 + intostr dup runtime_dbref @ swap "count" swap setprop runtime_dbref @ swap "log/" swap strcat me @ name setprop ( Record the name so we can use it on the desc ) runtime_dbref @ "user" me @ name setprop ( ) me @ "_prefs/machine/delay" getprop dup if delay ! else pop program_dbref @ "_delay" getprop atoi dup if delay ! else pop then then ( ) me @ "_prefs/machine/interactive" getpropstr "yes" stringcmp 0 = if 1 interactive ! then ( ) program_dbref @ "_max_poses" getprop atoi dup if max-poses ! else pop program_dbref @ "_duration" getprop atoi dup if delay @ / max-poses ! ( convert duration to max poses ) "> Max poses calculated: " max-poses @ intostr strcat tell-me else pop then then systime start-time ! 0 shutdown ! detect-threads not if "> Unable to auto detect your gender. Please run #setup." tell-me exit then init-threads ( ) "> To abort: " command @ strcat " #safeword" strcat tell-me "> To tell the machine if you climax: " command @ strcat " #climax" strcat tell-me interactive @ if "> When you are ready to continue use: " command @ strcat " #pose" strcat tell-me then ( Startup Message ) person_starting @ player? if program_dbref @ "_startonmsg" getpropstr "$$" "%%" subst person_starting @ name "%name" subst person_starting @ swap pronoun_sub strip "%" "$$" subst tell-room else program_dbref @ "_startmsg" prop-tell-room then background sleep-or-wait 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 ! ( It is posible in rare situations to have no stage text. Just continue until there is. ) stage-text @ strip if stage-text @ tell-room pose-count @ 1 + pose-count ! sleep-or-wait then REPEAT me @ location my-location @ dbcmp not me @ awake? not or if program_dbref @ "_escapemsg" prop-tell-room else runtime_dbref @ "safeword" getprop if program_dbref @ "_safewordmsg" prop-tell-room else program_dbref @ "_endmsg" prop-tell-room then then runtime_dbref @ "user" remove_prop ; : do-starton cmd-arg1 @ .pmatch dup player? not if pop "> I don't see that person." tell-me exit then dup location me @ location dbcmp not if pop "> They are not in this room." tell-me exit then dup "_prefs/machine/consent" getpropstr "yes" strcmp 0 = not if pop "> They are not consenting." tell-me exit then dup "_prefs/machine/lock" getprop dup lock? if me @ swap testlock not if pop "> Their lock does not allow you to do this." tell-me exit then else pop then runtime_dbref @ "pid" getprop ispid? if "> The machine is already in operation. It must finish first." tell-me exit then dup "> " me @ name strcat " starts the machine on you." strcat notify dup "> You start the machine on " swap name strcat "." strcat tell-me me @ person_starting ! me ! do-start ; : do-consent me @ "_prefs/machine/consent" "yes" setprop me @ "_prefs/machine/lock" getprop dup lock? if "> You are now consenting to people in your lock to place you in a machine." tell-me "> Lock: " swap prettylock strcat tell-me else pop "> You are now consenting to anyone placing you in a machine." tell-me "> Use " command @ strcat " #lock to be more specific." strcat tell-me then ; : do-noconsent me @ "_prefs/machine/consent" "no" setprop "> You are now not consenting to anyone putting you in a machine." tell-me ; : do-interactive me @ "_prefs/machine/interactive" "yes" setprop "> You are now set to use interactive mode." tell-me "> You must use #pose to let the machine know to continue." tell-me ; : do-nointeractive me @ "_prefs/machine/interactive" "no" setprop "> You are now set to use the standard delay mode." tell-me ; : do-wixxx cmd-arg1 @ strip cmd-arg1 ! cmd-arg1 @ not if "> Flags in standard wixxx: " me @ "_prefs/whatis/flags" getpropstr strip strcat tell-me "> Machine wixxx flags: " me @ "_prefs/machine/wixxx" getpropstr strip strcat tell-me exit then me @ "_prefs/machine/wixxx" cmd-arg1 @ setprop "> Machine wixxx flags set to: " cmd-arg1 @ strcat tell-me ; : do-speed cmd-arg1 @ strip atoi cmd-arg1 ! cmd-arg1 @ not if "> You must specify a number of seconds for the delay between poses." tell-me exit then me @ "_prefs/machine/delay" cmd-arg1 @ setprop "> Your machine delay has been set to: " cmd-arg1 @ intostr strcat " seconds" strcat tell-me ; : do-nospeed me @ "_prefs/machine/delay" remove_prop "> You will now use the machine's standard delay." tell-me ; : do-lock cmd-arg1 @ not if me @ "_prefs/machine/lock" getprop dup lock? if "> Your lock is: " swap prettylock strcat tell-me else pop "> You have no lock set." tell-me then exit then cmd-arg1 @ parselock dup if me @ swap "_prefs/machine/lock" swap setprop "> Lock set." tell-me else pop "> Parsing of that lock failed." tell-me then ; : do-nolock me @ "_prefs/machine/lock" remove_prop "> Your lock has been cleared." tell-me ; : do-climax "> Machine notified of your climax." tell-me runtime_dbref @ "climax" 1 setprop ; : do-pose "> Machine notified of your pose." tell-me runtime_dbref @ "pose" 1 setprop ; : do-safeword "> Initiating emergency shutdown." tell-me runtime_dbref @ "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-setup "> Initalizing setup..." tell-me ( get what they currently have ) 1 debugging ! detect-threads pop ( get the full list ) program_dbref @ "_all_threads" getpropstr " " strcat program_dbref @ "_all_body_parts" getpropstr strcat strip full-set ! full-set @ not if "> This machine must be upgraded to use autodetection." tell-me "> Can not customize body parts, exiting." tell-me exit then BEGIN " " tell-me print-list "* = part that the machine thinks you currently have." tell-me "Enter the name of a bodypart to toggle, or:" tell-me "q to quit, s to save, a to set autoscan on startup." tell-me read strip tolower " " tell-me dup "s" stringcmp 0 = if pop "> Saving bodypart description and exiting." tell-me me @ custom-body-prop current-set @ setprop exit then dup "a" stringcmp 0 = if pop "> The machine will now try and auto detect you." tell-me "> Deleting custom bodypart description and exiting." tell-me me @ custom-body-prop remove_prop exit then dup "q" stringcmp 0 = if pop "> Reverting bodypart description and exiting." tell-me exit then dup full-set @ inset? not if "> Bodypart \"" swap strcat "\" is unknown." strcat tell-me CONTINUE then dup current-set @ inset? if dup "> Removing bodypart: " swap strcat tell-me "-" swap strcat modify-current-set CONTINUE then dup "> Adding bodypart: " swap strcat tell-me "+" swap strcat modify-current-set REPEAT ; : do-settings "> Consent: " me @ "_prefs/machine/consent" getpropstr "yes" stringcmp 0 = if "Yes - Others may put you in the machine." else "No - You must start the machine yourself." then strcat tell-me "> Lock: " me @ "_prefs/machine/lock" getprop dup lock? if prettylock else pop "None - When consenting, anyone may put you in a machine." then strcat tell-me "> Delay: " me @ "_prefs/machine/delay" getprop dup if intostr " seconds" strcat else pop "Default." then strcat tell-me "> Interactive: " me @ "_prefs/machine/interactive" getpropstr "yes" stringcmp 0 = if "Yes - The machine will wait for you to respond to poses." else "No - The machine will delay between poses." then strcat tell-me "> Machine wixxx flags: " me @ "_prefs/machine/wixxx" getpropstr strip strcat tell-me "> Doing detection test..." tell-me 1 debugging ! detect-threads dup 2 < if "> Gender matched?: " matched-sex @ if "Yes" else "No - Use " command @ strcat " #setup" strcat then strcat tell-me "> Species Matched?: " matched-species @ if "Yes" else "No" then strcat tell-me then dup 2 = if "> Using old-style Firmware gender match." tell-me then dup 3 = if "> Using custom body definition. " "Use " strcat command @ strcat " #setup to modify." strcat tell-me then "> Threads chosen: " thread-names @ strcat tell-me "> Bodyparts chosen: " body-parts @ strcat tell-me ; : do-reset do-safeword ; ( ----------------------------------------------------------------- MAIN ) ( set prop locations ) : set-prop-locations ( Defaults ) ( 60 duration ! ) 0 interactive ! 120 delay ! #-1 person_starting ! 0 pose-count ! 20 max-poses ! ( Find the program ) runtime_dbref @ "_program" getprop dup ok? if program_dbref ! else pop runtime_dbref @ program_dbref ! then ( Debugging? ) runtime_dbref @ "d" flag? if ">> Debugging enabled." tell-me 1 else 0 then debugging ! ; ( we were run as a command ) : run-as-command trigger @ runtime_dbref ! set-prop-locations "Command" event_type ! lib-command-parse ( #s1 s2=s4 ) cmd-arg2 ! cmd-arg1 ! cmd-option ! 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 @ "lock" stringcmp 0 = if do-lock exit then cmd-option @ "!lock" stringcmp 0 = if do-nolock exit then cmd-option @ "interactive" stringcmp 0 = if do-interactive exit then cmd-option @ "!interactive" stringcmp 0 = if do-nointeractive exit then cmd-option @ "consent" stringcmp 0 = if do-consent exit then cmd-option @ "!consent" stringcmp 0 = if do-noconsent exit then cmd-option @ "delay" stringcmp 0 = if do-speed exit then cmd-option @ "!delay" stringcmp 0 = if do-nospeed exit then cmd-option @ "speed" stringcmp 0 = if do-speed exit then cmd-option @ "!speed" stringcmp 0 = if do-nospeed exit then cmd-option @ "start" stringcmp 0 = if do-start exit then cmd-option @ "starton" stringcmp 0 = if do-starton exit then cmd-option @ "cum" stringcmp 0 = if do-climax exit then cmd-option @ "climax" stringcmp 0 = if do-climax exit then cmd-option @ "pose" stringcmp 0 = if do-pose 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 @ "wixxx" stringcmp 0 = if do-wixxx exit then cmd-option @ "settings" stringcmp 0 = if do-settings exit then cmd-option @ "setup" stringcmp 0 = if do-setup 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 ; ( we were run as an event ) : queued-event event_type ! loc @ runtime_dbref ! "> Machine run as " event_type @ strcat " event." strcat tell-me ( Find our runtime props ) runtime_dbref @ "_machine_props" getprop dup ok? if runtime_dbref ! else pop "> _machine_props not set." tell-me exit then ( is this a supported event type ) event_type @ "Arrive" strcmp 0 = event_type @ "Connect" strcmp 0 = or not if "> Not a supported queued event type." tell-me then ( check if _machine_props is valid ) runtime_dbref @ exit? if runtime_dbref @ getlink prog dbcmp not else 0 then if "> _machine_props must be an exit that is linked to the machine." tell-me exit then runtime_dbref @ location dup thing? if location then loc @ dbcmp not if "> _machine_prop does not point to a machine exit in this room." tell-me exit then loc @ owner runtime_dbref @ owner dbcmp not if "> Machine exit not owned by room owner." tell-me exit then ( find program and such ) set-prop-locations ( set the command @ to be the right name ) runtime_dbref @ name dup ";" instr dup if 1 - strcut pop else pop then command ! "> Machine running as command " command @ strcat "." strcat tell-me ( start machine ) do-start ; : main trigger @ exit? not if queued-event exit then trigger @ getlink prog dbcmp not if queued-event exit then run-as-command ; . c q