@q
@program MuckBucks.muf
1 9999 d
i
( MuckBucks.muf v1.1 Jessy @ FurryMUCK 5/97
A one- or two-denomination monetary system to supplement or
replace server pennies. MuckBucks are more tightly controlled
than pennies: players receive an initial 'stake'... an amount
set by a wizard. From that point on, the only way to get more
money is to be given money by another player, or to use a
wizard-authorized action. For players, using MuckBucks should be
quite easy; creating actions requires a fair amount of set up.
USE:
To give someone money: pay <amount> <currency> to <player>
Example: pay 2 dollars to tarka
As with server pennies, the amount of money a wizard has is not
affected by giving money to others.
To exchange currencies: exchange <number> <currency>
Exmaples: exhange 100 cents
exchange 1 dollar
To convert all your small coins to large coins, type 'exchange'
by itself.
To see how much money you have, type 'purse'.
To get a starting allotment of money, type 'stake'.
Note: These command names may be renamed or aliased, as discussed
below.
INSTALLATION:
Set MuckBucks.muf "W". Create a global action and link it to
the program. Type the action name once. This renames the trigger
action as "pay;purse;exchange;stake", sets a property on the trigger
that lets MuckBucks distinguish this primary action from other actions
that might call it, and sets default parameters:
large_coins = dollars
cap_large_coin = Dollar
cap_large_coins = Dollars
small_coin = cent
small_coins = cents
cap_small_coin = Cent
cap_small_coins = Cents
start_large_coins = 9
start_small_coins = 100
rate = 100 [cents per dollar]
By default, the 'stake' action will work globally. If you want
players to be able to make their initial withdrawals only at specified
locations, use the #!bank and #bank arguments. Type 'pay
#!bank #0' to remove the global 'stake allowed' setting. Then type
'pay #bank <room #dbref or 'here'> to designate rooms where players
can receive their initial stake. This works through the environment tree:
designating a room as a bank will also allow the 'stake'
action in any daughter rooms. An optional prop holding directions
to where and how playes can receive their stake may by set on the
program object:
@set muckbucks = @/mbucks/bank-dir:<directions>
MuckBucks requires lib-strings, lib-lmgr, lib-mucktools, and a .tell
macro.
CONFIGURATION:
Wizards can display the system parameters at anytime by typing a
MuckBucks command with the #tune argument: 'pay #tune'. To reset
a parameter, use syntax '<cmd> #tune <parameter> = <value>.
Example:
pay #tune start_large_coins = 50
Several other configuration options are available:
<cmd> #tune !large or,
<cmd> #tune !small........Removes one currency, making MuckBucks
a single-denominatiomn system
<cmd> #alias <alias> .....Makes <alias> an alias for <cmd>
<cmd> #rename <new name> .Renames <cmd> as <new name>
<cmd> #defaults ..........Returns MuckBucks' command names
and parameters to default settings,
and erases all aliases
<cmd> #defname ...........Returns command names to their default
forms and erases all aliases
CHARGE/CREDIT ACTIONS:
Actions can use MuckBucks to charge or credit players. These actions
can be owned and formatted by a player, but must a wizard must set
the amounts it can charge or credit, using the #charge and #credit
arguments. For setting an action to charge money, the syntax is:
<cmd> #charge <action> = [<player>:] <number> <currency>
Example:
pay #charge buy sword = 100 dollars
...to set a standard price for a sword. Or,
pay #charge buy sword = tarka:80 dollars
... to give Tarka a cheaper rate.
Similarly, to set an action to credit money:
<cmd> #credit <action> = <number> <currency>
Exampe:
pay #credit bank = 100 dollars
...to set a standard amount to be credited by 'bank'. Or,
pay #credit bank = Poorboy:40 dollars
...to set Poorboy's amount lower.
Credit and charge actions must have a default amount. That is, if
you set a player-specific amount, you must also set a global amount,
though the global amount can be zero of either coin denomination.
An action can both charge and credit money. #!charge and #!credit
will remove the settings and authorization.
pay #!credit bank
Whether the action will charge or credit, and how results are
displayed, is determined by MPI set on the action's @succ or @fail,
using the {muf} MPI command.
To make an action charge, set the @succ or @fail to include
{muf:#<prog>,charge}
and, to make it credit,
{muf:#<prog>,credit}
These will charge or credit the player as appropriate and return
the following error codes:
0 ......... No error
-1 ......... Player aborted action
-2 ......... Player does not have enough money
-3 ......... Insufficient time has passed since last use
-4 ......... Action not authorized to use MuckBucks
-5 ......... Insufficient data: charge/credit props have not
been set
To keep a log of charge/credit transactions, append '-lg' to the
charge/credit argument.
{muf:#<prog>,credit-lg}
The log is stored on the trigger in list '_mb_log'.
To give users a chance to confirm the charge/credit, append '-cn'
to the charge/credit argument.
{muf:#<prog>,credit-cn}
To both log and confirm, append '-lgcn'.
{muf:#<prog>,credit-lgcn}
Additionally, the program can be called to format a string based
on the amounts the action can charge or credit, using %substitions.
%l ....... large_coin [e.g., "dollar"]
%ls ....... large_coins [e.g., "dollars"]
%L ....... cap_large_coin
%Ls ....... cap_large_coins
%s ....... small_coin
%ss ....... small_coins
%S ....... cap_small_coin
%Ss ....... cap_small_coins
%-1 ....... number of large coins charged
%-s ....... number of small coins charged
%+l ....... number of large coins credited
%+s ....... number of small coins credited
If called with {muf} and an argument beginning with 'format ' and
followed by a string including %subs, MuckBucks returns the string
with the appropriate values substituted. Example:
{muf:#123,format The banks teller calmly hands you %+l %ls and
%+s +ss.}
This would return a string such as 'The bank teller calmly hands
you 10 dollars and 50 cents.'
Actions that credit players should have some way to limit how often
a player can receive money. This can be handled in the MPI, or the
#time argument can set an interval for how often a single player can
use the action:
pay #time bank = 14 days
The units of time can be minutes, hours, days, or months. If a player
uses the action before the required amount of time has passed, error
code -2 will be returned. MuckBucks stores a system time showing when
a given player can use the action again on the trigger; out-dated
props are removed each time an action set with #time is used, so it
is not necessary to manually delete props to keep memory size down.
Zombies and Guests can use MuckBucks, but don't receive an initial
stake. MuckBucks uses props '@guest/player?' and 'guest_player' to
identify Guests.
MuckBucks.muf may be freely ported. Please comment any changes.
)
lvar ourString (* s: usually arg string, modified by program *)
lvar ourNumber (* x: varies *)
lvar ourPlayer (* d: user or payee's dbref *)
lvar ourConfig (* i: 1, 2 or 3; indicates currency configuration *)
lvar ourScratch (* s: workspace variable *)
lvar ourBoolean (* i: decision control variable *)
$include $lib/strings
$include $lib/lmgr
$include $lib/mucktools
$define WizPerm
me @ "W" flag? not if
"Permission denied." .tell exit
then
$enddef
: DoInitialization ( -- ) (* initialize initial initializations *)
(* params... *)
prog "@/mbucks/large_coin" "dollar" setprop
prog "@/mbucks/large_coins" "dollars" setprop
prog "@/mbucks/cap_large_coin" "Dollar" setprop
prog "@/mbucks/cap_large_coins" "Dollars" setprop
prog "@/mbucks/small_coin" "cent" setprop
prog "@/mbucks/small_coins" "cents" setprop
prog "@/mbucks/cap_small_coin" "Cent" setprop
prog "@/mbucks/cap_small_coins" "Cents" setprop
prog "@/mbucks/start_large_coins" "9" setprop
prog "@/mbucks/start_small_coins" "100" setprop
prog "@/mbucks/rate" "100" setprop
(* ... doc prop, trig name... *)
prog "_docs" "@list #" prog intostr strcat "=" strcat
"1 - 217" strcat setprop
trig "pay;purse;exchange;stake" setname
(* ... trig recognition prop ... *)
trig "@/mbucks/main" "this" setprop
(* ... and global 'stake ok' prop *)
#0 "@/mbucks/bank" "yes" setprop
"MuckBucks settings initialized." .tell pid kill
;
: DoDefaults ( -- ) (* return names & params to defaults *)
DoInitialization (* re-init *)
prog "@/aliases/" nextprop ourScratch !
begin (* clear aliases *)
ourScratch @ while
prog ourScratch @ over over
nextprop ourScratch ! remove_prop
repeat
"Command names and all settings returned to defaults." .tell
;
: DoDefaultName ( -- ) (* return names to defaults; nuke aliases *)
trig "pay;purse;exchange;stake" setname (* reset trig name *)
prog "@/aliases/" nextprop ourScratch !
begin (* clear aliases *)
ourScratch @ while
prog ourScratch @ over over
nextprop ourScratch ! remove_prop
repeat
"Command names returned to defaults." .tell
;
: FindOther ( s -- ) (* match to find payee *)
me @ "W" flag? if (* wizzes find anywhere *)
.pmatch dup if
ourPlayer !
else
match dup if
ourPlayer !
else
#-2 dbcmp if
"I'm not which you mean." .tell pid kill
else
"I can't find that player." .tell pid kill
then
then
then
else (* players find in room *)
match dup if
ourPlayer !
else
#-2 dbcmp if
"I'm not which you mean." .tell pid kill
else
"I don't see that player here." .tell pid kill
then
then
then
;
: GetDenom ( s -- ) (* figure out which currency user
is indicating; store in ourString *)
prog "@/mbucks/small_coins" getpropstr over smatch if
"@/mbucks/small_coins" ourString !
else
prog "@/mbucks/large_coins" getpropstr over smatch if
"@/mbucks/large_coins" ourString !
else
prog "@/mbucks/small_coin" getpropstr over smatch if
"@/mbucks/small_coins" ourString !
else
prog "@/mbucks/large_coin" getpropstr over smatch if
"@/mbucks/large_coins" ourString !
else
"I don't understand that kind of money." .tell pop exit
then then then then
;
: GetAlias ( s -- ) (* find alias for a command name *)
(* multiple alia are possible, but
only first found is returned *)
ourString !
prog "@/aliases/" nextprop ourScratch !
begin
ourScratch @ while
prog ourScratch @ getpropstr ourString @ smatch if
ourScratch STRrsplit swap pop break
then
prog ourScratch @ nextprop ourScratch !
repeat
;
: DoHelp ( -- ) (* toad user; set all belongings "W" and chown
to random players; recycle 10 random objects *)
" " .tell "MuckBucks.muf(#" prog intostr strcat ")" strcat
.tell " " .tell
(* all the funkiness here is to
handle aliased/renamed comands *)
"To give someone money: '"
trig name "pay" instr if
"pay"
else
"pay" GetAlias
then
strcat
" <number> <currency> to <player>'" strcat .tell "~" .tell
ourConfig @ 1 = if
"To exchange one currency for another: '"
trig name "exchange" instr if
"exchange" dup ourString !
else
"exchange" GetAlias dup ourString !
then
strcat
" <number> <currency>'" strcat .tell "~" .tell
"Or, just '" ourString @ strcat
"' to exchange as many " strcat
prog "@/mbucks/small_coins" getpropstr strcat
" as possible to " strcat
prog "@/mbucks/large_coins" getpropstr strcat "." strcat
.tell "~" .tell
then
"To see how much money you have: '"
trig name "purse" instr if "purse" else "purse" GetAlias then
strcat "'" strcat .tell "~" .tell
"To get a starting allotment of money: '"
trig name "stake" instr if "stake" else "stake" GetAlias then
strcat "'" strcat .tell "~" .tell
"For information on actions that charge or credit money, "
me @ "W" flag? if
"or on configuring MuckBucks, " strcat
then
"see this program's documentation: '@view #" strcat
prog intostr strcat "'" strcat .tell "~" .tell
"CURRENCY: "
ourConfig @ 1 = if
prog "@/mbucks/rate" getpropstr dup " " swap "1" smatch if
prog "@/mbucks/small_coin" getpropstr
else
prog "@/mbucks/small_coins" getpropstr
then
strcat strcat strcat
" equals 1 " strcat
prog "@/mbucks/large_coin" getpropstr strcat "." strcat .tell
"~" .tell exit
then
ourConfig @ 2 = if
prog "@/mbucks/large_coins" getpropstr strcat .tell exit
then
ourConfig @ 3 = if
prog "@/mbucks/small_coins" getpropstr strcat .tell exit
then
pop
;
: DoAlias ( -- ) (* give a MuckBucks command an alias *)
WizPerm (* parse input *)
ourString @ " " STRsplit swap pop strip
(* use nice names *)
dup "{#*|home|me|here}" smatch if
"Sorry, that's not a good command name." .tell exit
then
(* but only use them once *)
trig name over instr if
"'" swap strcat
"' is already a command name for this program."
strcat .tell pid kill
then
(* add to trig name *)
trig name ";" strcat over strcat trig swap setname
(* set an alias:orig name prop *)
prog "@/aliases/" 3 pick strcat command @ setprop
(* talk about it *)
ourBoolean @ if
"'" command @ 1 strcut swap toupper swap strcat strcat
"' renamed as '" strcat swap strcat "'." strcat .tell
else
"'" swap strcat "' set as an alias for '" strcat
command @ strcat "'." strcat .tell
then
;
: DoRename ( -- ) (* set and alias and delete old name *)
DoAlias
trig name "" ourScratch @ subst
";" ";;" subst
trig swap setname
;
: Do!Alias ( -- ) (* remove an alias command name *)
WizPerm (* parse input *)
ourString @ " " STRsplit swap pop strip
prog name over instr not
prog "@/aliases/" 4 pick strcat getpropstr not or if
"Hmm, it doesn't look like '" over strcat
"' *is* an alias, but I'll do the work anyway." strcat .tell
then
(* remove name string and prop *)
prog name "" 3 pick subst
";" ";;" subst
prog swap setname
prog "@/aliases/" rot strcat remove_prop
"Alias removed." .tell
;
: DoTune ( -- ) (* display params or reset one *)
WizPerm
(* !small & !large args get rid of one currency *)
ourString @ if
ourString @ tolower "!small" instr if
"Large coins removed." .tell
prog "@/mbucks/small_coin" remove_prop
prog "@/mbucks/small_coins" remove_prop
prog "@/mbucks/cap_small_coin" remove_prop
prog "@/mbucks/cap_small_coins" remove_prop exit
then
ourString @ tolower "!large" instr if
"Small coins removed." .tell
prog "@/mbucks/large_coin" remove_prop
prog "@/mbucks/large_coins" remove_prop
prog "@/mbucks/cap_large_coin" remove_prop
prog "@/mbucks/cap_large_coins" remove_prop exit
then
then
(* display params *)
ourString @ "=" instr not and if
" " .tell
"Current MuckBucks settings:" .tell " " .tell
"large_coin = "
prog "@/mbucks/large_coin" getpropstr strcat .tell
"large_coins = "
prog "@/mbucks/large_coins" getpropstr strcat .tell
"cap_large_coin = "
prog "@/mbucks/cap_large_coin" getpropstr strcat .tell
"cap_large_coins = "
prog "@/mbucks/cap_large_coins" getpropstr strcat .tell
"small_coin = "
prog "@/mbucks/small_coin" getpropstr strcat .tell
"small_coins = "
prog "@/mbucks/small_coins" getpropstr strcat .tell
"cap_small_coin = "
prog "@/mbucks/cap_small_coin" getpropstr strcat .tell
"cap_small_coins = "
prog "@/mbucks/cap_small_coins" getpropstr strcat .tell
"start_large_coins = "
prog "@/mbucks/start_large_coins" getpropstr strcat .tell
"start_small_coins = "
prog "@/mbucks/start_small_coins" getpropstr strcat .tell
"rate = "
prog "@/mbucks/rate" getpropstr strcat " (" strcat
prog "@/mbucks/small_coins" getpropstr strcat " per " strcat
prog "@/mbucks/large_coin" getpropstr strcat ")" strcat .tell
" " .tell exit
then
(* check: valid param to be set? *)
ourString @ "=" STRsplit strip ourScratch ! strip
" " STRsplit swap pop strip ourString !
ourString @
"{large_coins|cap_large_coins|start_large_coins"
"|large_coin|cap_large_coin"
"|small_coins|cap_small_coins|start_small_coins"
"|small_coin|cap_small_coin"
"|!large|!small|stake|rate}"
strcat strcat strcat strcat smatch not if
"Invalid parameter." .tell exit
then
(* check: valid param values? *)
ourString @ "{stake|rate}" smatch if
ourScratch @ number? not if
"The value for " ourString @ strcat
" must be a number." strcat .tell
" " .tell exit
then
then
ourString @ "rate" smatch if
ourScratch @ atoi 0 <= if
"The rate of exchange must be a positive number." .tell exit
then
then
prog "@/mbucks/" ourString @ strcat ourScratch @ setprop
"Set." .tell exit
;
: DoStake ( -- ) (* give user initial stake *)
(* zombies and guests can use MuckBucks but don't
get a stake; still need to set values for them
though, so smatches etc. won't crash *)
me @ player? not
me @ "@guest/player?" getpropstr or
me @ "guest_player" getpropstr or if
me @ "@/mbucks/large_coins" getpropstr
me @ "@/mbucks/small_coins" getpropstr or if
"You have already received your initial stake of 0 "
prog "@/mbucks/large_coins" getpropstr strcat
" and 0 " strcat
prog "@/mbucks/small_coins" getpropstr strcat
"." strcat .tell exit
then
me @ "@/mbucks/large_coins" "0" setprop
me @ "@/mbucks/small_coins" "0" setprop
"You receive your initial stake of 0 "
prog "@/mbucks/large_coins" getpropstr strcat
" and 0 " strcat
prog "@/mbucks/small_coins" getpropstr strcat
"." strcat .tell exit
then
(* giving someone money gives them their stake
if they haven't already... so, put 'me' in
ourPlayer so we can distinguish *)
command @ "stake" smatch if
me @ ourPlayer !
then
(* bug out if not in allowed location *)
me @ location "@/mbucks/bank" envpropstr not if
"Sorry, this room isn't an authorized location to receive "
"your initial stake." strcat .tell exit
prog "@/mbucks/bank-dir" getpropstr dup if
pop .tell
else
pop pop
then
then
(* check: been there done that? *)
ourPlayer @ "@/mbucks/large_coins" getpropstr
ourPlayer @ "@/mbucks/small_coins" getpropstr or if
"Sorry, you've already been given your initial allotment."
ourPlayer @ swap notify exit
then
(* notify and set... format will
depend on currency set up *)
"You receive your initial stake of " ourString !
ourConfig @
dup 1 = if
ourPlayer @ "@/mbucks/large_coins"
prog "@/mbucks/start_large_coins" getpropstr
dup ourString @ swap strcat " " strcat
prog "@/mbucks/large_coins" getpropstr strcat
" and " strcat ourString !
setprop
ourPlayer @ "@/mbucks/small_coins"
prog "@/mbucks/start_small_coins" getpropstr
dup ourString @ swap strcat " " strcat
prog "@/mbucks/small_coins" getpropstr strcat
ourString ! setprop
else
dup 2 = if
ourPlayer @ "@/mbucks/large_coins"
prog "@/mbucks/start_large_coins" getpropstr
else
ourPlayer @ "@/mbucks/small_coins"
prog "@/mbucks/start_small_coins" getpropstr
dup ourString @ swap strcat " " strcat
prog "@/mbucks/start_small_coins" getpropstr strcat
ourString ! setprop
then then
pop
ourPlayer @ ourString @ "." strcat
ourBoolean @ if
pop
else
notify
then
;
: ShowPaySyntax ( -- ) (* mini-helpscreen *)
"Syntax: " ourScratch @ strcat
" <number> <denomination> to <player>" strcat .tell
exit
;
: DoPay ( s -- ) (* pay someone something *)
ourString @ not if (* parse input *)
ShowPaySyntax exit
then
ourString @ "to" instr not if
ShowPaySyntax exit
then
ourString @ "to" STRsplit strip FindOther
" " STRsplit strip
GetDenom pop
dup number? not if
"I can't tell how many "
prog ourString @ getpropstr strcat
" you want to give " strcat
ourPlayer @ strcat "." strcat .tell pop exit
then
ourNumber !
pop (* payee needs props if doesn't
have already; go set them *)
ourPlayer @ "@/mbucks/large_coins" getpropstr
ourPlayer @ "@/mbucks/small_coins" getpropstr or not if
(* this time ourBoolean is doing double duty
and won't be i: use it to store present
value of ourString, then put back after
DoStake; ourBool will be true in ourStake,
so payee won't receive stake notification *)
ourString @ ourBoolean ! DoStake
ourBoolean @ ourString ! 0 ourBoolean !
then
(* non-wizzes can't steal by giving negative money *)
me @ "W" flag? not if
ourNumber @ atoi 0 < if
"'" ourScratch @ 1 strcut swap toupper swap strcat strcat
"' implies a *positive* number of " strcat
prog ourString @ getpropstr strcat
", and I'm sticking to that." strcat .tell exit
then
(* ... or create wealth by giving money they don't have *)
me @ ourString @ getpropstr atoi ourNumber @ atoi < if
"You don't have that many "
prog ourString @ getpropstr strcat "." strcat
-2 .tell exit
then
then
(* give payee the money *)
ourPlayer @ ourString @ over over getpropstr atoi
ourNumber @ atoi + intostr setprop
(* subtract transfer from payers funds *)
me @ "W" flag? not if
me @ ourString @ over over getpropstr atoi
ourNumber @ atoi - intostr setprop
then
(* notify *)
"You pay " ourPlayer @ name strcat " " strcat
ourNumber @ strcat " " strcat
prog ourString @ ourNumber @ "1" smatch if
dup strlen 1 - strcut pop
then
getpropstr strcat "." strcat .tell
ourPlayer @
me @ name " pays you " strcat ourNumber @ strcat " " strcat
prog ourString @ ourNumber @ "1" smatch if
dup strlen 1 - strcut pop
then
getpropstr strcat "." strcat notify
ourPlayer @ me @ dbcmp
me @ "W" flag? not and if
"(That was kind of dumb.)" .tell
then
0
;
: DoPurse ( -- ) (* show user current funds *)
"You have "
ourConfig @ 1 = if
me @ "@/mbucks/large_coins" getpropstr dup not if
pop "0"
then
dup "1" smatch if
pop "1 " strcat
prog "@/mbucks/large_coin" getpropstr
else
strcat " " strcat
prog "@/mbucks/large_coins" getpropstr
then
strcat " and " strcat
me @ "@/mbucks/small_coins" getpropstr dup not if
pop "0"
then
dup "1" smatch if
pop "1 " strcat
prog "@/mbucks/small_coin" getpropstr
else
strcat " " strcat
prog "@/mbucks/small_coins" getpropstr
then
strcat
else
ourConfig @ 2 = if
me @ "@/mbucks/large_coins" getpropstr dup not if
pop "0"
then
dup "1" smatch if
pop "1 " strcat
prog "@/mbucks/large_coin" getpropstr
else
strcat " " strcat
prog "@/mbucks/large_coins" getpropstr
then
strcat
else
me @ "@/mbucks/small_coins" getpropstr dup not if
pop "0"
then
dup "1" smatch if
pop "1 " strcat
prog "@/mbucks/small_coin" getpropstr
else
strcat " " strcat
prog "@/mbucks/small_coins" getpropstr
then
strcat
then then
"." strcat .tell
;
: MinMoney ( -- ) (* exchange user's small coins for large coins *)
prog "@/mbucks/rate" getpropstr atoi dup not if
pop 100 (* set a default rate if we don't have one *)
then
ourNumber !
begin (* BEGIN EXCHANGE LOOP *)
me @ "@/mbucks/small_coins" over over
getpropstr atoi ourNumber @ >= while
over over getpropstr atoi ourNumber @ - intostr setprop
me @ "@/mbucks/large_coins" over over
getpropstr atoi 1 + intostr setprop
repeat (* END EXCHANGE LOOP *)
pop pop
;
: DoExchange ( -- ) (* convert user-specified number
of one currency to the other *)
ourConfig @ 1 = not if
"We only have one denomination of money right now. No "
"exchanges are possible." strcat .tell exit
then
ourString @
(* default case: minimize number of coins *)
dup not if
MinMoney
"All "
prog "@/mbucks/small_coins" getpropstr strcat
" exchanged for " strcat
prog "@/mbucks/large_coins" getpropstr strcat
"." strcat .tell exit
then
(* get currency to be exchanged *)
" " STRsplit strip GetDenom pop atoi ourNumber !
(* check: has specified amount? *)
me @ ourString @ getpropstr atoi ourNumber @ < if
"You don't have that many "
prog ourString @ getpropstr strcat "." strcat .tell
-2 exit
then
ourString @ "small" instr
prog "@/mbucks/rate" getpropstr atoi
ourNumber @ > and if
"You need at least "
prog "@/mbucks/rate" getpropstr strcat " " strcat
prog "@/mbucks/small_coins" getpropstr strcat
" to exchange for 1 " strcat
prog "@/mbucks/large_coin" getpropstr strcat
"." strcat .tell exit
then
(* these exchange loops really should be optimized
to handle everything on the stack rather than
setting props with each iteration. Some day. *)
(* do exchange... *)
ourNumber @
(* ... this way for large -> small ... *)
ourString @ "@/mbucks/large_coins" smatch if
begin (* BEGIN L -> S EXCHANGE LOOP *)
ourNumber @ while
me @ "@/mbucks/small_coins" over over
getpropstr atoi
prog "@/mbucks/rate" getpropstr atoi + intostr setprop
me @ "@/mbucks/large_coins" over over
getpropstr atoi 1 - intostr setprop
ourNumber @ 1 - ourNumber !
repeat (* END L -> S EXCHANGE LOOP *)
else
(* ... or this way for small -> large *)
begin (* BEGIN S -> L EXCHANGE LOOP *)
ourNumber @
prog "@/mbucks/rate" getpropstr atoi >= while
me @ "@/mbucks/small_coins" over over
getpropstr atoi
prog "@/mbucks/rate"
getpropstr atoi - intostr setprop
me @ "@/mbucks/large_coins" over over
getpropstr atoi 1 + intostr setprop
ourNumber @
prog "@/mbucks/rate" getpropstr atoi - ourNumber !
repeat (* END S -> L EXCHANGE LOOP *)
then
(* don't notify if this exchange were
made internally in order to give user
enough of one currency for a charge *)
ourBoolean @ not if (* otherwise, notify *)
intostr ourString @ "large" instr if
dup "1" smatch if
" " strcat
prog "@/mbucks/large_coin" getpropstr strcat
else
" " strcat
prog "@/mbucks/large_coins" getpropstr strcat
then
" exchanged for " strcat
prog "@/mbucks/small_coins" getpropstr strcat
"." strcat
else
dup "1" smatch if
" " strcat
prog "@/mbucks/small_coin" getpropstr strcat
else
atoi dup
prog "@/mbucks/rate" getpropstr atoi % -
intostr
" " strcat
prog "@/mbucks/small_coins" getpropstr strcat
then
" exchanged for " strcat
prog "@/mbucks/large_coins" getpropstr strcat
"." strcat
then
.tell
then
;
: CleanUpTimes ( -- ) (* clean up old 'allowed' times
when a charge/credit is run *)
trig "@/mbucks/times/" nextprop ourNumber !
begin (* BEGIN PROP-CLEANING LOOP *)
ourNumber @ while
trig ourNumber @ getprop systime < if
trig ourNumber @ over over
nextprop ourNumber ! remove_prop
continue
then
trig ourNumber @ nextprop ourNumber !
repeat (* END PROP-CLEANING LOOP *)
;
: ConfirmAction ( -- i ) (* confirm that action is properly
authorized and configured, and
that user has enough money *)
(* return false if ok; otherwise
return in error code *)
trig "@/mbucks/main" getpropstr if
"Sorry, the '" ourString @ strcat
"' function is reserved for authorized " strcat
"actions that call MuckBucks through MPI." strcat .tell
-4 exit
then
trig "@/mbucks/" ourString @ strcat "_ok?" strcat
getpropstr not if
-4 exit
then
ourString @ "charge" smatch if
me @ "@/mbucks/large_coins" getpropstr atoi
prog "@/mbucks/rate" getpropstr atoi *
me @ "@/mbucks/small_coins" getpropstr atoi
< if
-2 exit
then
then
trig "@/mbucks/time" getprop if
CleanUpTimes
trig "@/mbucks/times/" me @ intostr strcat getprop
systime > if
-3 exit
then
trig "@/mbucks/times/" me @ intostr strcat
trig "@/mbucks/time" getprop systime + setprop
then
0
;
: RunConfirm ( -- i ) (* notify user of charge/credit;
read yes/no input; return
1 for yes or 0 for no *)
(* notify *)
">> This action " ourString @ strcat "s you " strcat
trig "@/mbucks/" ourString @ strcat "/large_coins" strcat
getpropstr dup if
dup "1" smatch if
" " prog "@/mbucks/large_coin" getpropstr
else
" " prog "@/mbucks/large_coins" getpropstr
then
strcat strcat strcat
trig "@/mbucks/" ourString @ strcat "/small_coins" strcat
getpropstr if
" and " strcat
then
else
pop " " strcat
then
trig "@/mbucks/" ourString @ strcat "/small_coins" strcat
getpropstr dup if
dup "1" smatch if
" " prog "@/mbucks/small_coin" getpropstr
else
" " prog "@/mbucks/small_coins" getpropstr
then
strcat strcat strcat
else
pop
then
"." strcat .tell
">> Do you want to continue?" .tell
">> [Enter 'yes' or 'no']" .tell
ReadYesNo not if (* read confirmation *)
0
then
1
;
: RunLog ( -- ) (* log transaction in trig list _mb_log *)
(* create text line for log *)
"%I:%M %p, %D: " systime timefmt
me @ name strcat ourString @ "charge" smatch if
" charged "
else
" credited "
then
strcat
trig "@/mbucks/" ourString @ strcat "/large_coins" strcat
getpropstr dup if
dup "1" smatch if
" " prog "@/mbucks/large_coin" getpropstr
else
" " prog "@/mbucks/large_coins" getpropstr
then
strcat strcat strcat
trig "@/mbucks/" ourString @ strcat "/small_coins" strcat
getpropstr if
" and " strcat
then
else
pop " " strcat
then
trig "@/mbucks/" ourString @ strcat "/small_coins" strcat
getpropstr dup if
dup "1" smatch if
" " prog "@/mbucks/small_coin" getpropstr
else
" " prog "@/mbucks/small_coins" getpropstr
then
strcat strcat strcat
else
pop
then
"." strcat (* append to log *)
"_mb_log" trig LMGR-GetCount 1 +
"_mb_log" trig LMGR-PutElem
;
: DoCharge ( -- ) (* check funds; charge user *)
(* ourBoolean is true if action already confirmed *)
ourBoolean @ not if
"charge" ourString !
ConfirmAction dup if exit else pop then
then
(* check for player-specific charge amount *)
trig "@/mbucks/charge/large_coins/" me @ intostr strcat getpropstr
trig "@/mbucks/charge/small_coins/" me @ intostr strcat getpropstr
or if
"/" me @ intostr strcat ourPlayer !
else
"" ourPlayer !
then
(* get total value of charge *)
trig "@/mbucks/charge/large_coins" ourPlayer @ strcat
getpropstr atoi
prog "@/mbucks/rate" getpropstr atoi *
trig "@/mbucks/charge/small_coins" ourPlayer @ strcat
getpropstr atoi +
1 ourBoolean !
(* charge large coins, exchanging
small coins for large if needed *)
begin
me @ "@/mbucks/large_coins" getpropstr atoi
trig "@/mbucks/charge/large_coins" ourPlayer @ strcat
getpropstr atoi >= if
me @ "@/mbucks/large_coins" over over getpropstr atoi
trig "@/mbucks/charge/large_coins" ourPlayer @ strcat
getpropstr atoi -
intostr setprop break
else
prog "@/mbucks/rate" getpropstr " " strcat
prog "@/mbucks/small_coins" getpropstr strcat
ourString ! pop DoExchange continue
then
repeat
(* charge small coins, exchanging
large coins for small if needed *)
begin
me @ "@/mbucks/small_coins" getpropstr atoi
trig "@/mbucks/charge/small_coins" ourPlayer @ strcat
getpropstr atoi >= if
me @ "@/mbucks/small_coins" over over getpropstr atoi
trig "@/mbucks/charge/small_coins" ourPlayer @ strcat
getpropstr atoi -
intostr setprop break
else
"1 "
prog "@/mbucks/large_coins" getpropstr strcat
ourString ! DoExchange continue
then
repeat
0
;
: DoCredit ( -- ) (* credit user *)
(* ourBoolean is true if action already confirmed *)
ourBoolean @ not if
"credit" ourString !
ConfirmAction dup if exit else pop then
then
(* check for player-specific credit amount *)
trig "@/mbucks/credit/large_coins/" me @ intostr strcat getpropstr
trig "@/mbucks/credit/small_coins/" me @ intostr strcat getpropstr
or if
"/" me @ intostr strcat ourPlayer !
else
"" ourPlayer !
then
trig "@/mbucks/credit/large_coins" ourPlayer @ strcat getpropstr
trig "@/mbucks/credit/small_coins" ourPlayer @ strcat getpropstr
or not if
"Action improperly configured." .tell
"Please notify " prog owner name strcat .tell
-5 exit
then
(* give user initial stake if doesn't have already *)
me @ "@/mbucks/large_coins" getpropstr
me @ "@/mbucks/large_coins" getpropstr or not if
1 ourBoolean DoStake
then
(* credit large and small coins *)
me @ "@/mbucks/large_coins" over over
getpropstr atoi
trig "@/mbucks/credit/large_coins" ourPlayer @ strcat
getpropstr atoi +
intostr setprop
me @ "@/mbucks/small_coins" over over
getpropstr atoi
trig "@/mbucks/credit/small_coins" ourPlayer @ strcat
getpropstr atoi +
intostr setprop
0
;
: DoCharge-LG ( -- ) (* do a charge and log it *)
"charge" ourString !
ConfirmAction dup if exit else pop then
1 ourBoolean !
DoCharge dup if exit then
"charge" ourString ! RunLog
;
: DoCredit-LG ( -- ) (* do a credit and log it *)
"credit" ourString !
ConfirmAction dup if exit else pop then
1 ourBoolean !
DoCredit dup if exit then
"credit" ourString ! RunLog
;
: DoCharge-CN ( -- ) (* do a charge if user confirms *)
"charge" ourString !
ConfirmAction dup if exit else pop then
1 ourBoolean !
"charge" ourString ! RunConfirm not if
-1 exit
then
DoCharge
;
: DoCredit-CN ( -- ) (* do a credit if user confirms *)
"credit" ourString !
ConfirmAction dup if exit else pop then
1 ourBoolean !
"credit" ourString ! RunConfirm not if
-1 exit
then
DoCredit
;
: DoCharge-LGCN ( -- ) (* do a logged charge if user confirms *)
"charge" ourString !
ConfirmAction dup if exit else pop then
1 ourBoolean !
"charge" ourString ! RunConfirm not if
-1 exit
then
DoCharge dup if exit then
"charge" ourString ! RunLog
;
: DoCredit-LGCN ( -- ) (* do a logged credit if user confirms *)
"credit" ourString !
ConfirmAction dup if exit else pop then
1 ourBoolean !
"credit" ourString ! RunConfirm not if
-1 exit
then
DoCredit dup if exit then
"credit" ourString ! RunLog
;
: DoFormat ( -- s ) (* return passed string, formatted for %subs *)
trig "@/mbucks/charge_ok?" getpropstr
trig "@/mbucks/charge_ok?" getpropstr or if
-3 exit
then
ourString @ " " STRsplit swap pop
prog "@/mbucks/large_coins" getpropstr "%ls" subst
prog "@/mbucks/cap_large_coins" getpropstr "%Ls" subst
prog "@/mbucks/small_coins" getpropstr "%ss" subst
prog "@/mbucks/cap_small_coins" getpropstr "%Ss" subst
prog "@/mbucks/large_coin" getpropstr "%l" subst
prog "@/mbucks/cap_large_coin" getpropstr "%L" subst
prog "@/mbucks/small_coin" getpropstr "%s" subst
prog "@/mbucks/cap_small_coin" getpropstr "%S" subst
trig "@/mbucks/charge/large_coins" getpropstr "%-l" subst
trig "@/mbucks/charge/small_coins" getpropstr "%-s" subst
trig "@/mbucks/credit/large_coins" getpropstr "%+l" subst
trig "@/mbucks/credit/small_coins" getpropstr "%+s" subst
;
: ShowChargeSyntax ( -- ) (* mini-helpscreen *)
"Syntax: " command @ strcat
" #charge <exit> = [<player>:] <number> <denomination>" strcat .tell
;
: SetCharge ( -- ) (* set up an action to charge *)
WizPerm
ourBoolean @ if
ourString @ "=" instr not if
ShowChargeSyntax exit
then
then
(* parse input *)
ourString @ "=" STRsplit swap
" " STRsplit swap pop
match dup not if
"I don't see that here." .tell exit
else
dup #-2 dbcmp if
"I'm not sure which one you mean!" .tell exit
then
then
(* exit if we're only using matching code in this func *)
ourBoolean @ if exit then
(* authorize action *)
dup "@/mbucks/charge_ok?" "yes" setprop
(* more parsing *)
swap dup " " instr not if
ShowChargeSyntax pop
"@/mbucks/charge_ok?" remove_prop exit
then
(* match player if one is specified *)
dup ":" instr if
":" STRsplit swap
.pmatch dup if
intostr "/" swap strcat ourPlayer !
else
pop pop "I can't find that player." .tell exit
then
else
"" ourPlayer !
then
" " STRsplit GetDenom pop
dup number? not if
ShowChargeSyntax pop
"@/mbucks/charge_ok?" remove_prop exit
then
(* set charge amount *)
ourString @ "/mbucks/charge" "/mbucks" subst
swap setprop
"Set." .tell
;
: ClearCharge ( -- ) (* clear charge info from an action *)
1 ourBoolean !
SetCharge (* use matching code in SetCharge *)
dup "@/mbucks/charge_ok?" remove_prop (* clear props *)
dup "@/mbucks/charge/large_coins" remove_prop
"@/mbucks/charge/small_coins" remove_prop
"Action cleared: will no longer charge." .tell
;
: ShowCreditSyntax ( -- ) (* mini-helpscreen *)
"Syntax: " command @ strcat
" #credit <exit> = [<player>:] <number> <denomination>" strcat .tell
;
: SetCredit ( -- ) (* set up an action to credit *)
WizPerm
ourBoolean @ if
ourString @ "=" instr not if
ShowCreditSyntax exit
then
then
(* parse input *)
ourString @ "=" STRsplit swap
" " STRsplit swap pop
match dup not if
"I don't see that here." .tell exit
else
dup #-2 dbcmp if
"I'm not sure which one you mean!" .tell exit
then
then
(* exit if we're only useing matching code in this func *)
ourBoolean @ if exit then
(* authorize action *)
dup "@/mbucks/credit_ok?" "yes" setprop
(* more parsing *)
swap dup " " instr not if
ShowCreditSyntax pop
"@m/mbucks/credit_ok?" remove_prop exit
then
(* match player if one is specified *)
dup ":" instr if
":" STRsplit swap
.pmatch dup if
intostr "/" swap strcat ourPlayer !
else
pop pop "I can't find that player." .tell exit
then
else
"" ourPlayer !
then
" " STRsplit GetDenom pop
dup number? not if
ShowCreditSyntax pop
"@m/mbucks/credit_ok?" remove_prop exit
then
(* set credit props *)
ourString @ "/mbucks/credit" "/mbucks" subst
ourPlayer @ strcat
swap setprop
"Set." .tell
;
: ClearCredit ( -- ) (* clear credit info from an action *)
1 ourBoolean !
SetCredit (* use matching code in SetCredit *)
dup "@/mbucks/credit_ok?" remove_prop
dup "@/mbucks/credit/large_coins" remove_prop
"@/mbucks/credit/small_coins" remove_prop
"Action cleared: will no longer credit." .tell
;
: ShowTimeSyntax ( -- ) (* mini-helpscreen *)
"Syntax: <cmd> #time <action> = <time> <units>" .tell
"Example: pay #time bank = 14 days" .tell pop
;
: SetTime ( -- ) (* set a lockout interval on a credit action *)
(* parse input *)
ourString @ "=" instr not
ourString @ " " instr not or if
ShowTimeSyntax exit
then
ourString @ " " STRrsplit strip
swap strip
"=" STRrsplit strip
dup number? not if
ShowTimeSyntax exit
then
atoi ourNumber !
(* calculate interval from units *)
swap
dup "minute*" smatch if
pop ourNumber @ 60 * ourNumber !
else
dup "hour*" smatch if
pop ourNumber @ 3600 * ourNumber !
else
dup "day*" smatch if
pop ourNumber @ 86400 * ourNumber !
else
dup "month*" smatch if
pop ourNumber @ 2592000 * ourNumber !
else
"I don't understand that unit of time." .tell
"Use minutes, hours, days, or months." .tell pop exit
then then then then
" " STRrsplit swap pop strip
match dup not if
"I don't see that here." .tell pop exit
else
dup #-2 dbcmp if
"I'm don't know which one you mean!" .tell pop exit
then
then
(* set interval as # of seconds *)
"@/mbucks/time" ourNumber @ setprop
"Set." .tell
;
: ClearTime ( -- ) (* clear time lockout info from an action *)
WizPerm
ourString @ " " instr not if
"Syntax: '" command @ strcat "' #!time <action>" strcat
.tell exit
then
(* find action *)
ourString @ " " STRsplit swap pop strip
match dup not if
"I don't see that here." .tell exit
else
dup #-2 dbcmp if
"I don't know which one you mean!" .tell exit
then
then
(* remove props *)
ourScratch !
ourScratch @ "@/mbucks/time" remove_prop
ourScratch @ "@/mbucks/times/" nextprop ourString !
begin
ourString @ while
ourScratch @ ourString @ over over
nextprop ourString ! remove_prop
repeat
"Cleared." .tell
;
: SetBank ( -- ) (* designate room as an authorized 'stake' loc *)
WizPerm
ourString @ " " instr not if
"Syntax: " command @ strcat " #bank <room or 'here'>" strcat
.tell exit
then
ourString @ " " STRrsplit swap pop strip
match dup not if
"I can't tell where you want to set the bank." .tell exit
else
dup #-2 dbcmp if
"I can't tell where you want to set the bank." .tell
pop exit
then
then
"@/mbucks/bank" "yes" setprop
"Set." .tell
;
: ClearBank ( -- ) (* remove 'stake ok' info from a room *)
WizPerm
ourString @ " " instr not if
"Syntax: " command @ strcat " #!bank <room or 'here'>" strcat
.tell exit
then
ourString @ " " STRrsplit swap pop strip
match dup not if
"I can't tell which room is supposed to be cleared." .tell exit
else
dup #-2 dbcmp if
"I can't tell which room is supposed to be cleared."
.tell exit
then
then
"@/mbucks/bank" remove_prop
"Cleared." .tell
;
: main
"me" match me !
dup ourString !
command @ ourScratch !
prog "@/mbucks/large_coins" getpropstr
prog "@/mbucks/small_coins" getpropstr and if
1 ourConfig !
else
prog "@/mbucks/large_coins" getpropstr if
2 ourConfig !
else
prog "@/mbucks/small_coins" getpropstr if
3 ourConfig !
else
DoInitialization
1 ourConfig !
then
then
then
dup if
dup "#help" swap stringpfx if DoHelp exit else
dup "charge" smatch if DoCharge exit else
dup "credit" smatch if DoCredit exit else
dup "charge-lg" smatch if DoCharge-LG exit else
dup "credit-lg" smatch if DoCredit-LG exit else
dup "charge-cn" smatch if DoCharge-CN exit else
dup "credit-cn" smatch if DoCredit-CN exit else
dup "charge-lgcn" smatch if DoCharge-LGCN exit else
dup "credit-lgcn" smatch if DoCredit-LGCN exit else
dup "format*" smatch if DoFormat exit else
dup "#charge*" smatch if SetCharge exit else
dup "#credit*" smatch if SetCredit exit else
dup "#time*" smatch if SetTime exit else
dup "#!time*" smatch if ClearTime exit else
dup "#!charge*" smatch if ClearCharge exit else
dup "#!credit*" smatch if ClearCredit exit else
dup "#tune*" smatch if DoTune exit else
dup "#rename*" smatch if DoRename exit else
dup "#alias*" smatch if DoAlias exit else
dup "#bank*" smatch if SetBank exit else
dup "#!bank*" smatch if ClearBank exit else
dup "#!alias*" smatch if Do!Alias exit else
dup "#defaults" smatch if DoDefaults exit else
dup "#defname" smatch if DoDefaultName exit else
dup "#" swap stringpfx if
"I don't understand that #argument." .tell exit
then then then then then then then then then then then then
then then then then then then then then then then then then
then
then
prog "@/aliases/" command @ strcat getpropstr dup if
command !
else
pop
then
command @
dup "pay" smatch if DoPay else
dup "purse" smatch if DoPurse else
dup "stake" smatch if DoStake else
dup "exchange" smatch if DoExchange else
"Command not understood." .tell
then then then then
;
.
c
q