: say ( s -- ) me @ swap notify ; : formfitstr ( s -- s ) " " swap strcut pop over strlen strcut swap pop ; : prepend ( s -- s ) formfitstr swap strcat ; : append ( s -- s ) formfitstr strcat ; : get_age ( i i -- s ) swap - dup 31449600 / dup if swap pop intostr dup atoi 1 = not if " years ago" else " year ago" then strcat exit then pop dup 2620800 / dup if swap pop intostr dup atoi 1 = not if " months ago" else " month ago" then strcat exit then pop dup 604800 / dup if swap pop intostr dup atoi 1 = not if " weeks ago" else " week ago" then strcat exit then pop dup 86400 / dup if swap pop intostr dup atoi 1 = not if " days ago" strcat else pop "Yesterday" then exit then pop pop "Today" ; : mainmenu ( -- ) "Welcome to " trigger @ ".title" getpropstr strcat say " " say "# Subject Author" " Posted When" strcat say "-------------------------------------" "---------------------------------------" strcat say trigger @ ".nmsg" getpropstr atoi dup not if pop " No current news" say exit then 1 swap 1 for dup intostr 2 append " " strcat trigger @ 3 pick intostr ".msg" swap strcat "-1" strcat getpropstr 25 append strcat " " strcat trigger @ 3 pick intostr ".msg" swap strcat "-2" strcat getpropstr atoi dbref name 16 append strcat " " strcat trigger @ 3 pick intostr ".msg" swap strcat "-3" strcat getpropstr atoi dup ctime 4 strcut swap pop 6 strcut 10 strcut swap pop ", " swap strcat strcat rot swap strcat " " strcat swap systime get_age strcat say 15 % not if " " say "Type to continue, 'q' to quit: " prompt " " say tolower "q" 1 strncmp not if break then then loop "Done." say ; : getmsg ( i i -- s ) trigger @ ".msg" 4 rotate intostr strcat "-" strcat rot intostr strcat getpropstr ; : writemsg ( s i i -- ) trigger @ ".msg" 4 rotate intostr strcat "-" strcat rot intostr strcat rot 0 addprop ; : exists? ( i i -- i ) trigger @ ".msg" 4 rotate intostr strcat "-" strcat rot intostr strcat prop-exists? ; : increment ( i -- ) 1 + trigger @ ".nmsg" 3 pick intostr 0 addprop dup 1 - 1 -1 for 1 begin over over exists? while over over getmsg 3 pick 1 + 3 pick writemsg 1 + loop pop 1 begin over over exists? while trigger @ ".msg" 4 pick intostr strcat "-" strcat 3 pick intostr strcat remove_prop 1 + loop pop pop loop pop pop ; : do_add ( -- ) trigger @ "*uselock" getpropstr if "News is being edited. Try again later." say exit then trigger @ "*uselock" "yes" 0 addprop trigger @ ".nmsg" getpropstr atoi dup if increment else trigger @ ".nmsg" "1" 0 addprop then "Enter the subject of this posting (25 chars max): " prompt 25 strcut pop trigger @ ".msg1-1" rot 0 addprop trigger @ ".msg1-2" me @ intostr 0 addprop trigger @ ".msg1-3" systime intostr 0 addprop "Enter your message below ('<<' to back up, '.' to end):" say 4 begin dup 3 - intostr "> " strcat prompt dup "." strcmp while dup "<<" strcmp not if pop trigger @ ".msg1-" 3 pick intostr strcat remove_prop "Backing up one line..." say 1 - dup 4 < if pop 4 then else trigger @ ".msg1-" 4 pick intostr strcat rot 0 addprop 1 + then loop pop trigger @ "*uselock" remove_prop "Message posted." say ; : do_del ( -- ) trigger @ "*uselock" getpropstr if "News is being edited. Try again later." say exit then trigger @ "*uselock" "yes" 0 addprop dup " " instr not if "You must supply a message number to delete." say trigger @ "*uselock" remove_prop pop exit then dup " " instr strcut swap pop atoi dup dup 1 < swap trigger @ ".nmsg" getpropstr atoi > or if "That is not a valid posting." say trigger @ "*uselock" remove_prop pop exit then trigger @ ".msg" 3 pick intostr strcat "-2" strcat getpropstr atoi dbref me @ dbcmp not me @ wizard? not and if "You cannot delete that message." say trigger @ "*uselock" remove_prop pop exit then dup 1 begin over over exists? while trigger @ ".msg" 4 pick intostr strcat "-" strcat 3 pick intostr strcat remove_prop 1 + loop pop trigger @ ".nmsg" getpropstr atoi dup 1 = if pop pop trigger @ ".nmsg" remove_prop trigger @ "*uselock" remove_prop "Message deleted." say exit else swap 1 + swap 1 for 1 begin over over exists? while over over getmsg 3 pick 1 - 3 pick writemsg 1 + loop pop 1 begin over over exists? while trigger @ ".msg" 4 pick intostr strcat "-" strcat 3 pick intostr strcat remove_prop 1 + loop pop pop loop pop then trigger @ ".nmsg" getpropstr atoi 1 - trigger @ ".nmsg" rot intostr 0 addprop "Message deleted." say trigger @ "*uselock" remove_prop ; : do_read ( s -- ) atoi dup dup 1 < swap trigger @ ".nmsg" getpropstr atoi > or if pop "Sorry, that is not a current news item number." say exit then dup 1 getmsg "Subject: " swap strcat say dup 2 getmsg " Author: " swap atoi dbref name strcat say dup 3 getmsg " Posted: " swap atoi dup ctime 4 strcut swap pop 6 strcut 10 strcut swap pop ", " swap strcat strcat " ("strcat swap systime get_age strcat ")" strcat strcat say " " say 4 begin over over exists? while over over getmsg say dup 20 % not if " " say "Type to continue, 'q' to quit: " prompt " " say tolower "q" 1 strncmp not if break then then 1 + loop pop pop "Done." say ; : main ( s -- ) .sstrip dup not if pop mainmenu exit then tolower dup "add" 3 strncmp not if me @ wizard? not trigger @ name tolower "news" instr 1 = and if pop "Only a wizard may do that." say exit then do_add exit then dup "del" 3 strncmp not if me @ wizard? not trigger @ name tolower "news" instr 1 = and if pop "Only a wizard may do that." say exit then do_del exit then dup number? if do_read exit then pop "Usage: " trigger @ name strcat say " = list all messages" say " = read message " say " add = write a new message" say " delete = delete message if able" say ;