( cmd-cinfo Version: 1.1.0 Character Information Copyright by WhiteFire under GPL [ Any version the FSF likes. ] Properties: [ on trigger ] _field-descs/: [ on player ] _cinfo/: _cinfo/misc/: Commands: cinfo - Show all standard fields cinfo - Show one of the misc fields [ Setting standard fields: ] cinfo #set = - Sets a standard field [ Setting Misc fields: ] cinfo #misc = - Sets a misc field [ List fields: ] cinfo #fields - List of fields and descriptions [ Help: ] cinfo #help [] - Show help topic CHANGES: 1.1.0 -- Added MPI parsing to all fields shown. ) ( ----------------------------------------------------------------- $include ) $include $lib/command ( ----------------------------------------------------------------- VARS ) var cmd-option var cmd-arg1 var cmd-arg2 var object-shown ( ----------------------------------------------------------------- UTIL ) : tell-me me @ swap notify ; ( ----------------------------------------------------------------- PARSE ) ( Varous general functions.. ) : cmd-parse ( s -- s1 s2 s3 ) strip ( *s1* if it starts with a # strip off the option.. ) dup 1 strcut pop "#" stringcmp 0 = if dup " " instr dup if strcut strip swap strip else pop "" swap then 1 strcut swap pop (strip #/-) else "" then swap ( stack: s1 s ) ( *s3* Is there a =? ) dup "=" instr dup if 1 - strcut 1 strcut swap pop ( strip = ) strip swap else pop "" swap then ( stack: s1 s3 s ) ( *s2* Finish it.. ) strip swap ; ( ----------------------------------------------------------------- Funcs ) : comma-format (string -- formattedstring) strip ( stripspaces single-space ) ", " " " subst dup ", " rinstr dup if 1 - strcut 2 strcut swap pop " and " swap strcat strcat else pop then ; : split swap over over swap instr dup not if pop swap pop "" else 1 - strcut rot strlen strcut swap pop then ; : controls? ( d d -- i ) ( wizard controlls all ) dup "w" flag? if pop pop 1 exit then ( What you own ) swap owner dbcmp ; : misc-name-ok? ( s -- i ) ( Null string not valid. ) dup not if pop 0 exit then ( check first character ) dup 1 strcut pop "_.@~" swap instr if pop 0 exit then ( Nothing silly like propdirs .. ) dup " " instr over "/" instr or swap ":" instr or if 0 exit then 1 ; : get-player ( -- bool ) cmd-arg1 @ "me" stringcmp 0 = if me @ object-shown ! 1 exit then cmd-arg1 @ .pmatch dup player? if object-shown ! 1 else pop "> Can't find player \"" cmd-arg1 @ strcat "\"." strcat tell-me 0 then ; ( ----------------------------------------------------------------- COMMANDS ) : do-show-field get-player not if exit then object-shown @ "_cinfo/misc/" cmd-arg2 @ strcat getpropstr if "> Character Info for: " object-shown @ name strcat ", Miscellaneous field: " strcat cmd-arg2 @ strcat tell-me object-shown @ "_cinfo/misc/" cmd-arg2 @ strcat me @ name 1 parseprop "> " swap strcat tell-me else "> " object-shown @ name strcat " has no field \"" strcat cmd-arg2 @ strcat "\"." strcat tell-me then ; : do-show-all get-player not if exit then "> Character Info for: " object-shown @ name strcat tell-me "_field-descs/" BEGIN trigger @ swap nextprop dup 13 strcut pop "_field-descs/" stringcmp 0 = WHILE dup 13 strcut swap pop ( "_cinfo/" over strcat object-shown @ swap getpropstr ) "_cinfo/" over strcat object-shown @ swap "cinfo" 1 parseprop dup if swap ": " strcat swap strcat tell-me else pop pop then REPEAT pop "" "_cinfo/misc/" BEGIN object-shown @ swap nextprop dup 12 strcut pop "_cinfo/misc/" stringcmp 0 = WHILE dup 12 strcut swap pop rot swap strcat " " strcat swap REPEAT pop dup if comma-format "> Miscellaneous fields: " swap strcat tell-me "> \"cinfo " object-shown @ name strcat " \" to display." strcat tell-me else pop then "> Done." tell-me ; : do-fields "> Fields list:" tell-me "_field-descs/" BEGIN trigger @ swap nextprop dup 13 strcut pop "_field-descs/" stringcmp 0 = WHILE trigger @ over getpropstr over 13 strcut swap pop " - " strcat swap strcat tell-me REPEAT pop "> Done." tell-me ; : do-set cmd-arg1 @ not if "> You must specify a field. See \"cinfo #help\" for usage." tell-me exit then cmd-arg1 @ misc-name-ok? not if "> \"" cmd-arg1 @ strcat "\" is an invalid field name." strcat tell-me exit then trigger @ "_field-descs/" cmd-arg1 @ strcat getpropstr if cmd-arg2 @ if me @ "_cinfo/" cmd-arg1 @ strcat cmd-arg2 @ setprop "> Field \"" cmd-arg1 @ strcat "\" set to \"" strcat cmd-arg2 @ strcat "\"." strcat tell-me else me @ "_cinfo/" cmd-arg1 @ strcat remove_prop "> Field \"" cmd-arg1 @ strcat "\" removed." strcat tell-me then else "> \"" cmd-arg1 @ strcat "\" is an unknown field." strcat tell-me then ; : do-setmisc cmd-arg1 @ not if "> You must specify a field. See \"cinfo #help\" for usage." tell-me exit then cmd-arg1 @ misc-name-ok? not if "> \"" cmd-arg1 @ strcat "\" is an invalid field name." strcat tell-me exit then cmd-arg2 @ if me @ "_cinfo/misc/" cmd-arg1 @ strcat cmd-arg2 @ setprop "> Miscellaneous field \"" cmd-arg1 @ strcat "\" set to \"" strcat cmd-arg2 @ strcat "\"." strcat tell-me else me @ "_cinfo/misc/" cmd-arg1 @ strcat remove_prop "> Miscellaneous field \"" cmd-arg1 @ strcat "\" removed." strcat tell-me then ; : do-help prog cmd-arg1 @ lib-help ; ( ----------------------------------------------------------------- MAIN ) : main cmd-parse ( #s1 s2=s4 ) cmd-arg2 ! cmd-arg1 ! cmd-option ! cmd-option @ not cmd-arg1 @ not and if "> See cinfo #help for usage." tell-me exit then ( cinfo ) cmd-option @ not cmd-arg2 @ not and if cmd-arg1 @ " " split cmd-arg2 ! cmd-arg1 ! then cmd-option @ not cmd-arg2 @ not and if do-show-all exit then cmd-option @ not cmd-arg2 @ and if do-show-field exit then cmd-option @ "s" stringcmp 0 = if do-set exit then cmd-option @ "set" stringcmp 0 = if do-set exit then cmd-option @ "f" stringcmp 0 = if do-fields exit then cmd-option @ "fields" stringcmp 0 = if do-fields exit then cmd-option @ "m" stringcmp 0 = if do-setmisc exit then cmd-option @ "misc" stringcmp 0 = if do-setmisc exit then cmd-option @ "setmisc" stringcmp 0 = if do-setmisc exit then cmd-option @ "h" stringcmp 0 = if do-help exit then cmd-option @ "help" stringcmp 0 = if do-help exit then "> \"#" cmd-option @ strcat "\" is an unknown command. Try \"cinfo #help\" for help." strcat tell-me ;