@edit fst3k_action.muf
1 99999 d
1 i
( fst3k_action.muf 04/10/01 by BoingDragon
  Holodeck Theater [Furry Science Theater 3000]
  This action in a room or parent sets it up to monitor cambot holodecks
  as part of the cambot system. Monitorable rooms must be registered in
  the fst3k environment as 'room/<channel number or name>:<room db>'. Note
  that the room db is read as a string, so shouldn't contain a # sign. 
 
  To set up, simply link an action 'fst3k' to the program and type 'fst3k'
  to set up the various command aliases and display usage.

  You need to set a channel with the 'channel' command initially to set up
  the 'ch' and 'channel' properties on the room that it will need.
)
 
$def ACTION_NAME "fst3k;channel;channels;lastline;printlog;viewlog;viewlast;theater;logs"
$def FST3K ME @ location
 
$def CLOSEUP_OPEN "<div class=\"vista\">"
$def CLOSEUP_CLOSE "</div>"

$include $lib/case
$include $lib/sort
lvar logname
lvar startline
lvar stopline
lvar inarg
lvar loglib
lvar shownumbers
lvar holodb
lvar index
lvar fst3k_parent
lvar count
lvar status
lvar temp
lvar age
 
(Begin Greywolf function block) 
: tell ( s -- : return message to user )
  me @ swap notify
;
()
: even? ( i -- 0|1 : return 1 if even, 0 if odd )
  2 % not
;
()
: extract-char ( s1 i -- s2 : return the ith character of s1 )
  dup 1 = if  ( handle i = 1 as special case to avoid error below )
   strcut pop exit
  then
  over over strcut pop  ( remove all characters after i )
  rot pop swap ( remove input string )
  (stack: s2 i )
  1 - strcut swap pop ( remove all characters before i )
;  
()
: split-remove ( s1 i -- s2 s3 : return strings on both sides of i )
  dup 1 = if ( handle i = 1 as special case to avoid error )
    strcut swap pop "" swap exit
  then
  over over strcut 
  (stack: s1 i s s3 )
  swap pop ( split off characters after i )
  (stack: s1 i s3 )
  rot rot 1 - strcut pop ( split off characters before i )
  (stack: s3 s2 )
  swap
;
()
: numeric? ( s1 -- 0|1 : returns 1 if numeric, 0 if not )
  dup "0" strcmp not if
    pop 1 exit
  then
  atoi 0 > if
    1
  else
    0
  then
;
()
: last-char ( s1 -- s2 : returns last character of s1 )
  dup strlen dup 2 < if
    pop exit
  then
  1 - strcut swap pop
;
()
: html-convert ( s1 s2 s3 -- s4 : convert key codes to html)
  (s1 = input string ; s4 = output string )
  (s2 = key code -- example '*' )
  (s3 = html code -- example 'b' )
  ()
  (note:  if this function is unable to get a 'clean' convert, it will 
   return the line with no changes.  The reasoning is that it is better 
   to leave things be than to convert wrongly.)
()
  rot
  (stack: * b s1 )
  dup 4 pick instr not if  ( if no "*" at all, leave line untouched )
    swap pop swap pop exit (clean stack and quit)
  then
  (stack:  * b s1 )
  0 "" 3 pick  ( stack: * b s1 counter rebuild workstring )
  begin
    dup 7 pick instr dup not if ( no more * to process )
      pop strcat
      swap even? if 
        swap pop   ( remove input string )
        break
      else
        (if odd occurrences of *, then something is wrong)
        (abort and return original string)
        pop
        break
      then
    then
    (stack: * b s1 counter rebuild workstring position )
    split-remove
    (stack: * b s1 counter rebuild part1 workstring )
    rot rot strcat swap
    (stack: * b s1 counter rebuild workstring )
()
    over last-char
    (stack: * b s1 counter rebuild workstring last-char )
    dup "<" strcmp not ( is < last character? )
    (stack: * b s1 counter rebuild workstring last-char i )
    swap 8 pick strcmp not or if  ( is * last character? )
      (stack: * b s1 counter rebuild workstring )
      swap 6 pick strcat swap ( if so, don't convert this time )
      continue
    then
()
    (stack: * b s1 counter rebuild workstring )
    dup 1 strcut pop 7 pick strcmp not if ( is * next character? )
      swap 6 pick strcat swap ( if so, don't convert this time )
      continue
    then
()
    (stack: * b s1 counter rebuild workstring )
    dup 1 strcut pop numeric? if ( is next character numeric? )
       over last-char numeric? if ( is previous character numeric? )
          swap 6 pick strcat swap ( if so, don't convert this time )
          continue
       then
    then
()
    3 pick even? if
      swap "<" 6 pick ">" strcat strcat strcat swap (stick tag after 'rebuild' portion )
    else
      swap "</" 6 pick ">" strcat strcat strcat swap (end bold html indicator )
    then
    rot 1 + rot rot ( increment counter, put back in stack )
  repeat
;
()
: bold-convert ( s1 -- s2 : convert *bold* to <b>bold</b> )
  "*" "b" html-convert
;
()
: italics-convert ( s1 -- s2 : convert /italics/ to <i>italics</i> )
  "/" "i" html-convert
;
()
: underline-convert ( s1 -- s2 : convert _underline_ to <u>underline</u> )
  "_" "u" html-convert
;
(End Greywolf function block)
 
: holodeck
  fst3k_parent @ "room/" FST3K "ch" getpropstr strcat getpropstr atoi dbref
;
 
: get-logname
  holodeck "logname" getpropstr logname ! 		( get the name of the current log )
; 
 
: log-prop
  "logs/" logname @ strcat
;
 
: log-propdir
  log-prop "/" strcat
;
 
: get-parent
  FST3K "fst3k" envprop pop dup #-1 dbcmp not if
    fst3k_parent !
  else
    pop
    FST3K fst3k_parent !
  then
;
 
: get-line
  loglib @ log-prop getpropval
;
 
: channels ( list all 'active' logs on all registered channels )
  ">> Available channels:" tell
  0 count !
  fst3k_parent @ "room/" nextprop index !
  begin
  index @ strlen while
    fst3k_parent @ index @ getpropstr atoi dbref holodb !
    holodb @ room? if
      holodb @ "library" envprop loglib ! pop
      loglib @ strlen if
        loglib @ atoi dbref loglib !
      else
        holodb @ loglib !
      then
      holodb @ "logname" getpropstr logname !
      loglib @ "logs/" logname @ strcat "/status" strcat getpropstr status !
      logname @ strlen status @ strlen and if
        count @ 1 + count !
        "   " index @ 5 strcut swap pop strcat ": " strcat logname @ strcat
        "                              " strcat 30 strcut pop "(" strcat 
        status @ strcat ")" strcat tell
      then
    then
    fst3k_parent @ index @ nextprop index !
  repeat
  count @ 0 = if
    "   No channels are active." tell
  then
  ">> use 'channel <channel number>' to select the channel to watch." tell
;
 
: channel
  inarg @ strlen not if
    channels
    exit
  then
  holodb @ room? if
    holodb @ "fst3k/" FST3K intostr strcat remove_prop
  then
  inarg @ "0" strcmp not inarg @ "off" strcmp not or if
    FST3K "ch" "0" setprop
    ">> Turning off monitor. <<" tell
    FST3K ME @ ">> " ME @ name strcat " turns off the monitor." strcat notify_except
    exit
  then
  fst3k_parent @ "room/" inarg @ strcat getprop if
    fst3k_parent @ "room/" inarg @ strcat getpropstr atoi dbref holodb !
    holodb @ "fst3k/" FST3K intostr strcat FST3K intostr setprop
    FST3K "ch" inarg @ setprop
    FST3K "channel" holodb @ setprop
    ">> You set the monitor to channel " inarg @ strcat " <<" strcat tell
    FST3K ME @ ">> " ME @ name strcat " sets the monitor to channel " strcat inarg @ strcat " <<" strcat notify_except
  else
    ">> That is not an active channel. <<" tell
  then
;
: viewrange
   get-logname
   get-line not if
    ">> There are no recorded lines in this log." tell
    exit
  then
  begin
  startline @ stopline @ <= while
    loglib @ log-propdir startline @ intostr strcat getpropstr inarg !
    inarg @ "||" instring if inarg @ "||" explode pop pop inarg ! then
    inarg @ strlen if
      shownumbers @ if
        "    " 4 startline @ intostr strlen - strcut pop 
        startline @ intostr strcat ": " strcat inarg @ strcat tell
      else
        inarg @
        "<BR>" "<br>" subst
        "I>"   "i>"   subst
        "B>"   "b>"   subst
        "U>"   "u>"   subst
        "P>"   "p>"   subst
        "<I>"  "<I."  subst
        "</I>" "</I." subst
        CLOSEUP_OPEN "<em><ul>" subst
        CLOSEUP_CLOSE "</ul></em>" subst
        inarg !
        COMMAND @ "printlog" strcmp if
          inarg @
          "/"  "<I>"        subst
          "*"  "<B>"        subst
          "_"  "<U>"        subst
          "/"  "</I>"       subst
          "*"  "</B>"       subst
          "_"  "</U>"       subst
          "[ " CLOSEUP_OPEN   subst
          " ]" CLOSEUP_CLOSE subst
          inarg !
          inarg @ "<hr" instring if
            " ------=====*=====------ " inarg !
          then
          inarg @ "(OOC)" instring not if
            inarg @ "<BR>" instr if
              inarg @ "<BR>" explode count !
              1 index !
              begin
              index @ count @ <= while
                inarg !
                "    " inarg @ striplead strcat tell
                index @ 1 + index !
              repeat
            else
              "    " inarg @ strcat tell
            then
          else
            "  " inarg @ strcat tell
          then
        else
          inarg @ italics-convert bold-convert underline-convert inarg !
          inarg @ "<!--" instring inarg @ " notes:" instring or inarg @ CLOSEUP_OPEN instring or if
            inarg @ tell
          else
            "<P>" inarg @ strcat "</P>" strcat tell
          then
        then
      then
    then
    startline @ 1 + startline !
  repeat
;
: viewlast
  get-logname
  logname @ strlen not if
    ">> There is no log for this channel" tell
    exit
  then
  get-line not if
    ">> There are no recorded lines in this log." tell
    exit
  then
  get-line stopline !
  0 shownumbers !
  inarg @ "#" instring 0 > if
    1 shownumbers !
    inarg @ "" "#" subst inarg !
  then
  inarg @ strlen 0 > if
    stopline @ inarg @ atoi - 1 + startline !
    startline @ 1 < if 1 startline ! then
  else
    stopline @ startline !
  then
  viewrange
;
: lastline
  get-logname
  logname @ strlen not if
    ">> There is no log for this channel" tell
    exit
  then
  get-line not if
    ">> There are no recorded lines in this log." tell
    exit
  then
  ">> The last line number is "
  get-line intostr strcat tell
;
: viewlog
  get-logname
  logname @ strlen not if
    ">> There is no log for this channel" tell
    exit
  then
  get-line not if
    ">> There are no recorded lines in this log." tell
    exit
  then
  get-line stopline !
  0 shownumbers !
  1 startline !
  inarg @ "#" instring 0 > if
    1 shownumbers !
    inarg @ "" "#" subst inarg !
  then
  inarg @ strlen 0 > if
    inarg @ "-" instring 0 > if
      inarg @ "-" explode pop atoi startline ! atoi stopline !
    else
      inarg @ atoi startline !
      inarg @ atoi stopline !
    then
  then
  viewrange
;
 
: logs
  0 count !
  ">> Available logs: + = campaign, - = archived, * = recording" tell
  inarg @ strlen 0 > if
    loglib @ "logs/" inarg @ strcat "/" strcat nextprop logname !
  else
    loglib @ "logs/" nextprop logname !
  then
  begin
  logname @ strlen 0 > while
    loglib @ logname @ getpropval 0 > if
      systime loglib @ logname @ "/time" strcat getpropval - age !
      1000000 age @ age @ 86400 % - 86400 / + intostr "|" strcat
      loglib @ logname @ "/status" strcat getpropstr "recording" strcmp if
        "-  \"" strcat
      else
        "*  \"" strcat
      then
      logname @ 5 strcut swap pop strcat
      "\"" strcat
      dup strlen 48 > if
        "  (" strcat
      else
        "                                                                                 " strcat
        48 strcut pop "(" strcat
      then
      age @ age @ 86400 % - 86400 / intostr strcat " days/" strcat
      loglib @ logname @ getpropval intostr strcat " lines)" strcat
      count @ 1 + count !
    else
      "+  " logname @ 5 strcut swap pop strcat
      loglib @ logname @ getprop if
        " (" strcat loglib @ logname @ getprop strcat ")" strcat
      then
      tell
    then
    loglib @ logname @ nextprop logname !
  repeat
  count @ 0 = if
    " None" tell
  else
    inarg @ strlen 0 > if
      ">> Displaying/sorting " count @ intostr strcat " logs for \"" strcat
      loglib @ "logs/" inarg @ strcat getprop strcat "\":" strcat tell
    else
      ">> Displaying/sorting " count @ intostr strcat " logs:" strcat tell
    then
    count @ sort
    begin
      count @ 0 > while
      8 strcut swap pop tell
      count @ 1 - count !
    repeat
  then
  ">> Done." tell
;

: help
  "How to use viewing commands:" tell
  "  theater          : Display commands and status." tell
  "  channels         : Displays the list of live channels." tell
  "  channel n        : Sets the active channel to n." tell
  "  channel off      : Turns off monitoring." tell
  "  viewlog          : Views the entire log." tell
  "  viewlog m        : Views line m of the log." tell
  "  viewlog m-n      : Views lines m through n of the log." tell
  "  viewlast         : Views the last recorded line." tell
  "  viewlast n       : Views the last n lines of the log." tell
  "  printlog         : Views the entire log as HTML." tell
  "  logs             : Lists available logs and their status." .tell
  "  Using # in the arg to viewlog or viewlast lists line numbers." tell
  "Current Status:" tell
  "  Recording: " FST3K "channel" getprop "recording" getpropstr strcat tell
  "  Current log: "
  FST3K "channel" getprop "logname" getpropstr logname ! logname @ strlen 0 > if
    logname @ strcat tell
    "  Log Length: " loglib @ "logs/" logname @ strcat getpropval intostr strcat tell
  else
    "none" strcat tell
  then
;
: main
  depth 0 > if inarg ! then
  TRIGGER @ name ACTION_NAME strcmp if
    TRIGGER @ ACTION_NAME setname
  then
  get-parent
  FST3K "ch" getprop dup if
    fst3k_parent @ "room/" FST3K "ch" getpropstr strcat getpropstr atoi dbref holodb !
    holodb @ room? if
      holodb @ "library" envprop loglib ! pop
    then
    loglib @ string? if
      loglib @ strlen 0 > if
        loglib @ atoi dbref loglib !
      else
        FST3K "channel" getprop loglib !
      then
    else
      FST3K "channel" getprop loglib !
    then
  then
  COMMAND @ case
    "fst3k" over strcmp not when help end
    "theater" over strcmp not when help end
    "channels" over strcmp not when channels end
    "channel" over strcmp not when channel end
    "lastline" over strcmp not when lastline end
    "viewlog" over strcmp not when viewlog end
    "printlog" over strcmp not when viewlog end
    "viewlast" over strcmp not when viewlast end
    "logs" over strcmp not when logs end
  endcase
;
.
c
q
@set fst3k_action.muf=L
@set fst3k_action.muf=sortlist: