( MUFmessageBoard v0.80   Copyright 5/31/91 by Garth Minette )
(                                           foxen@netcom.com )
( A program for storing and displaying multi-line messages   )
  
( This code may be freely distributed, and code from it may   
  used in other non-similar programs, but the author's name
  must be credited.                                          )
  
  
$include $lib/strings
$include $lib/props
$include $lib/match
$include $lib/lmgr
$include $lib/mesg
$include $lib/mesgbox
$include $lib/edit
$include $lib/editor
  
$def .sedit_std EDITOR
$def STRtolower tolower
$def DAYOFFSET 7800
  
  
( ***** Misc. Object ***** )
  
: get-day ( -- dayint)
    systime dup 86400 % time 60 * + 60 * + - - 86400 /
$ifdef DAYOFFSET
    DAYOFFSET -
$endif
;
  
  
$define showrange EDITdisplay $enddef
  
  
( ***** Message Board Object -- MBRD *****
    Display  [parm base dbref -- err]
    Add      [parm base dbref -- err]
    Kill     [parm base dbref -- err]
)
  
: MBRDparseinfo (refnum base dbref -- keywords protect? poster day subject)
    (format: player# day# subject$)
    (new:    $topicword safe? player# day# subject$)
    MBOX-msginfo
    dup "$" 1 strncmp not if
      1 strcut swap pop
      " " STRsplit " " STRsplit swap atoi swap
    else
      "" 0 rot
    then
    " " STRsplit swap atoi dbref swap
    " " STRsplit swap atoi swap
;
  
: MBRDreparseinfo (keywords protect? poster day subject -- infostr)
    rot owner rot rot
    swap intostr " " strcat swap strcat
    swap int intostr " " strcat swap strcat
    swap intostr " " strcat swap strcat
    swap ";" " " subst STRtolower " " strcat
    swap strcat "$" swap strcat
;
  
: MBRDsetinfo (refnum base dbref keywords protect? poster day subject -- )
    rot owner rot rot
    MBRDreparseinfo -4 rotate MBOX-setinfo
;
  
lvar tmp
: MBRDperms? (refnum base dbref -- bool)
    me @ owner tmp !
    MBRDparseinfo pop pop rot rot pop pop
    tmp @ dbcmp tmp @ "Wizard" flag? or
    tmp @ trigger @ getlink owner dbcmp or
    tmp @ trigger @ location owner dbcmp or
;
  
  
: MBRDlastread (dbref -- lastreadmesgnum)
    "_bbsread/" swap intostr strcat
    me @ owner swap getpropval
;
  
  
: MBRDset_lastread (lastreadnum dbref -- )
    "_bbsread/" swap intostr strcat
    me @ owner swap rot "" swap addprop
;
  
  
: MBRDdisplay-expire? (refnum base dbref -- bool)
    dup "_expire" getpropstr atoi
    dup not if pop pop pop pop 0 exit then
    -4 rotate MBRDparseinfo
    pop -4 rotate pop swap pop
    if pop pop 0 exit then
    get-day swap - <
;
  
  
  
: MBRDdisplay-header (topicstr refnum base dbref -- )
    3 pick 3 pick 3 pick MBRDparseinfo
    (topicstr refnum base dbref keywords protect? poster day subject)
    5 rotate 9 rotate dup if
        (If keyword is a negative number, don't display mesgs older than that)
        dup number? over atoi 0 < and if
            4 pick get-day - over atoi < if
                pop pop pop
                pop pop pop
                pop pop pop
                exit
            then
        then
  
        (If keyword is 'new', don't display messages older than 2 days)
        dup "new" stringcmp not
        get-day 6 pick - 3 >= and if
            pop pop pop
            pop pop pop
            pop pop pop
            exit
        then
  
        (If keyword isn't in the keywords of the message don't display it)
        instr not if
            pop pop pop pop
            pop pop pop exit
        then
    else
        pop pop
    then
    7 pick intostr 5 rotate if "} " else ") " then strcat
    4 rotate
    dup ok? if
        dup player? if name
        else pop "(Toaded Player)"
        then
    else pop "(Toaded Player)"
    then
    strcat "  " strcat
    rot get-day swap - 
    dup 7 < if
        dup not if pop "Today"
        else dup 1 = if pop "Yesterday"
            else intostr " days ago" strcat
            then
        then
    else 7 / dup 1 = if pop "Last week"
        else intostr " weeks ago" strcat
        then
    then
    " -- " strcat strcat swap
    strcat me @ swap notify
    pop pop pop
;
  
  
: MBRDdisplay-loop (topic base dbref lcv  -- )
    3 pick 3 pick MBOX-count swap
    begin
        over over <  if pop pop pop pop pop break then
        5 pick over 6 pick 6 pick
        3 pick 3 pick 3 pick MBRDdisplay-expire? if
          MBOX-delmesg pop
          swap 1 - swap
        else
          MBRDdisplay-header
          1 +
        then
    repeat
  
    "Use 'read <mesgnum>'to list a message.  Use 'read <keyword>' to list"
    me @ swap notify
    "messages with a keyword.  Use 'read -' to read the next message."
    me @ swap notify
;
  
  
: MBRDdisplay_next (base dbref -- err)
    (find the next message reference number)
    dup MBRDlastread 1 +
    3 pick 3 pick MBOX-num2ref
  
    (Was that the last message?)
    dup not if
       pop pop pop
       6 (No more messages to read.) exit
    then
    rot rot
  
    (remember that we've read this message)
    3 pick 3 pick 3 pick MBOX-ref2num
    over MBRDset_lastread
  
    (display the message)
    "" 4 pick 4 pick 4 pick MBRDdisplay-header
    MBOX-message showrange
    0 (No error.)
;
  
: MBRDdisplay (parmstr base dbref -- err)
    rot STRtolower -3 rotate (lowercase parmstr)
  
    begin (Not a loop.  Used for fake case, to provide breaks)
  
        (case "-":)
            (read next message after last read mesg)
        3 pick "-" strcmp not if
            rot pop
            MBRDdisplay_next
            exit
            break (Yes, I know the break is overkill)
        then
  
        (case "-recent":)
            (read all messages after last read mesg)
        3 pick "-recent" stringcmp not if
            rot pop
            begin
                over over MBRDdisplay_next
                0 sleep
            until
            pop pop
            break
        then
  
        (case "recent":)
            (display headers of messages after last read message)
        3 pick "recent" stringcmp not if
            (find refnum of message after last message read)
            rot pop "" rot rot
            dup MBRDlastread 1 +
            3 pick 3 pick MBOX-num2ref
  
            dup if
                MBRDdisplay-loop (topic base dbref lcv  -- )
            else
                6 exit (No more messages.)
            then
            break
        then
  
        (case <number>:)
            (Read a single message referred to by number)
        3 pick number?
        4 pick atoi 0 >= and if
            rot atoi rot rot
  
            (check to see if that reference is valid)
            3 pick 3 pick 3 pick MBOX-badref? if pop pop pop 2 exit then
  
            (remember that we've read this message)
            3 pick 3 pick 3 pick MBOX-ref2num
            over MBRDset_lastread
  
            (display the message)
            "" 4 pick 4 pick 4 pick MBRDdisplay-header
            MBOX-message showrange
            me @ "  " notify
            break
        then
  
        (default:)
            (display headers of messages, by topic or other criteria)
        1 MBRDdisplay-loop
  
    1 until (Not a loop.  Used for fake case.  breaks jump to after this line)
  
    0 (no error)
;
  
  
: MBRDreadlines ( -- {str_rng})
    0 .sedit_std pop
;
  
: MBRDadd (parmstr base dbref -- err)
    rot "=" STRsplit STRstrip swap STRstrip
    dup not if
        "What is the subject of this post?"
        me @ swap notify pop read STRstrip
    then
    swap
    dup not if
        "What keywords fit this post? (ie: art, building, place, personal)"
        me @ swap notify pop read STRstrip
    then
    0 me @ owner get-day 5 rotate MBRDreparseinfo rot rot
  
    ( infostr base dbref )
    MBRDreadlines
  
    (Stamp the name and time onto the message)
    "  " over 2 + 0 swap - rotate 1 +
    "From: " me @ name strcat
    me @ player? not if
        (if it's a puppet, then include the owner's name too)
        " (" strcat
        me @ owner name strcat
        ")" strcat
    then
    "  " strcat "%X %x %Z" systime timefmt strcat
    over 2 + 0 swap - rotate 1 +
  
    dup if
        dup 4 + rotate
        over 4 + rotate
        3 pick 4 + rotate
        MBOX-append
    else 4 (post cancelled)
    then
    0 (no error)
;
  
: MBRDkill (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
    3 pick 3 pick 3 pick MBRDperms? not if
        pop pop pop 3 exit  (not owner of mesgboard or poster)
    then
    MBOX-delmesg
    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 @ "Wizard" flag?
    me @ trigger @ getlink owner dbcmp or
    me @ trigger @ location owner dbcmp or not if
        pop pop pop 3 exit  (not owner of mesgboard or poster)
    then
    3 pick 3 pick 3 pick MBRDparseinfo
    4 rotate not -4 rotate MBRDsetinfo
    0 (no error)
;
  
  
  
lvar fromline
  
: MBRDedit (parmstr base dbref -- err)
    "" fromline !
    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 MBOX-message
  
    (Strip headers, if they are there)
    begin
        dup 1 + pick "  " strcmp not if
            dup 1 + rotate pop 1 - break
        then
        dup 1 + pick "From: " 6 strncmp not if
            dup 1 + rotate fromline ! 1 - continue
        then
        dup 1 + pick "Edited by: " 11 strncmp not if
            dup 1 + rotate pop 1 - continue
        then
        break
    repeat
  
    .sedit_std pop dup not if
        pop pop pop pop 5 (no error) exit
    then
  
    (Stamp the name and time onto the message)
    "  " over 2 + 0 swap - rotate 1 +
    "Edited by: " me @ name strcat
    me @ player? not if
        (if it's a puppet, then include the owner's name too)
        " (" strcat
        me @ owner name strcat
        ")" strcat
    then
    "  " strcat "%X %x %Z" systime timefmt strcat
    over 2 + 0 swap - rotate 1 +
  
    (Resave the From header, if there was one)
    fromline @ if
        fromline @ over 2 + 0 swap - rotate 1 +
    then
  
    dup 4 + rotate over 4 + rotate 3 pick 4 + rotate
    3 pick 3 pick 3 pick MBRDparseinfo
  
    me @ "Current subject: \"" 3 pick strcat "\"" strcat notify
    "Enter new subject, or press space and return to keep old one."
    me @ swap notify
    read STRstrip dup if swap then pop
  
    5 rotate
    me @ "Current keywords: \"" 3 pick strcat "\"" strcat notify
    "Enter new keywords, or press space and return to keep old ones."
    me @ swap notify
    read STRstrip dup if swap then pop
    -5 rotate
  
    swap pop get-day swap MBRDreparseinfo
    -4 rotate MBOX-setmesg
    0 (no error)
;
  
  
: MBRD-checkinit (basename dbref -- )
    (If MBOX doesn't exist yet, create it.)
    over over MBOX-count not if
        MBOX-create
    else
        pop pop
    then
;
  
  
  
( ***** Interface Object *****
)
$def basename "msgs"
  
: handle-errs
    dup not if pop me @ "Done." notify exit then
    dup 1 = if pop me @ "Should be a numeric parameter." notify exit then
    dup 2 = if pop me @ "Invalid message number." notify exit then
    dup 3 = if pop me @ "Permission denied." notify exit then
    dup 4 = if pop me @ "Cancelling post." notify exit then
    dup 5 = if pop me @ "Cancelling edit." notify exit then
    dup 6 = if pop me @ "No more messages." notify exit then
;
  
: get-bbsobj (default -- bbsdbref)
    dup "_bbsloc" getpropstr
    dup not if pop exit then
    dup number? not if pop exit then
    atoi dbref
    dup ok? not if pop exit then
    over owner over .controls
    if swap then pop
;
  
lvar bbsobj
: interface
    preempt
    "me" match me !
    trigger @ exit? if
        trigger @ location
        get-bbsobj bbsobj !
        basename bbsobj @ MBRD-checkinit
        trigger @ name
        dup "write" instring if
            pop basename bbsobj @ MBRDadd
            handle-errs
            me @ location me @ me @ name
            " finishes writing on the bulletin board." strcat
            notify_except
            exit
        then
        dup "erase" instring if
            pop basename bbsobj @ MBRDkill
            handle-errs exit
        then
        dup "edit" instring if
            pop basename bbsobj @ MBRDedit
            handle-errs
            me @ location me @ me @ name
            " finishes editing a message on the bulletin board." strcat
            notify_except
            exit
        then
        dup "protect" instring if
            pop basename bbsobj @ MBRDprotect
            handle-errs exit
        then
        pop basename bbsobj @ MBRDdisplay
        handle-errs exit
    then
    trigger @ get-bbsobj bbsobj !
    basename bbsobj @ MBRD-checkinit
    basename bbsobj @ MBRDdisplay
    handle-errs exit
;
