@program filter-contents-cats.muf
1 9999 d
i
( filter-contents-cats.muf version 1.0 by Wog

	A look-filter for Jaffa's cmd-look.

	Gives seperate categories for a lot things...
	Namely:
	  1> Players
	  2> Vehicles
	  3> Things
	  4> Programs
	  And if a $def is set below:
	  5> Puppets
	  And for a rare special case:
	  6> Rooms

  INITIAL SETUP:
   @propset #<look-proggie>=dbref:_reg/look-filter/concats:<this proggie>
	  
--- Change History ----------------------------------
v 1.0	Apr 16 2000
    Initial Release
--- Distrubution 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
)
$include $lib/look-install

$ifdef ansi-support
$ifdef colorized
$include $lib/look-color
$endif
$else
$undef colorized
$endif

( You may want to change these....  $def means on, $undef means off. )
$undef PUPPET_CATEGORY
$def PLAYER_ALSEEP_APPEND
(Set to "Things:" for a Things: label, $undef for the standard label... )
$undef THING_CAT_NAME ("Things:")
( End of them you might want to change... )

$include $lib/fake
$def tmpdir "_t" prog intostr strcat

(This [the numbers here] defines the order things show in...)
(NOTE: Every one of these should have the same number of digits to work...)
(NONE OF THESE CAN BE ZERO!)
$def cat-player		1
$def cat-vehicle	3
$ifdef PUPPET_CATEGORY
$def cat-puppet		2
$endif
$def cat-vehicle	3
$def cat-thing		4
$def cat-program	5
(We have a rare special case here...)
$def cat-rooms		6

(Returns a category integer for an object...)
: findCategory ( d -- i )
  dup fake? if
    pop cat-thing exit
  then
  
  dup program? if pop cat-program exit then
  
  dup thing? if dup "V" flag? else 0 then
  if
    pop cat-vehicle exit
  then
  
$ifdef PUPPET_CATEGORY
(Advanced programmers can change this logic...)
  dup thing? if dup "Z" flag? over "X" flag? or else 0 then
  if
    pop cat-puppet exit
  then
$endif
  dup player?
$ifndef PUPPET_CATEGORY
  over thing? if over "Z" flag? 3 pick "X" flag? or or then
$endif
  if pop cat-player exit then

  room? if cat-rooms exit then
  cat-thing
;

$ifdef colorized
$def label-color "contents" add-color
$else
$def label-color ( Do Nothing! )
$endif
: catLabel ( i -- s )
  dup cat-player = if pop "Players:" label-color exit then
  dup cat-vehicle = if pop "Vehicles:" label-color exit then
  dup cat-program = if pop "Programs:" label-color exit then
$ifdef PUPPET_CATEGORY
  dup cat-puppet = if pop "Puppets:" label-color exit then
$endif
  (-) cat-rooms = if (-) "Rooms:" label-color exit then
  (Otherwise things...)
$ifdef THING_CAT_NAME
  THING_CAT_NAME label-color
$else
  me @ tmpdir "/_head" strcat getpropstr
$endif
;

$def kill-tempdir me @ tmpdir remove_prop

: main
  over 4 < if exit then
  over 4 = if
    me @ tmpdir "/_head" strcat rot setprop "" exit
  then
  (Temp store in /c/<catid>:...)
  over 5 = if
    trigger @ ok? if 
      trigger @ .person?
      if trigger @ awake? not if
        " [asleep]" $ifdef colorized "refs" add-color $endif strcat
      then then
    then
(Patch for compatibility with horiz look-filter...)
(
$ifdef colorized
$ifdef __glowver
    "^reset^" strcat
$else
    "~&R" strcat
$endif
$endif
)
    trigger @ findCategory
    intostr tmpdir "/c/" strcat swap strcat
    me @ over getpropstr dup if "\r" strcat then rot strcat
    me @ -3 rotate setprop
    "" exit
  then
  over 6 = if exit then
  over 99 = if pop pop
  ( For output...
    Props: where:FULL PROPDIR NAME!
           mode:1 if need header )
    me @ tmpdir "/where" strcat
    getpropstr
    dup not if
      pop
      me @ tmpdir "/c/" strcat nextprop
      me @ tmpdir "/where" strcat
      3 pick setprop
      dup not if pop kill-tempdir 99 "" exit then
      1
    else me @ tmpdir "/mode" strcat getpropval then 
    if
      tmpdir strlen 3 +
      strcut
      swap pop
      atoi catLabel 4 swap
      me @ tmpdir "/mode" strcat 0 setprop
      exit
    then 
    me @ over getpropstr
    dup not if 
      pop
      me @ swap nextprop
      dup not if pop kill-tempdir 99 "" exit then
      me @ tmpdir "/where" strcat rot setprop
      me @ tmpdir "/mode" strcat 1 setprop
      98 "" exit
    then
    dup "\r" instr
    dup not if
      pop 5 swap
      rot me @ swap "" setprop
      exit
    then
    1 - strcut 1 strcut swap pop
    ( prop extract old )
    rot
    swap
    me @ -3 rotate setprop
    5 swap exit
  then
;
.
c
q
@set filter-contents-cats.muf=VIEWABLE
@set filter-contents-cats.muf=info:A contents categorizing filter. [written by Wog]
@set filter-contents-cats.muf=fake_ok:yes
@set filter-contents-cats.muf=order:800