@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 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 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 $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 "cyan,bold" textattr ":" "cyan" textattr 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 "Player Info by Wog" "white,bold" textattr .tell "--------------------" "blue,bold" textattr .tell " pinfo #help " "yellow" textattr " -- This screen" "cyan" textattr strcat .tell " pinfo " "yellow" textattr " -- Get the pinfo for a player" "cyan" textattr strcat .tell " pinfo #fields " "yellow" textattr " -- List fields" "cyan" textattr strcat .tell "To set fields use the setpinfo command." "magenta" textattr .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: " "magenta" textattr output @ "magenta,bold" textattr 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 "pinfo>" "white,bold" textattr " Not a valid player!" "red,bold" textattr strcat .tell pop exit then dup #-2 dbcmp if "pinfo>" "white,bold" textattr " Ambiguous!" "red,bold" textattr strcat .tell pop exit then dup player? not if "Not a valid player!" .tell pop exit then dup name "--[ " "blue" textattr "Player Info For " "yellow" textattr strcat swap "green" textattr strcat " ]" "blue" textattr strcat over name strlen (Constant of size without name:) 23 + 78 swap - begin dup while swap "-" strcat swap 1 - repeat pop .tell getPinfoFor dup "" strcmp not if pop "This player's player info is unset." "bold" textattr .tell else striptail .tell then "------------------------------------------------------------------------------" "blue" textattr .tell ; . c q @set pinfo.muf=W @reg pinfo.muf=cmd/pinfo @prog pinfo-prog-setup.muf 1 99 d i ( Setup program to _defs/pinfo def to cmd-pinfo as registered. ) : 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 Syntax: pinfoedit [=] --- 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 pronoun sub runs on this and not 'me'. v 1.2.2 04/24/00 Fixed NOTIFY_TEXT mis-setting {again!} and setpinfo 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 $include $lib/ansi : 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 "Changed." "green,bold" textattr .tell else "Cancelled. No changes made." "red,bold" textattr .tell then ; : doHelp "Player Info Editor by Wog" "white,bold" textattr .tell "-------------------------" "blue" textattr .tell " COMMAND #help " "yellow" textattr " -- This screen\r" "cyan" textattr strcat " COMMAND #clear " "yellow" textattr strcat " -- Clears a field\r" "cyan" textattr strcat prog "_notify_field" getpropstr if " COMMAND #notify " "yellow" textattr " -- Enable notification when someone views your pinfo\r" "cyan" textattr strcat " COMMAND #!notify " "yellow" textattr " -- Disable notification\r" "cyan" textattr strcat then " COMMAND " "yellow" textattr strcat " -- Edit field (for longer fields)\r" "cyan" textattr strcat " COMMAND =" "yellow" textattr strcat " -- Set field to value\r" "cyan" textattr strcat " MPI is parsed on field settings.\r" "magenta" textattr strcat " Type 'pinfo #fields' for a list of fields." "magenta" textattr strcat command @ "COMMAND" subst .tell ; : cmdPrefix command @ "> " strcat "white,bold" textattr swap strcat ; : main dup "" strcmp not over "#help" strcmp not or if pop doHelp exit then dup "#clear" instr 1 = if " " .split swap pop matchField if "Could not reference field. " swap strcat "red,bold" textattr cmdPrefix .tell pop exit then (Stack: ) swap pop me @ over remove_prop "#" strcat me @ swap remove_prop "Field cleared." "green,bold" textattr cmdPrefix .tell exit then dup "#!notify" stringpfx if prog "_notify_field" getpropstr dup if matchField if "Could not reference field. Suspect misconfiguration." "red,bold" textattr cmdPrefix .tell exit then swap pop me @ swap remove_prop "Field cleared." "green,bold" textattr cmdPrefix .tell exit else "Notify feature not supported." "red,bold" textattr cmdPrefix .tell exit then then dup "#notify" stringpfx if prog "_notify_field" getpropstr dup if swap pop matchField if "Could not reference field. Suspect misconfiguration." "red,bold" textattr cmdPrefix .tell exit then swap pop me @ swap NOTIFY_TEXT setprop "Field set." "green,bold" textattr cmdPrefix .tell exit else "Notify feature not supported." "red,bold" textattr cmdPrefix .tell exit then then "=" .split swap matchField if "Could not reference field. " swap strcat "red,bold" textattr cmdPrefix .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 "Property changed." "green,bold" textattr cmdPrefix .tell ; . c q @set pinfo-edit.muf=VIEWABLE @set pinfo-edit.muf=W @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 setpinfo" .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: :