@program muckers-list.muf
1 9999 d
i
( muckers-list.muf version 1.0 by Wog

A clone of the 'muckers' command + color.

Format inspired by GlowMuck's WHO command.

NOTE - This program uses the _prefs/mucker? property as the
flag whether someone should be listed [this is primarilly for
`will help' purposes]. BUT, that can be changed below.

--- Change History ----------------------------------
v 1.0	09 Dec 2000
    Initial Release
--- Distribution Information ------------------------
Copyright {C} Charles "Wog" Reiss <car@cs.brown.edu>

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 MUCKER_PROP "_prefs/mucker?"

$include $lib/case

$def .mlevel dup "T" flag? if pop 4 else mlevel then

: is-mucker? ( d -- b ) dup .mlevel swap MUCKER_PROP getpropstr .yes? and ;

: set-mucker ( d -- ) MUCKER_PROP "yes" setprop ;
: unset-mucker ( d -- ) MUCKER_PROP remove_prop ;

$def SPACES "                                                             "
: leftfit ( s i -- s' )
	swap SPACES strcat swap ansi_strcut pop
;
: show-mucker ( d -- )
	name 20 leftfit "green,bold" textattr
	swap
	.mlevel
	case
		0 = when
			"(" "bold,white" textattr
			"M0" "bold,red" textattr strcat
			")   - " "bold,white" textattr strcat
			"No Mucker Bit" "bold,red" textattr strcat
		end
		1 = when
			
			"(" "bold,white" textattr
			"M1" "bold,red" textattr strcat
			")   - " "bold,white" textattr strcat
			"Apprentice" "bold,cyan" textattr strcat
		end
		2 = when
		
			"(" "bold,white" textattr
			"M2" "bold,red" textattr strcat
			")   - " "bold,white" textattr strcat
			"Journeyman" "bold,cyan" textattr strcat
		end
		3 = when
		
			"(" "bold,white" textattr
			"M3" "bold,red" textattr strcat
			")   - " "bold,white" textattr strcat
			"Master" "bold,cyan" textattr strcat
		end
		4 = when
		
			"(" "bold,white" textattr
			"M4" "bold,red" textattr strcat
			")   - " "bold,white" textattr strcat
			"Wizard" "bold,cyan" textattr strcat
		
		end
	endcase
	strcat
	.tell
;

: header
	"Name" 20 leftfit "green" textattr 
	"Level" "cyan" textattr strcat .tell
;

: footer
	over
	case
		0 = when
			"No muckers"
		end
		1 = when
			"A mucker"
		end
		2 = when
			"A couple of muckers"
		end
		default
			intostr " muckers" strcat
		end
	endcase
	strcat " found." strcat
	"blue,bold" textattr .tell
;

( -- Purify code -- )

: purify-one ( d1 .. dn n t i -- d1 .. dn n t ;  t will remain unaltered. )
        3 + ( for the t, n and copy )
        dup pick ( get dbref )
        ( d1 .. dn n t i di )
        swap
        ( Now we could add one to compensate for di, and subtract
          one to compensate for the fact we want the next value up,
          but it would be pointless. )
        begin
                ( d1 .. dn n t di x )
                dup 4 > while
                dup rotate
                ( d1 .. dn n t di x dx ;  note that dx is missing for d1 .. dn )
                dup 4 pick dbcmp not if
                        ( d1 .. dn n t di x dx )
                        over 0 swap -
                        ( d1 .. dn n t di x dx -x )
                        ( Insert what we took back. )
                        rotate
                        ( d1 .. dn n t di x )
                else
                        ( d1 .. dn n t di x dx )
                        pop ( Remove item, we don't want it. )
                        ( d1 .. dn n t di x )
                        4 rotate 1 - -4 rotate ( Since we got rid of it decremen
t n )
                        ( d1 .. dn' n' t di x )
                then
                ( Now we want to try the next-closest item... )
                1 -
        repeat
        pop pop  
        ( d1 .. dn n t )
; 


: purify-reflist ( {d} -- {d}' ;  removes duplicate dbrefs from list. )
        dup not if exit then
        (Note: We store the offest from the top of the list here. Our convience.
 )
        0 begin
                over over >= not while
                over over - ( Find location from list top. )
                ( {d} i i' )
                purify-one ( And one-loop. )
                1 + ( Go to next item up. )
        repeat pop 
; 

lvar count
: muckers ( -- )
	header
	0 count !
	online purify-reflist
	begin
		dup while
		1 - swap
		dup is-mucker? if
			count @ 1 + count ! show-mucker
		else pop then
	repeat pop
	count @ footer
;

: main
	dup "#" 1 strncmp if muckers exit then
	
	1 strcut swap pop
	tolower case
		"{on|yes}" smatch when
			"You've been added to the Muckers list."
			me @ set-mucker
			.tell
		end
		"{off|no}" smatch when
			"You've been removed from the Muckers list."
			me @ unset-mucker
			.tell
		end
		default
			"Mucker List Clone -- by Wog" "green,bold" textattr .tell
			"---------------------------" "black,bold" textattr .tell
			"Usage:" "cyan,bold" textattr .tell
			"  muckers" "white,bold" textattr .tell
			"    Show the list." "white" textattr .tell
			"  muckers #on" "white,bold" textattr .tell
			"  muckers #yes" "white,bold" textattr .tell
			"    Add yourself to the Muckers list." "white" textattr .tell
			"  muckers #off" "white,bold" textattr .tell
			"  muckers #no" "white,bold" textattr .tell
			"    Remove yourself from the Muckers list." "white" textattr .tell
		end
	endcase
;
.
c
q
@set muckers-list.muf=VIEWABLE