@q
@program lib-jcolor
1 9999 d
i
 
( lib-jcolor    v1.0    Jessy @ FurryMUCK    11/99
  
  lib-jcolor provides a consistent, simplified interface to Caspian's
  lib-ansi-free.muf, reducing the amount of rework that will be needed
  to color-enable existing programs and allowing users to store a 
  single set of color preferences for all programs that use this 
  interface.
  
  INSTALLATION:
  
  Set lib-jcolor M3 and Link_OK. lib-ansi-free.muf must be installed.
  lib-ansi-free.muf requires special setup. Register lib-jcolor as
  lib/jcolor:
    
  	@reg lib-jcolor=lib/jcolor
  
  Set the following definition props on lib-jcolor:
  
    _defs/colorstr:"$lib/jcolor" match "colorstr" call
    _defs/colornotify:"$lib/jcolor" match "colornotify" call
    _defs/colornotifyexcept:"$lib/jcolor" match "colornotifyexcept" call
    _defs/colorobj:"$lib/jcolor" match "colorobj" call
    _defs/colortell:"$lib/jcolor" match "colortell" call
  
  
)
  
$include $lib/ansi
  
$define
  puppet?
  dup "Z" flag?
  swap thing? and if
    1
  else
    0
  then
$enddef
 
: colorstr  ( d s1 s2 -- s' )  (* format s1 for user d & data type s2 *)
  
                    (* check: user-specified color pref for obj type? *)
  3 pick "_prefs/colors/" 3 pick strcat getpropstr dup if
  	swap pop
    "~&" swap strcat swap strcat "~&R" strcat        (* if so, format *)
  	swap pop
  else
             (* check: globally specified color pref for object type? *)
  pop rot pop
  prog "_colors/" rot strcat getpropstr dup if
    "~&" swap strcat swap strcat "~&R" strcat        (* if so, format *)
  else
    pop                                     (* otherwise, leave alone *)
  then then
;
public colorstr
 
: colorobj  ( d1 d2 -- s )    
        (* return color-formatted name string for d2, formated for d1 *)
  
  dup exit? if                                  (* this way for exits *)
    name dup ";" instr if                       (* strip exit aliases *)
  	  dup ";" instr 1 - strcut pop
  	then
  	"exit" colorstr                                         (* format *)
  else
  dup player? if                              (* this way for players *)
    over over controls if
  	  dup unparseobj
  	else
  	  dup name
  	then                             (* add connection info if pref'd *)
  	3 pick "_prefs/look/flags" getpropstr "C" instr if
      over awake? if
        over descriptors
        begin dup 1 > while rot pop 1 - repeat
        not if -1 exit then
        descrcon conidle
        300 > if
          " [idle]"
        else
          " [awake]"
        then
      else
        " [asleep]"
      then
  	  strcat
  	then
  	"player" colorstr
  else
  dup puppet? if                              (* this way for puppets *)
    over over controls if
  	  dup unparseobj
  	else
  	  dup name
  	then                             (* add connection info if pref'd *)
  	3 pick "_prefs/look/flags" getpropstr "C" instr if
      over owner awake? if
        over owner descriptors
        begin dup 1 > while rot pop 1 - repeat
        not if -1 exit then
        descrcon conidle
        300 > if
          " [idle]"
        else
          " [awake]"
        then
      else
        " [asleep]"
      then
  	  strcat
  		"*" strcat
  	then
  	"puppet" colorstr
  else
  dup thing? if                                (* this way for things *)
    over over controls if
  	  unparseobj
  	else
  	  name
  	then
  	"thing" colorstr
  else
  dup program? if                            (* this way for programs *)
    over over controls if
  	  unparseobj
  	else
  	  name
  	then
  	"program" colorstr
  else
  dup room? if                                  (* this way for rooms *)
    over over controls if
  	  unparseobj
  	else
  	  name
  	then
  	"room" colorstr
  then then then then then then
;
public colorobj
 
: colortell  ( s1 s2 --  )  
                   (* notify user with s1, formatted for data type s2 *)
   
  me @ ansi? if
    me @ rot rot colorstr
    me @ swap ansi-notify
  else
    pop me @ swap ansi-strip notify
  then
;
public colortell
 
: colornotify  ( d s1 s2 --  )
                  (* notify obj d with s1, formatted for data type s2 *)
  
  3 pick ansi? if
    3 pick rot rot
  	colorstr ansi-notify
  else
    pop ansi-strip notify
  then
;
public colornotify
 
: colornotifyexcept  ( d1 d2 s1 s2 --  )
                             (* notify all at location d1 except for 
                                d2 with s1, formatted as data type s2 *)
  
  4 rotate contents
  begin
    dup while
  	dup 5 pick dbcmp not if
      dup 4 pick 4 pick colornotify
  	then
  	next
  repeat
  pop pop pop pop
;
public colornotifyexcept
 
: help                                            (* show help screen *)
  
  "Help!" .tell
;
 
: main                                             (* set color prefs *)
  
  dup if
    "#help" over stringpfx if help exit then
    dup "=" instr if
  	  dup "=" instr strcut strip
  		swap strip dup strlen 1 - strcut pop strip 
  		me @ "_prefs/colors/" rot strcat rot setprop
  		"Set." "output" colorstr colortell
    else
  	  ">>  Syntax:  $command <data type>=<color code>
  		command @ "$command" subst
  		"error" colorstr colortell
  	then
  else
    help
  then
;
.
c
q
@set lib-jcolor=l
@reg lib-jcolor=lib/jcolor
@set lib-jcolor=_defs/colorstr:"$lib/jcolor" match "colorstr" call
@set lib-jcolor=_defs/colornotify:"$lib/jcolor" match "colornotify" call
@set lib-jcolor=_defs/colornotifyexcept:"$lib/jcolor" match "colornotifyexcept" call
@set lib-jcolor=_defs/colorobj:"$lib/jcolor" match "colorobj" call
@set lib-jcolor=_defs/colortell:"$lib/jcolor" match "colortell" call