"Beginning installation of cmd-bbs...
@prog cmd-bbs
1 99999 d
1 i
( cmd-bbs: $Date: 2004/03/11 20:57:41 $ $Revision: 1.8 $                      )
( Author: Garth Minette                                                       )
( Mods & Fixes By: Feaelin Moilar AKA Iain E. Davis                           )
(                  Wixenstyx AKA Jennifer A. Boeyink                          )
( Color By: Wixenstyx AKA Jennifer A. Boeyink                                 )
( --------------------------------------------------------------------------- )
( MUFmessageBoard v0.80   Copyright 5/31/91 by Garth Minette                  )
( A program for storing and displaying multi-line messages                    )
 
( Custom succ/osucc messages:
     @set <action>=_read:You read a note.
     @set <action>=_oread:%N reads a note.
     @set <action>=_write:You write a note.
     @set <action>=_owrite:%N writes a note.
)
 
( @set here=_bbs:yes    -- This room has a BBS )
( @set here=_bbsro:yes  -- This BBS is read only cept for owner )
( @set here=_bbslib:yes -- BBS library room )
( @set here=_bbspub:yes -- Public BBS can be in library lists )
( @set here=_bbsuse:123 -- Use this BBS, must be public )
( @set here=_expire:7   -- Messages expire in 7 days unless protected )
( @set here=_cmdprefix: -- Replaces 'bb' with the prefix in dialogs )
 
( Or, you can set some other object _storehere:yes, and then set that object )
( with the above props )
 
( Wizstuff...)
( @set here=~bbswiz:yes -- Board is public to Mages+ )
( @set here=@bbsadm:yes -- Board is public to Arches+ )
  
( @set *player=~/ban/bbs:yes -- Ban a player from using any bbs )
( @set *player=~/ban/bbswrite:yes -- Ban a player from writing any posts )
  
( We'll try some tricks... )
( You can set _bbslib but not _bbs to keep a bbs from being in a library )
( You can set _bbsuse but not _bbs to keep a bbs from being in a mirror )
( You can set _bbspub but not _bbs to make a bbs library only, storage room )
 
( @desc an object with @dbref or @$cmd/bbs to allow a 'look' at the board to )
( list the messages on the board.                                            )
 
( 
  $Log: cmd-bbs,v $
  Revision 1.8  2004/03/11 20:57:41  feaelin
  Incorporated color changes by Wixenstyx
  Applied bugfixes that Wixenstyx found
  Replaced call to EDITdisplay to EDITansi_display so you
  can use color in the body text of your messages.

  Revision 1.7  2004/03/10 06:18:31  feaelin
  Added some customization features.  With appropiate props, the commands can
  be changed.
  
  Revision 1.6  2000/12/19 20:23:26  feaelin
  General cleanup.
  
  Revision 1.5  2000/12/19 20:18:49  feaelin
  Documentation fixes.
  
  Revision 1.4  2000/12/19 20:16:42  feaelin
  Fixed an issue where a custom look would not properly trigger
  the 'bbread' event when looking at a bulletin board object.
)
 
$include $lib/strings
$include $lib/lmgr
$include $lib/mesg
$include $lib/mesgbox
$include $lib/edit
$include $lib/editor
$include $lib/glow
 
$def IndexRef     #0
$def IndexDir     "_bbs/"
$def BanProp      "~/ban/bbs"
$def BanWriteProp "~/ban/bbswrite"
$def notify       .wrapnotify
 
( ***** Misc. Object ***** )
 
lvar theboard lvar bbsindexprog
 
: conBBSlistnew ( i --   ) bbsindexprog @ "BBSlistnew"  call ;
: okpubboard?   ( d -- i ) bbsindexprog @ "okpubboard?" call ;
 
: mytell ( s -- )
  dup "bb" instring if
    loc @ "_cmdprefix" getpropstr dup "" strcmp if
      "bb" subst
    else
      pop
    then
  then
  me @ swap ansi_notify
;
 
: which-board
  loc @ "_bbslib" getpropstr .yes? if
    me @ "_prefs/bbs/board" getpropstr
    atoi dbref dup okpubboard? not if pop #-1 then
  else
    loc @ "_bbsuse" getpropstr dup if
      atoi dbref dup okpubboard? not if pop #-2 then
    else
      pop loc @ "_bbs" getpropstr .yes? if loc @ else #-3 then
    then
  then
  theboard !
;
 
: get-new ( mbrdref -- i )
  me @ "_prefs/bbs/new/" rot intostr strcat getpropval
  dup 0 < if pop 0 then 1 -
;
 
: set-new ( mbrdref i -- i )
  1 +
  me @ "_prefs/bbs/new/" 4 rotate intostr strcat rot setprop
;
 
: find-next ( base d -- i )
  swap "#/" strcat swap dup get-new
  dup 0 < if 3 popn 1 exit then ( handle msg 0/1 )
  ( base board curr )
  over 4 pick "#" "#/" subst getpropstr atoi
  1 begin over over >= while
    ( base board curr top cnt )
    4 pick 6 pick 3 pick intostr strcat getpropstr atoi
    4 pick > if ( found next ) break then
  1 + repeat
  -5 rotate 4 popn
;
 
: get-day ( -- dayint)
    systime dup 86400 % time 60 * + 60 * + - - 86400 /
;
 
( ***** Message Board Object -- MBRD *****
    Display  [parm base dbref -- err]
    Add      [parm base dbref -- err]
    Kill     [parm base dbref -- err]
)
 
: MBRDparseinfo (refnum base dbref -- keywords prot? hidden? poster day subject)
    (format: player# day# subject$)
    (new:    $topicword safe? player# day# subject$)
    (newer:  $topicword safe? hidden? player# day# subject$)
    MBOX-msginfo
    dup "$" 1 strncmp not if
      1 strcut swap pop
      " " STRsplit " " STRsplit swap atoi swap
      " " STRsplit swap atoi swap
    else
      "" 0 0 4 rotate
    then
    " " STRsplit swap atoi dbref swap
    " " STRsplit swap atoi swap
;
 
: MBRDoldparse (refnum base dbref -- keywords prot? poster day subject)
    MBOX-msginfo
    dup "$" 1 strncmp not if
      1 strcut swap pop
      " " STRsplit " " STRsplit swap atoi swap
    else
      "" 0 4 rotate
    then
    " " STRsplit swap atoi dbref swap
    " " STRsplit swap atoi swap
;
 
: MBRDreparseinfo (keywords protect? hidden? poster day subject -- infostr)
    swap intostr " " strcat swap strcat
    swap int intostr " " strcat swap strcat
    swap intostr " " strcat swap strcat
    swap intostr " " strcat swap strcat
    swap ";" " " subst tolower " " strcat
    swap strcat "$" swap strcat
;
 
: MBRDsetinfo (refnum base dbref keywords prot? hidden? poster day subject -- )
    MBRDreparseinfo -4 rotate MBOX-setinfo
;
 
: MBRDperms? (refnum base dbref -- bool)
    MBRDparseinfo pop pop swap pop rot rot pop pop
    dup ok? if me @ swap controls else pop 1 then
    me @ theboard @ controls or
;
 
: MBRDdisplay-expire? (refnum base dbref -- bool)
    dup "_expire" getpropstr atoi
    dup not if pop pop pop pop 0 exit then
    -4 rotate MBRDparseinfo
    pop -5 rotate pop pop swap pop
    if pop pop 0 exit then
    get-day swap - <
;
 
: MBRDhidden? (refnum base dbref -- bool)
    MBRDparseinfo
    pop pop pop -3 rotate pop pop
;
 
: MBRDdisplay-header (topicstr refnum base dbref -- )
    3 pick 3 pick 3 pick MBRDparseinfo
    (topicstr refnum base dbref keywords protect? hidden? poster day subject)
    6 rotate 10 rotate dup if
        dup "recent" stringcmp not
        get-day 6 pick - 8 < and
        over "new" stringcmp not
        get-day 7 pick - 3 < and or
        not (rot rot) swap pop swap pop
        (instr not and) if
            pop pop pop pop
            pop pop pop pop exit
        then
    else
        pop pop
    then
    8 pick intostr 6 rotate if "}^RESET^" else ")^RESET^" then strcat
    "^WHITE^" swap strcat
    "    " swap strcat dup ansi_strlen 4 - strcut swap pop ( padding )
    5 rotate if "*" else " " then strcat
    4 rotate
    dup ok? if
        dup player? if name "^RESET^" strcat "^GREEN^" swap strcat
        else pop "^GLOOM^(Toaded Player)^RESET^"
        then
    else pop "^GLOOM^(Toaded Player)^RESET^"
    then
    strcat "  " strcat
    rot get-day swap - 
    dup 7 < if
        dup not if pop "^CYAN^Today^RESET^"
        else dup 1 = if pop "^CYAN^Yesterday^RESET^"
            else intostr " days ago^RESET^" strcat
              "^CYAN^" swap strcat
            then
        then
    else 7 / dup 1 = if pop "^AQUA^Last week^RESET^"
        else intostr " weeks ago^RESET^" strcat "^AQUA^" swap strcat
        then
    then
    "^WHITE^ -- ^YELLOW^" strcat strcat swap
    strcat me @ swap ansi_notify
    pop pop pop
;
  
: MBRDdisplay-loop (topic base dbref cnt lcv  -- )
    over over <  if pop pop pop pop pop exit then
    5 pick over 6 pick 6 pick
    3 pick 3 pick 3 pick MBRDdisplay-expire? if
      MBOX-delmesg pop
      swap 1 - swap
    else
      3 pick 3 pick 3 pick MBRDhidden? not
      me @ theboard @ controls or if
          MBRDdisplay-header
      else pop pop pop pop
      then
      1 +
    then
    MBRDdisplay-loop
;
  
: bbs-index-help ( -- )
"'bbnew' shows unread boards, 'bbindex' lists all boards." mytell
"'bbindex <num>' selects that board to read from." mytell
;
  
: MBRDdisplay (parmstr base dbref -- err)
    " " mytell
    "^YELLOW^Message List:" mytell
    " " mytell
    3 pick number? if
        rot atoi rot rot
        3 pick 3 pick 3 pick MBOX-badref? if pop pop pop 2 exit then
        3 pick 3 pick 3 pick MBRDhidden? me @ theboard @ controls not and
        if pop pop pop 2 exit then
        "" 4 pick 4 pick 4 pick MBRDdisplay-header
        3 pick 3 pick 3 pick MSG-item atoi
        over swap set-new
        MBOX-message EDITansi_display
        " " mytell
    else
        rot tolower -3 rotate
        over over MBOX-count
        1 MBRDdisplay-loop
        " " mytell
        "^WHITE^'^CYAN^bbnext^WHITE^' reads next unread message, '^CYAN^bbnext <count>^WHITE^' reads multiple." mytell
        "^WHITE^'^YELLOW^bbread^WHITE^' lists all messages, '^YELLOW^bbread <num>^WHITE^' reads that message." mytell
        "^WHITE^'^GREEN^bbwrite^WHITE^' posts a new message, it prompts you for what it needs." mytell
        loc @ "_bbslib" getpropstr .yes? if bbs-index-help then
    then
    0 (no error)
;
  
: MBRDreadlines ( -- {str_rng})
    0 EDITOR pop
;
  
: MBRDadd (parmstr base dbref -- err)
    dup "_bbsro" getpropstr .yes? if
      dup me @ swap controls not if pop pop pop 6 exit then
    then
    rot "=" STRsplit STRstrip swap STRstrip
    dup not if
        "^YELLOW^What is the subject of this post?"
        mytell pop read STRstrip
    then
    swap
    dup not if
        "^YELLOW^What ^RED^keywords^YELLOW^ fit this post? (ie: art, building, place, personal)"
        mytell pop read STRstrip
    then
    0 0 me @ get-day 6 rotate MBRDreparseinfo rot rot
  
    ( infostr base dbref )
    MBRDreadlines
    dup if
        dup 4 + rotate
        over 4 + rotate
        3 pick 4 + rotate
        MBOX-append pop
        "^SUCC^Message posted." mytell 0 (no error)
    else pop pop pop pop 4 (post cancelled) then
;
  
: MBRDkill (parmstr base dbref -- err)
    dup "_bbsro" getpropstr .yes? if
      dup me @ swap controls not if pop pop pop 6 exit then
    then
    rot dup number? not if pop pop pop 1 exit then
    atoi rot rot
    3 pick 3 pick 3 pick MBOX-badref? if pop pop pop 2 exit then
    3 pick 3 pick 3 pick MBRDperms? not if
        pop pop pop 3 exit  (not owner of mesgboard or poster)
    then
    3 pick 3 pick 3 pick MBRDhidden? me @ theboard @ controls not and if
        pop pop pop 2 exit
    then
    MBOX-delmesg
    "^SUCC^Message erased." mytell 0 (no error)
;
  
: MBRDprotect (parmstr base dbref -- err)
    rot dup number? not if pop pop pop 1 exit then
    atoi rot rot
    3 pick 3 pick 3 pick MBOX-badref? if pop pop pop 2 exit then
    me @ theboard @ controls not if
        pop pop pop 3 exit  (not owner of mesgboard or poster)
    then
    3 pick 3 pick 3 pick MBRDparseinfo
    5 rotate not -5 rotate MBRDsetinfo
    "^SUCC^Message protected." mytell 0 (no error)
;
  
: MBRDhide (parmstr base dbref -- err)
    rot dup number? not if pop pop pop 1 exit then
    atoi rot rot
    3 pick 3 pick 3 pick MBOX-badref? if pop pop pop 2 exit then
    me @ theboard @ controls not if
        pop pop pop 3 exit  (not a Wizard)
    then
    3 pick 3 pick 3 pick MBRDparseinfo
    4 rotate not -4 rotate MBRDsetinfo
    "^SUCC^Message hidden." mytell 0 (no error)
;  
  
: MBRDedit (parmstr base dbref -- err)
    dup "_bbsro" getpropstr .yes? if
      dup me @ swap controls not if pop pop pop 6 exit then
    then
    rot dup number? not if pop pop pop 1 exit then
    atoi rot rot
    3 pick 3 pick 3 pick MBOX-badref? if pop pop pop 2 exit then
    3 pick 3 pick 3 pick MBRDperms? not if
        pop pop pop 3 exit  (not owner of mesgboard or poster)
    then
    3 pick 3 pick 3 pick MBRDhidden? me @ theboard @ controls not and if
        pop pop pop 2 exit
    then
    3 pick 3 pick 3 pick MBOX-message
    EDITOR pop dup not if
        pop pop pop pop 5 (no error) exit
    then
    dup 4 + rotate over 4 + rotate 3 pick 4 + rotate
    3 pick 3 pick 3 pick MBRDparseinfo
  
    me @ "^INFO^Current subject: \"^NOTE^" 3 pick strcat "^INFO^\"" strcat notify
    "^INFO^Enter new subject, or ^RED^press space and return^INFO^ to keep old one."
    mytell read STRstrip dup if swap then pop
  
    6 rotate
    me @ "^INFO^Current keywords: \"^NOTE^" 3 pick strcat "^INFO^\"" strcat notify
    "^INFO^Enter new keywords, or ^RED^press space and return^INFO^ to keep old ones."
    mytell read STRstrip dup if swap then pop
    -6 rotate
  
    swap pop get-day swap MBRDreparseinfo
    -4 rotate MBOX-setmesg
    "Message edited." mytell 0 (no error)
;
  
: MBRDnext (parmstr base dbref -- err)
  over over find-next 4 rotate atoi
  dup 1 < if pop 1 then
  ( base board next# cnt )
  begin dup while
    over intostr 5 pick 5 pick
    MBRDdisplay if
"^FAIL^No more unread messages.  Type 'bbclear' to go back to the first message." 
      mytell break
    then
    1 - swap 1 + swap
  repeat 4 popn
  0 (no error)
;
  
: BBSsetboard ( i -- )
  1 IndexRef IndexDir nextprop
  begin dup while
    ( Board# Count Prop )
    IndexRef over getpropstr atoi dbref okpubboard? if
      3 pick 3 pick = if break then
      swap 1 + swap
    then
    IndexRef swap nextprop
  repeat rot rot pop pop
  dup if
    IndexRef swap getpropstr atoi dbref
    dup okpubboard? if
      me @ "_prefs/bbs/board" 3 pick intostr setpropstr
      "^INFO^You are now reading the board at ^GREEN^"
      swap name strcat "^INFO^." strcat mytell
    else pop "^FAIL^That board is not set public." mytell then
  else pop "^FAIL^Which board?" mytell then
;
  
: BBSlistnew ( s i -- )
  over over and if
    pop atoi BBSsetboard exit
  else swap pop conBBSlistnew then
  me @ "_prefs/bbs/board" getpropstr dup atoi dbref
  dup okpubboard? rot and if
    "You are currently reading the board at ^GREEN^"
    swap name strcat "^YELLOW^." strcat mytell
  else pop "^FAIL^You are currently not reading any board." mytell then
  " " mytell
  bbs-index-help
;
  
: BBSclearnew ( d -- i ) ( Clear newest read message )
  me @ "_prefs/bbs/new/" rot intostr strcat remove_prop
  "^INFO^Index reset to first message." mytell
;
  
: bbshelp ( -- )
  "^YELLOW^Bulletin Board Help Screen" mytell
  "^GREEN^~~~~~~~~~~~~~~" mytell
  "^YELLOW^bbread^WHITE^      -- List all messages for the current board" mytell
  "^YELLOW^bbnext ^WHITE^     -- Read the next unread message" mytell
  "^YELLOW^bbnext <n> ^WHITE^ -- Read the next 'n' messages." mytell
  "^YELLOW^bbread <m>^WHITE^  -- Read message 'm' (sets 'next' count)" mytell
  "^YELLOW^bbclear ^WHITE^    -- Reset 'next' count to first message of board" mytell
  "               ^WHITE^This will remove a board from your 'new' list" mytell
  " " mytell
  "^CYAN^bbindex  ^WHITE^   -- List all public boards" mytell
  "^CYAN^bbindex <n>^WHITE^ -- Change to read board 'n' at a library of boards" mytell
  "^CYAN^bbnew   ^WHITE^    -- List boards you have read before with new messages" mytell
  " " mytell
  "^GREEN^bbwrite   ^WHITE^  -- Post a message" mytell
  "^GREEN^bberase <m> ^WHITE^-- Delete a message " mytell
  "^GREEN^bbedit <m> ^WHITE^ -- Edit a message " mytell
  "^GREEN^bbhide <m> ^WHITE^ -- Hide a message" mytell
  "^GREEN^bbkeep <m> ^WHITE^ -- Keep a message from expiring" mytell
;
  
( ***** Interface Object *****
)
: basename "_bbs/msgs" ;
  
: handle-errs ( i -- )
    ( dup not if pop "^SUCC^Done." mytell exit then )
    dup not if pop exit then
    dup 1 = if pop "^FAIL^Should be a number." mytell exit then
    dup 2 = if pop "^FAIL^Invalid message number." mytell exit then
    dup 3 = if pop "^FAIL^Permission denied." mytell exit then
    dup 4 = if pop "^FAIL^Cancelling post." mytell exit then
    dup 5 = if pop "^FAIL^Cancelling edit." mytell exit then
    dup 6 = if pop "^FAIL^Board is read only." mytell exit then
    pop "^FAIL^Unknown error." mytell exit
;
  
: handle-succs-and-osuccs
  trig "_" command @ strcat getpropstr
  dup if me @ swap pronoun_sub mytell else pop then
  trig "_o" command @ strcat getpropstr
  dup if me @ swap pronoun_sub .otell else pop then
;
  
: interface ( s -- )
  .noguest
  "me" match dup me !
  trig "_storehere" getpropstr "y" instring if 
    pop trig loc !
  else
    location loc !
  then
  me @ BanProp getpropstr .yes? if
    pop "^RED^You are banned from using bulletin boards." mytell exit
  then
  "$con/bbsindex" match dup program? not if
    "$con/bbsindex does not exist, cannot run." mytell pop exit
  then bbsindexprog !
  trig exit? not if
    dup if
      " " .split swap
    else 
      "bbread" 
    then
    command !
  else
    trig name "look" instring if
      dup if
        " " .split swap
      else
        "bbread"
      then
      command !
    then
  then
  which-board
  theboard @ #-2 dbcmp if
    "^FAIL^The board mirrored here is bad, please tell the room owner."
    mytell pop exit
  then
  handle-succs-and-osuccs
  command @
  dup "help" instring if
    pop pop BBShelp exit
  then
  dup "new" instring if
    pop 0 BBSlistnew exit
  then
  theboard @ #-3 dbcmp if
    pop pop "^FAIL^There is no bulletin board here.  Type 'bbhelp' for help."
    mytell exit
  then
  dup "index" instring if
    loc @ "_bbslib" getpropstr .yes? if
      pop 1 BBSlistnew exit
    else "^FAIL^You are not at a library.  Type 'bbhelp' for help."
    mytell pop pop exit then
  then
  theboard @ #-1 dbcmp if
    "^FAIL^You need to select a board to read.  Type 'bbindex' to list boards."
    mytell pop pop exit
  then
  dup "read" instring if
    pop basename theboard @ MBRDdisplay
    handle-errs exit
  then
  dup "next" instring if
    pop basename theboard @ MBRDnext
    handle-errs exit
  then
  dup "clear" instring if
    pop pop theboard @ BBSclearnew
    exit
  then
  me @ BanWriteProp getpropstr .yes? if
    "^FAIL^You are banned from writing on bulletin boards." mytell
    pop pop BBShelp exit
  then
  dup "write" instring if
    pop basename theboard @ MBRDadd
    handle-errs exit
  then
  dup "erase" instring if
    pop basename theboard @ MBRDkill
    handle-errs exit
  then
  dup "edit" instring if
    pop basename theboard @ MBRDedit
    handle-errs exit
  then
  dup "keep" instring if
    pop basename theboard @ MBRDprotect
    handle-errs exit
  then
  dup "hide" instring if
    pop basename theboard @ MBRDhide
    handle-errs exit
  then
  pop pop BBShelp exit
;
  
: debug-bbs ( s -- )
  interface
  depth if
    depth "^FAIL^Bad stack depth: ^INFO^" swap intostr strcat mytell
    .debug-line
  then
;
.
c
q
@register cmd-bbs=cmd/bbs
@register #me cmd-bbs=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=W2
@set $tmp/prog1=/_/de:@$desc %list[doc]
@set $tmp/prog1=/_defs/.eval-loop:"$desc" match "eval-loop" call
@set $tmp/prog1=/_defs/.format-print:"$desc" match "format-print" call
@set $tmp/prog1=/_defs/.gen-desc:"$desc" match "gen-desc" call
@set $tmp/prog1=/_defs/.get-legal-prop:"$desc" match "get-legal-prop" call
@set $tmp/prog1=/_defs/.split-args:"$desc" match "split-args" call
@set $tmp/prog1=/_defs/.wipe-list:"$desc" match "wipe-list" call
@set $tmp/prog1=/_docs:@list $cmd/bbs=1-33
@action bbhelp;bbread;bbnext;bbindex;bbnew;bbwrite;bbedit;bbhide;bberase;bbkeep;bbclear;read;write;erase;protect=here=tmp/exit1
@link $tmp/exit1=$tmp/prog1
@set $tmp/exit1=M3
@set $tmp/exit1=/_/de:@$cmd/bbs
@set $tmp/prog1=_version:0.80FM$Revision: 1.8 $
"Installation of cmd-bbs complete.