@program #261 1 1000 d i $include #2123 $include $lib/rp ( mcomm.muf - Multi Comm Broadcaster Version 1.9 - By Taura LearFox ... love the Cranberries! No-nonsense setup instructions: 1. Create this program into your muck database: mcomm.muf 2. Create @actions on your root room, usually #0. Then @link the @actions to this program. The default @action's name is '@public;@pub;@wizard;@wiz'. *** @Action names can be anything: *** The @action's name will be the channel's name. So if your action name is '@channelname' then the user types '@general ' to send a message on the '@channelname' channel. 3. @set this program to W. 4. At your option, you may go and edit the $defs just after this header. If you are unsure about any particular setting, please leave it as it is. 5. Type: @channelname #ops Where @channelname is the channel name. Do this for *every* default channel to chown ownership to the wizard or you. Freespeechware, may NOT be ported to any of the following sites or domains: aol - America Online cn - China compuserve - Compuserve edu - US collages hk - Hong Kong kr - Korea kw - Kuwait il - Israel in - India ir - Iran iq - Iraq jp - Japan gov - US goverment mil - US military sa - Sudia Arabia --Modifications by Chetar-- Cosmetic changes to the output, new prop from rooms. @mcomm/name: broadcast name for this room, displayed when a player uses a channel from that room. ) $include $lib/debug ( Do you want this program to censor? "n" ) $def censoring "n" ( Broadcast prepend text. "=>" ) $def prepend "=>" ( What to put over sware words. "[CENSORED]" ) $def cenblock "[CENSORED]" ( Menu banner "---" ) $define banner "---------------------------" dup strcat dup strcat dup strcat screenwidth 1 - strcut pop $enddef ( Header, please do NOT change ) $def header "Mcomm Version %ver" $def version "1.9" $def propdir "@mcomm/" $def author "Taura LearFox" ( list of swear words or misc. that will be replaced with cenblock. ) ( please use lowercase. matching will be case insensitive. ) $def badword1 "fuck" $def badword2 "ass " $def badword3 "shit" $def badword4 "phuck" $def badword5 "fuk" $def badword6 "phuk" $def badword7 "fuk" $def badword8 "phuk" ( -- i ; return length of terminal ) $define screenlength me @ "_/scrlen" getpropstr dup "" strcmp not if pop 23 else atoi dup 0 = if pop 23 else then then $enddef $def notify ansi_notify ( -- i ; return width of terminal ) $define screenwidth me @ "_/scrwid" getpropstr dup "" strcmp not if pop 80 else atoi dup 0 = if pop 80 else then then $enddef ( -- ; Operator Menu - Main ) $define operator_menu command @ " Channel Operator - Main Menu" strcat .tell " " .tell " 1 = Edit Ban List".tell " 2 = Change Owners" .tell " 3 = Edit Description" .tell " 4 = Delete Channel" .tell " q = Exit" .tell " " .tell "Enter Choice:" .tell $enddef ( -- ; Operator Menu - Ban ) $define ban_menu "Please type in a list of player's names seperated by a space" .tell "then press ." .tell "\".b\" then to to cancel and go back." .tell "\".r\" then to remove the prop." .tell $enddef ( -- ; Squelch Menu ) $define squelch_menu "Type in the names of the players you wish to squelch." .tell "Seperate each name with a space. Press when you are done." .tell "\".r\" then removes squelching." .tell "\".c\" then to cancel and go back." .tell $enddef ( -- ; Operator Menu - Owner ) $define owner_menu "Please type in a list of player's names seperated by a space" .tell "then press ." .tell "\".b\" then to go back without making any changes." .tell $enddef ( -- ; Operator Menu - Description ) $define desc_menu "Please type in a 40 char max description then press ." .tell "\".b\" then to go back without making any changes." .tell "\".r\" then removes description." .tell $enddef ( -- ; Operator Menu - Kill ) $define kill_menu "Attention:" .tell " " command @ strcat " will be permenently deleted from the database!" strcat .tell "Are you absolutely sure you want to do this?" .tell "\"y\" to delete this channel." .tell "\"n\" to abort and NOT delete this channel." .tell $enddef ( -- i ; More prompt ) $define prompt_more "--- \"c\" to continue, \"n\" for nonstop, or \"q\" to quit ---" strcen .tell read strip dup "q" stringpfx 1 = if pop 0 else "n" stringpfx 1 = if "y" nonstop? ! 1 else 1 then then $enddef ( s -- s ; Centers String ) $define strcen dup string? if strip dup strlen screenwidth 1 - swap - 2 / " " dup strcat dup strcat dup strcat swap dup 0 > if strcut pop else pop 0 strcut pop then swap strcat else pop "Top of stack is not a string." abort then $enddef ( Please do not edit anything below this line. ) ( ----------------------------------------------------------------------- ) ( player count used in loop ) var counta var countb var countc ( input message string ) var str1 ( loop temp string ) var str2 ( screen measuring variables ) var countscr_w var countscr_l var nonstop? ( dbref of current target player being broadcasted to ) var target1 : msgsub1 ( s -- s ; message string substituting ) version "%ver" subst ; : help0 ( -- ; basic help if you didn't type a argument with the @action ) "Usage: " command @ strcat " " strcat .tell " For more help type '" command @ strcat " #help'." strcat .tell ; : help1 ( -- ; detailed help page 1 ) banner .tell header msgsub1 strcen .tell " " .tell command @ " " strcat .tell " Shouts through a channel to subscribed players online." .tell " " .tell command @ " #on -- turn this channel on." strcat .tell command @ " #off -- turn this channel off." strcat .tell command @ " #who -- list of players listening on this channel." strcat .tell command @ " #list -- list all available channels." strcat .tell command @ " #sub -- list all your subscribed channels." strcat .tell command @ " #sq -- squelching menu." strcat .tell command @ " #op -- operator menu (owners or wizards only)." strcat .tell command @ " #help2 -- help on custom channels." strcat .tell command @ " #help3 -- help and list of properties for this program." strcat .tell command @ " #last -- display the last 100 messages" strcat .tell " " .tell " Haven flag on yourself closes ALL channels, you may not broadcast" .tell "or hear broadcasts if you have the Haven flag set on yourself." .tell " " .tell " -" .tell "Done." .tell ; : help2 ( -- ; help on custom channels help ) banner .tell header msgsub1 strcen .tell " " .tell "Custom Chanels:" .tell " " .tell "To create your own channel:" .tell " " .tell " 1. @action =" .tell " 2. @link =" .tell " 3. #op" .tell " 4. Tell your friends about it!" .tell " " .tell " If all goes well, you now have your own channel, where " .tell "is the name of your channel like '@flying'. Step 3 takes you to the" .tell "operator's menu and automatically claims that channel ownership" .tell "to you." .tell " " .tell "Done." .tell ; : help3 ( -- ; help and list of properties for this program ) banner .tell header msgsub1 strcen .tell " " .tell "Properties on player:" .tell " " .tell propdir " -- on or off ; turns on or off. *" strcat .tell propdir "squelch -- 71 72 646 ; list of players to squelch. *" strcat .tell "_/scrlen -- 23 ; screen length." .tell "_/scrwid -- 80 ; screen width." .tell " " .tell " * notes that setting can be set by built in commands." .tell " " "Done." .tell ; : strcensor ( s -- s ; returns a string with censored text ) censoring "y" stringpfx if dup tolower badword1 instr if dup tolower badword1 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword2 instr if dup tolower badword2 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword3 instr if dup tolower badword3 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword4 instr if dup tolower badword4 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword5 instr if dup tolower badword5 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword6 instr if dup tolower badword6 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword7 instr if dup tolower badword7 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then dup tolower badword8 instr if dup tolower badword8 instr 1 - strcut " " strcat dup " " instr 1 - strcut swap pop cenblock swap strcat strcat then else then ; : dbinstr_chk ( s d -- i ; chk if d is in s, 1 if exist ) over strip "" strcmp not if pop pop 0 exit then intostr instr if 1 else 0 then ; : perm_chk ( d -- i ; check permissions on d, 1 if ok ) dup "H" flag? if pop 0 exit then dup propdir command @ strcat getpropstr "y" stringpfx 0 <= if pop 0 exit then propdir "squelch" strcat getpropstr dup "" strcmp not if pop 1 exit then me @ dbinstr_chk if 0 exit then prog propdir command @ strcat "/ban" strcat getpropstr dup "" strcmp not if pop 1 exit then me @ dbinstr_chk not ; : broadcast_proc ( -- ; broadcast processor ) var message var x str1 @ "^^^^_^^^^" "^_^" subst str1 ! ( this routine has been HEAVILY changed by Chetar@FurryFaire, forward hate mail to him ) concount counta ! begin counta @ while counta @ condbref dup perm_chk if str1 @ ":'" stringpfx if prepend command @ strcat me @ location "@mcomm/name" getpropstr dup "" strcmp not if pop else " (" swap strcat ")" strcat strcat then " <" strcat me @ "%n" command @ strcat getpropstr dup not if pop me @ "%N" pronoun_sub then me @ "Nocolor" getstatint if 1 unparse_ansi then strcat str1 @ 1 strcut swap pop strcat strcensor "^ ^>" strcat dup message ! counta @ condbref swap notify else str1 @ ":" stringpfx if prepend command @ strcat me @ location "@mcomm/name" getpropstr dup "" strcmp not if pop else " (" swap strcat ")" strcat strcat then " <" strcat me @ "%n" command @ strcat getpropstr dup not if pop me @ "%N" pronoun_sub then me @ "Nocolor" getstatint if 1 unparse_ansi then strcat " " strcat str1 @ 1 strcut swap pop strcat strcensor "^ ^>" strcat dup message ! counta @ condbref swap notify else prepend command @ strcat me @ location "@mcomm/name" getpropstr dup "" strcmp not if pop else " (" swap strcat ")" strcat strcat then " <" strcat me @ "%n" command @ strcat getpropstr dup not if pop me @ "%N" pronoun_sub then strcat me @ "Nocolor" getstatint if 1 unparse_ansi then me @ "_say/def/osay" getpropstr dup "" strcmp not if pop " says, " else strip dup strlen 1 - strcut dup "," strcmp not if strcat " " strcat " " swap strcat else strcat ", " strcat " " swap strcat then then strcat "^ ^\"" strcat str1 @ "\"" strcat strcat strcensor "^ ^>" strcat dup message ! counta @ condbref swap notify then then then counta @ 1 - counta ! repeat prog command @ "#/101" strcat message @ setprop 1 x ! begin prog command @ "#/" strcat x @ 1 + intostr strcat getpropstr prog command @ "#/" strcat x @ intostr strcat rot setprop x @ 1 + x ! x @ 101 = until ; : get_channel_attn ( s -- i ; returns i as number of players on s ) concount countb ! 0 countc ! begin countb @ dup 0 > while condbref over propdir swap strcat getpropstr "y" stringpfx 1 = if countc @ 1 + countc ! then countb @ 1 - countb ! repeat pop pop countc @ ; : sublist_prn ( d -- ; prints a list of channels that d is subscribed to ) 0 counta ! 7 countscr_l ! "n" nonstop? ! banner .tell header msgsub1 strcen .tell " " .tell "Subscribed channels for " over name strcat ":" strcat .tell " " .tell "Channel Name Attendance Description" .tell "------------ ---------- -----------" .tell dup propdir nextprop str2 ! begin countscr_l @ screenlength >= if nonstop? @ "y" stringpfx 1 = if else prompt_more if 0 countscr_l ! else "Done, " counta @ intostr strcat " channels listed." strcat .tell exit then then then str2 @ dup "" strcmp while propdir "squelch" strcat stringcmp not if dup str2 @ nextprop str2 ! continue then str2 @ over over getpropstr "y" stringpfx 1 = if propdir strlen strcut swap pop dup " " strcat 16 strcut pop swap get_channel_attn intostr strcat " " strcat 30 strcut pop prog str2 @ "/desc" strcat getpropstr dup strlen 49 > if 49 strcut pop then strcat .tell countscr_l @ 1 + countscr_l ! counta @ 1 + counta ! else pop then dup str2 @ nextprop str2 ! repeat pop pop "Done, " counta @ intostr strcat " channels found." strcat .tell ; : fulllist_prn ( -- ; prints all available channels ) 0 counta ! 7 countscr_l ! "n" nonstop? ! banner .tell header msgsub1 strcen .tell " " .tell "All available channels on " "muckname" sysparm strcat ":" strcat .tell " " .tell "Channel Name Attendance Description" .tell "------------ ---------- -----------" .tell prog dup propdir nextprop str2 ! begin countscr_l @ screenlength >= if nonstop? @ "y" stringpfx 1 = if else prompt_more if 0 countscr_l ! else "Done, " counta @ intostr strcat " channels listed." strcat .tell exit then then then str2 @ dup "" strcmp while propdir strlen strcut swap pop dup " " strcat 16 strcut pop swap get_channel_attn intostr strcat " " strcat 30 strcut pop prog str2 @ "/desc" strcat getpropstr dup strlen 49 > if 49 strcut pop then strcat .tell counta @ 1 + counta ! countscr_l @ 1 + countscr_l ! dup str2 @ nextprop str2 ! repeat pop pop "Done, " counta @ intostr strcat " channels found." strcat .tell ; : channelop_chk ( d -- ; checks if d is an operator on this channel, 1 if yes ) prog propdir command @ strcat "/owners" strcat getpropstr dup "" strcmp not if pop pop 0 exit then strip " " strcat begin striplead dup " " instr 1 - strcut swap striplead atoi dbref 3 pick dbcmp if pop pop 1 break then dup strip "" strcmp not if pop pop 0 break then repeat ; : channelop_owner ( -- ; channel operator owner setting ) banner .tell "Current owners:" .tell prog propdir command @ strcat "/owners" strcat getpropstr strip dup "" strcmp not if pop "No one" .tell else " " explode counta ! "" str2 ! begin counta @ while atoi dbref dup player? if name else pop "" then .tell counta @ 1 - counta ! repeat then "End of list." .tell owner_menu read strip dup ".b" stringpfx if pop exit then dup me @ name instring not if "Warning, you will no longer own this channel." .tell "Are you sure you want to do this? (y/N)" .tell read "n" stringpfx if pop "Canceled." .tell exit then then " " explode counta ! "" str2 ! begin counta @ while "*" swap strcat match intostr str2 @ striplead " " strcat swap strcat striplead str2 ! counta @ 1 - counta ! repeat prog propdir command @ strcat "/owners" strcat str2 @ strip setprop "Owners set." .tell ; : channelop_ban ( -- ; channel operator ban setting ) banner .tell "Currently banning:" .tell prog propdir command @ strcat "/ban" strcat getpropstr strip dup "" strcmp not if pop "*No one*" .tell else " " explode counta ! "" str2 ! begin counta @ while atoi dbref dup player? if name else pop "*Not Found*" then .tell counta @ 1 - counta ! repeat then "End of list." .tell ban_menu read strip dup ".b" stringpfx if pop exit then dup ".r" stringpfx if pop prog propdir command @ strcat "/ban" strcat remove_prop "Ban list removed." .tell exit then " " explode counta ! "" str2 ! begin counta @ while "*" swap strcat match intostr str2 @ striplead " " strcat swap strcat striplead str2 ! counta @ 1 - counta ! repeat prog propdir command @ strcat "/ban" strcat str2 @ strip setprop "Ban list set." .tell ; : channelop_desc ( -- ; channel operater desc set menu ) banner .tell "Current description:" .tell prog propdir command @ strcat "/desc" strcat getpropstr dup "" strcmp not if pop "*no description*" then .tell "Done." .tell desc_menu read strip dup ".b" stringpfx if pop exit then dup ".r" stringpfx if pop prog propdir command @ strcat "/desc" strcat remove_prop "Description removed." .tell exit then prog over propdir command @ strcat "/desc" strcat swap setprop "Channel description set to:" .tell .tell "Done." .tell ; : channelop_kill ( -- ; channel kill confermation menu ) banner .tell kill_menu read strip "y" stringpfx if prog propdir command @ strcat "/owners" strcat remove_prop prog propdir command @ strcat "/desc" strcat remove_prop prog propdir command @ strcat "/ban" strcat remove_prop command @ " channel information has been deleted from the database." strcat .tell "Please @recycle all @actions related to the " command @ strcat " channel." strcat .tell "Since they are no longer needed." .tell else "Aborted, " command @ strcat " channel not deleted." strcat .tell then ; : channelop_proc ( -- ; channel operator menu ) command @ "Wiz" stringpfx if me @ "W" flag? not if "Sorry, only wizards my be operators on this channel." .tell exit then then prog propdir command @ strcat "/owners" strcat getpropstr "" strcmp not if prog propdir command @ strcat "/owners" strcat me @ intostr setprop command @ " is a new channel and you have been granted ownership of it." strcat .tell then me @ "W" flag? not if prog propdir command @ strcat "/owners" strcat getpropstr me @ dbinstr_chk not if "Sorry, you are not a operator on the " command @ strcat " channel." strcat .tell exit then then begin banner .tell header msgsub1 strcen .tell operator_menu read strip dup "1" stringpfx if pop channelop_ban continue then dup "2" stringpfx if pop channelop_owner continue then dup "3" stringpfx if pop channelop_desc continue then dup "4" stringpfx if pop channelop_kill exit then "q" stringpfx if "Exited." .tell break then repeat ; : squelch_proc ( -- ; players to squelch prompt proccessor ) "You are currently squelching:" .tell me @ propdir "squelch" strcat getpropstr dup "" strcmp not if pop "*no one*" .tell else strip " " explode counta ! "" str2 ! begin counta @ while atoi dbref dup player? if name else pop "*Not Found*" then .tell counta @ 1 - counta ! repeat then squelch_menu read strip dup ".r" stringpfx if pop me @ propdir "squelch" strcat remove_prop "Property removed and sqelching turned off." .tell exit then dup ".c" stringpfx if pop "Canceled." .tell exit then " " explode counta ! "" str2 ! begin counta @ while "*" swap strcat match intostr str2 @ striplead " " strcat swap strcat striplead str2 ! counta @ 1 - counta ! repeat me @ propdir "squelch" strcat str2 @ setprop "Squelch list set." .tell "You are now squelching:" .tell me @ propdir "squelch" strcat getpropstr strip " " explode counta ! "" str2 ! begin counta @ while atoi dbref dup player? if name else pop "*Not Found*" then .tell counta @ 1 - counta ! repeat "Done." .tell ; : scanchannel_proc ( -- ; scans channel name in string for who is listening ) 7 countscr_l ! "n" nonstop? ! concount counta ! 0 countb ! banner .tell header msgsub1 strcen .tell " " .tell command @ "Players listening on channel \"" over strcat "\":" strcat .tell " " .tell "Player Name(title)" 60 left "Idle" strcat .tell "----------- " 60 left "----" strcat .tell begin countscr_l @ screenlength >= if nonstop? @ "y" stringpfx 1 = if else prompt_more if 0 countscr_l ! else "Done, " countb @ intostr strcat " players listed." strcat .tell exit then then then counta @ 0 > while counta @ condbref over propdir swap strcat getpropstr "y" stringpfx 1 = if counta @ condbref name counta @ condbref "%n" command @ strcat getpropstr dup not if pop counta @ condbref "%n" getpropstr dup not if pop "" else ")" strcat "(" swap strcat then else ")" strcat "(" swap strcat then strcat 60 left counta @ conidle dup 60 > if 60 / intostr "m" strcat strcat .tell else intostr "s" strcat strcat .tell then countb @ 1 + countb ! countscr_l @ 1 + countscr_l ! else then counta @ 1 - counta ! repeat "Done, " countb @ intostr strcat " players listed." strcat .tell ; : channelopen? ( d -- i ; see if d has this channel open ) propdir command @ strcat getpropstr "yes" strcmp not if 1 else command @ " channel is currently closed for you." strcat .tell "Please type '@" command @ strcat " #on' to open the channel." strcat .tell 0 then ; : atsignrem ( s -- ; removing the "@" character from the command if exist ) dup "@" stringpfx if 1 strcut swap pop 1 strcut swap toupper swap strcat command ! else pop then ; : command2def ( s -- ; check command if they are default names to adjust and reput ) dup "sp" stringpfx if pop "Sports" command ! exit then dup "wiz" stringpfx if pop "Wizard" command ! exit then dup "@pub" stringpfx if pop "Public" command ! exit then "pub" stringpfx if "Public" command ! exit then ; : chkwiz ( -- i ; returns 0 if user does not have a W flag ) me @ mlevel 3 > ; : history ( s -- ) var x var y strip dup " " instring strcut swap pop atoi y ! y @ not if "Defaulting to the last 10 messages, use #last (number) to change this, up to 100)" .tell 10 y ! then y @ 100 > if 100 y ! then command @ command2def "Displaying last " y @ intostr strcat " messages" strcat .tell 100 x ! begin prog command @ "#/" strcat x @ intostr strcat getpropstr dup if ">" 100 x @ - 1 + intostr 2 left swap strcat swap strcat .tell else pop then x @ 1 - x ! x @ 100 y @ - = until ; : main dup "" strcmp not if pop help0 exit then strip dup striplead "#last" stringpfx over "last" smatch or if history exit then dup striplead "#help3" stringpfx if pop help3 exit then dup striplead "#help2" stringpfx if pop help2 exit then dup striplead "#h" stringpfx if pop help1 exit then command @ atsignrem ( remove the @ sign for the command var ) command @ command2def ( change command name to default if pub or wiz ) dup striplead "#l" stringpfx if pop fulllist_prn exit then dup striplead "#su" stringpfx if pop me @ sublist_prn exit then dup striplead "#op" stringpfx if pop channelop_proc exit then dup "#of" stringpfx over striplead "off" stringcmp not or if me @ propdir command @ strcat "no" setprop command @ " channel is now closed." strcat .tell exit then dup striplead "#sq" stringpfx if pop squelch_proc exit then dup prog propdir command @ strcat "/ban" strcat getpropstr me @ dbinstr_chk if pop "You have been banned from using this channel." .tell exit then me @ "H" flag? if pop "You cannot broadcast while haven." .tell exit then dup striplead "#w" stringpfx over striplead "who" stringcmp not or if pop scanchannel_proc exit then dup "#on" stringpfx over striplead "on" stringcmp not or if me @ propdir command @ strcat "yes" setprop command @ " channel is now open." strcat .tell exit then me @ channelopen? not if pop exit then ( see if a non-wizard is trying to use a command called @wiz ) command @ "Wiz" stringpfx if chkwiz not if "Sorry, only wizards may broadcast on this channel." .tell "Please try '@pub' instead." .tell exit else then then str1 ! broadcast_proc ; . c q