@prog pinfo.muf 1 9999 d i ( pinfo.muf by Wog This is a simple highly customizable pinfo-type program. SETUP: lsedit =fields [Enter data for fields, format: : ] --- Change History ---------------------------------- v 1.0 02/24/00 Assignment of version number to programs. v 1.01 03/23/00 Changes the unset text to something more logical. v 1.1 03/26/00 Added support for p #global-alias lookup of names. v 1.2 03/27/00 Fixed potential security hole; Added setpinfo #notify support. v 1.2.1 04/24/00 Fixed bug in setpinfo... v 1.2.2 10/26/00 Fixed setpinfo colors, default #notify setting. v 1.2.3 22 May 2004 Fixed some typos (esp. for FB6 color). Thanks to Enzeru@SPR. -- Distrubution Information ------------------------ Copyright {C} Charles "Wog" Reiss This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or {at your option} any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. For a copy of the GPL: a> see: http://www.gnu.org/copyleft/gpl.html b> write to: the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA ) $undef USE_PAGE_ALIASES $ifdef USE_PAGE_ALIASES $def PAGE_DBREF "page" match getlink $def PAGE_GALIAS_PREFIX "_page/galias/g-" : do_pmatch ( s -- d ) dup PAGE_DBREF PAGE_GALIAS_PREFIX rot strcat getpropstr strip dup if dup " " instr not if .pmatch swap pop exit else pop then else pop then .pmatch ; $else $def do_pmatch .pmatch $endif $ifdef __glowver $def __glowlike $endif $ifdef __smms $def __glowlike $endif $ifdef __glowlike $def ansi-tell me @ swap ansi_notify $def ansi-strlen ansi_strlen $else $include $lib/ansi (TODO: implement ansi fully) $endif $include $lib/lmgr lvar itmp lvar place lvar itmp2 lvar itmp3 : getFields ( -- {ss} ) ( prop stored on player, name of prop ) prog "/_fields#" getpropstr atoi itmp ! itmp @ place ! begin place @ "/_fields" prog lmgr-getelem ":" .split place @ 1 - dup place ! 0 = until itmp @ ; PUBLIC getFields : longFormat ( s -- s' ) "\r" explode itmp3 ! 1 itmp2 ! begin itmp2 @ 1 = not if " " rot strcat swap "\r" strcat swap strcat then itmp2 @ 1 + itmp2 ! itmp2 @ itmp3 @ > until "\r" strcat ; lvar player lvar output lvar stmp : getPinfoFor ( d -- s ) player ! "" output ! getFields itmp ! begin (Stack: ... name prop ) dup player @ swap getpropstr dup stmp ! "" strcmp not if pop pop itmp @ 1 - dup itmp ! 0 = if break else continue then then player @ swap "pinfo" 1 parseprop swap "~&160" swap strcat "~&060:~&070 " strcat swap strcat stmp @ "{" instr 1 = if longFormat output @ swap strcat output ! else itmp @ 1 = not if "\r" strcat then output @ swap strcat output ! then itmp @ 1 - dup itmp ! 0 = until output @ ; : doHelp "~&170Player Info by Wog" ansi-tell "~&040--------------------" ansi-tell "~&030 pinfo #help ~&060 -- This screen" ansi-tell "~&030 pinfo ~&060 -- Get the pinfo for a player" ansi-tell "~&030 pinfo #fields ~&060 -- List fields" ansi-tell "~&050To set fields use the setpinfo command.~&R" ansi-tell ; : listFields getFields itmp ! "" output ! begin swap itmp @ 1 = if output @ swap strcat output ! else itmp @ 2 = if output @ swap strcat ", and " strcat output ! else output @ swap strcat ", " strcat output ! then then pop itmp @ 1 - dup itmp ! 0 = until "Fields are: " output @ strcat .tell ; : main dup "#h" instring 1 = if pop doHelp exit then dup "#f" instring 1 = if pop listFields exit then dup "" strcmp not if pop doHelp exit then dup "me" strcmp not if pop me @ name then do_pmatch dup #-1 dbcmp if "~&170pinfo>~&110 Not a valid player!~&R" ansi-tell pop exit then dup #-2 dbcmp if "~&170pinfo>~&110 Ambiguous!~&R" ansi-tell pop exit then dup player? not if "Not a valid player!" .tell pop exit then dup name "~&040--[ ~&030Player Info For ~&020" swap strcat "~&040 ]" strcat dup ansi-strlen 78 swap - itmp ! begin "-" strcat itmp @ 1 - dup itmp ! 0 <= until "~&R" strcat ansi-tell getPinfoFor dup "" strcmp not if pop "~&170This player's player info is unset.~&R" ansi-tell else striptail ansi-tell then "~&040------------------------------------------------------------------------------~&R" ansi-tell ; . c q @set pinfo.muf=W @reg pinfo.muf=cmd/pinfo @prog pinfo-prog-setup.muf 1 99 d i : main "$cmd/pinfo" match dup "_defs/pinfo" rot int intostr "#" swap strcat setprop ">> Pinfo-prog-setup.muf done." .tell ; . c q @mpi {muf:pinfo-prog-setup.muf,} @recycle pinfo-prog-setup.muf @program pinfo-edit.muf 1 9999 d i ( pinfo-edit.muf by Wog Pinfo editor intended for use with pinfo.muf Please name action linked to this program 'setpinfo' or change the text refering to this proggie in pinfo.muf's help info. --- Change History ---------------------------------- v 1.0 02/24/00 Assignment of version number to programs. v 1.2.1 04/24/00 Fixed NOTIFY_TEXT mis-setting, so pronouns sub runs on this and not 'me'. v 1.2.2 10/26/00 Fixed NOTIFY_TEXT further mis-setting to start with not:, and fixed colors. --- Distrubution Information ------------------------ Copyright {C} Charles "Wog" Reiss This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or {at your option} any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. For a copy of the GPL: a> see: http://www.gnu.org/copyleft/gpl.html b> write to: the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA ) $def NOTIFY_TEXT "{null:{tell:++++ {name:me} just looked at your PInfo!,this}}{pronouns:%N sees you looking at %p PInfo.,this}" $include $cmd/pinfo ( gets pinfo $define ) $include $lib/lmgr $include $lib/editor $ifdef __smms $def __glowlike $endif $ifdef __glowver $def __glowlike $endif $ifdef __glowlike $def ansi-tell me @ swap ansi_notify $else $include $lib/ansi $endif : getFields ( -- {ss} ) pinfo "getFields" call ; lvar maxField lvar itmp lvar stmp lvar match1 lvar match2 lvar listSaved (Takes the beginning of field name and finds the data for it...) : matchField ( s -- s1 s2 b ) ( b = was error ) ( s1 = prop/errortext) ( s2 = field namenot ) stmp ! "" match1 ! (holds name) "" match2 ! (holds prop) getFields maxField ! 1 itmp ! begin over stmp @ instring 1 = if match1 @ "" strcmp if "" "Ambiguous." 1 exit then match1 ! match2 ! else pop pop then itmp @ dup 1 + itmp ! maxField @ >= until match1 @ "" strcmp not if "" "No match found." 1 exit then match2 @ match1 @ 0 ; (Begin code blantly copied from cmd-lsedit and slightly modified ) $def LMGRgetcount lmgr-getcount $def LMGRgetrange lmgr-getrange $def LMGRputrange lmgr-putrange $def LMGRdeleterange lmgr-deleterange : LMGRdeletelist over over LMGRgetcount 1 4 rotate 4 rotate LMGRdeleterange ; : LMGRgetlist over over LMGRgetcount rot rot 1 rot rot LMGRgetrange ; : lsedit-loop ( listname dbref {rng} mask currline cmdstr -- saved? ) EDITORloop dup "save" stringcmp not if 1 listSaved ! pop pop pop pop 3 pick 3 + -1 * rotate over 3 + -1 * rotate dup 5 + pick over 5 + pick over over LMGRdeletelist 1 rot rot LMGRputrange 4 pick 4 pick LMGRgetlist dup 3 + rotate over 3 + rotate "< List saved. >" .tell "" lsedit-loop exit then dup "abort" stringcmp not if "< list not saved. >" .tell pop pop pop pop pop pop pop pop pop listSaved @ exit then dup "end" stringcmp not if pop pop pop pop pop pop dup 3 + rotate over 3 + rotate over over LMGRdeletelist 1 rot rot LMGRputrange "< list saved. >" .tell 1 exit then ; : initEditor ( s -- saved? ) "< Welcome to the list editor. You can get help by entering '.h' >" .tell "< '.end' will exit and save the list. '.abort' will abort any changes. >" .tell "< To save changes to the list, and continue editing, use '.save' >" .tell me @ over me @ lmgr-fullrange lmgr-getrange "save" 1 ".i" lsedit-loop ; (End copied code) : editPropAsList ( prop -- ) stmp ! stmp @ initEditor if (saved) me @ stmp @ "{nl}{eval:{list:" stmp @ strcat ",*" me @ name strcat "}}" strcat strcat setprop "~&120Changed.~&R" ansi-tell else "~&110Cancelled. No changes made.~&R" ansi-tell then ; : doHelp "~&170Player Info Edit by Wog" ansi-tell "~&040-------------------------" ansi-tell "~&030 COMMAND #help ~&160 -- This screen\r" "~&030 COMMAND #clear ~&160 -- Clears a field\r" prog "_notify_field" getpropstr if "~&030 COMMAND #notify ~&160 -- Enable notification when someone views your pinfo\r" strcat "~&030 COMMAND #!notify ~&160 -- Disable notification\r" strcat then "~&030 COMMAND ~&160 -- Edit field (for longer fields)\r" "~&030 COMMAND =~&160 -- Set field to value\r" "~&050 MPI is parsed on field settings.\r" "~&050 Type 'pinfo #fields' for a list of fields.~&R" strcat strcat strcat strcat strcat command @ "COMMAND" subst ansi-tell ; : main dup "" strcmp not over "#help" strcmp not or if pop doHelp exit then dup "#clear" instr 1 = if " " .split swap pop matchField if "~&170" command @ strcat ">~&110 Could not reference field. " strcat swap strcat "~&R" strcat ansi-tell pop exit then (Stack: ) swap pop me @ over remove_prop "#" strcat me @ swap remove_prop "~&170" command @ strcat ">~&120 Field cleared." strcat ansi-tell exit then dup "#!notify" stringpfx if prog "_notify_field" getpropstr dup if matchField if "~&170" command @ strcat ">~&110 Could not reference field. Suspect misconfiguration." strcat ansi-tell exit then swap pop me @ swap remove_prop "~&170" command @ strcat ">~&110 Field cleared." strcat ansi-tell exit else "~&170" command @ strcat ">~&110 Notify feature not supported." strcat ansi-tell exit then then dup "#notify" stringpfx if prog "_notify_field" getpropstr dup if swap pop matchField if "~&170" command @ strcat ">~&110 Could not reference field. Suspect misconfiguration." strcat ansi-tell exit then swap pop me @ swap NOTIFY_TEXT setprop "~&170" command @ strcat "> ~&110Field set." strcat ansi-tell exit else "~&170" command @ strcat ">~&110 Notify feature not supported." strcat ansi-tell exit then then "=" .split swap matchField if "~&170" command @ strcat ">~&110 Could not reference field. " strcat swap strcat "~&R" strcat ansi-tell pop exit then (Stack: ) swap pop (Stack: ) over "" strcmp not if swap pop editPropAsList exit then dup "#" strcat me @ swap getpropstr "" strcmp if dup "#" strcat me @ swap remove_prop then me @ swap rot ( ) setprop "~&170" command @ strcat "> ~&120Property changed.~&R" strcat ansi-tell ; . c q @set pinfo-edit.muf=VIEWABLE @set pinfo-edit.muf=W whis me=Creating pinfo field setup proggie... @prog pinfo-field-setup.muf 1 9999 d i $include $lib/lmgr lvar pinfo : main ">> Setting up pinfo fields..." .tell "$cmd/pinfo" match pinfo ! pinfo @ "fields#" getpropstr if ">> Copying old fields list to new prop..." .tell "fields" pinfo @ LMGR-getlist 1 "_fields" pinfo @ LMGR-putrange ">> Copied old list. Now removing..." .tell "fields" pinfo @ LMGR-deletelist ">> Done." .tell ">> If you want to have setpinfo #notify work, then create a field" .tell ">> named similar to `Notify' and set the _notify_field prop on the pinfo-edit" .tell ">> proggie to it's name." .tell exit else pinfo @ "_fields#" getpropstr if ">> Fields already setup." .tell exit then ">> Creating sample list... Remove Notify field and unset the _notify_field prop" .tell ">> on the setpinfo.muf proggie to disable pinfo notify." .tell (1) "Notify:/_pinfo/n" (2) "Character:/_pinfo/c" (3) "EMail:/_pinfo/e" (4) "Birthdate:/_pinfo/b" (5) "Homepage:/_pinfo/w" (6) "Residence:/_pinfo/r" (7) "TinyPlot Prefs:/_pinfo/tp" 7 1 "_fields" pinfo @ LMGR-putrange "pinfo-edit.muf" match "_notify_field" "Notify" setprop then ; . c q @set pinfo-edit.muf=VIEWABLE @mpi {muf:pinfo-field-setup.muf,} @recycle pinfo-field-setup.muf whis me=To finish install create a 'pinfo' global linked to the pinfo.muf proggie, and a 'setpinfo' global linked to the pinfo-edit.muf proggie. whis me=You can add/edit/remove the fields by typing 'lsedit $cmd/pinfo=_fields'. The list is in this format: :