@q @program asys-money 1 99999 d i ( asys-money v1.2 Jessy@FurryMUCK 6/00 INSTALLATION: asys-money uses the standard Argo installation method. Port the program and set it Wizard. Type '+install asys-money' USAGE: asys-money may be freely ported. Please comment any changes. ) (2345678901234567890123456789012345678901234567890123456789012345678901) $def thisVersion "1.2" $define Tell me @ owner swap notify $enddef $include $lib/argo $include $lib/reflist $include $lib/strings lvar ourArg (* inital arg string, unmodified *) lvar ourBoolean (* int: misc flow control var *) lvar ourCom (* string: 'official' name of command *) lvar ourCounter (* misc. counter var *) lvar ourDataObj (* dbref: object holding system-wide data *) lvar ourDenom (* string: currency denomination *) lvar ourObject (* dbref: object to sell *) lvar ourOption (* string: command #option *) lvar ourPlayer (* dbref: player we're handling *) lvar ourSource (* dbref: dbref of source room or object *) lvar ourString (* string: workspace var *) lvar scratch (* workspace var *) : DoInstall ( -- ) (* install program into Argo system *) caller program? not if (* confirm installation method *) ">> Programs must be installed via the " "+install" GetCommandName strcat " command." strcat Tell exit then prog "@a/version" getpropstr if ">> Reinstalling..." Tell else ">> Installing..." Tell then (* record 'official' name of prog; remove old links *) prog "@a/name" "asys-money" setprop RecOldActions (* create and register commands; set default props *) #0 "@a/prog_list/" prog name strcat prog setprop #0 "+account" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+account" scratch @ setprop scratch @ "@a/name" "+account" setprop #0 "+banks;+bank" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+banks" scratch @ setprop scratch @ "@a/name" "+banks" setprop #0 "+browse" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+browse" scratch @ setprop scratch @ "@a/name" "+browse" setprop #0 "+buy" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+buy" scratch @ setprop scratch @ "@a/name" "+buy" setprop #0 "+deposit" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+deposit" scratch @ setprop scratch @ "@a/name" "+deposit" setprop #0 "+exchange" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+exchange" scratch @ setprop scratch @ "@a/name" "+exchange" setprop #0 "+give" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+give" scratch @ setprop scratch @ "@a/name" "+give" setprop #0 "+income" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+income" scratch @ setprop scratch @ "@a/name" "+income" setprop #0 "+job;jobs" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+job" scratch @ setprop scratch @ "@a/name" "+job" setprop #0 "+sell" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+sell" scratch @ setprop scratch @ "@a/name" "+sell" setprop #0 "+will" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+will" scratch @ setprop scratch @ "@a/name" "+will" setprop #0 "+withdraw" newexit dup scratch ! prog setlink prog "@a/version" thisVersion setprop scratch @ "@a/version" thisVersion setprop #0 "@a/comm_list/+withdraw" scratch @ setprop scratch @ "@a/name" "+withdraw" setprop ">> Installed." Tell ; : DoUninstall (* uninstall program from Argo *) prog "@a/name" getpropstr if #0 "@a/prog_list/" prog "@a/name" getpropstr strcat getprop not if ">> " prog name strcat " is not currently installed." strcat Tell pid kill then else ">> " prog name strcat " is not currently installed." strcat Tell pid kill then ">> Please confirm: You wish to uninstall " prog name strcat "?" strcat Tell ReadYesNo not if ">> Aborted." Tell pid kill Then background "@a/comm_list/+account" RemoveCommand "@a/comm_list/+banks" RemoveCommand "@a/comm_list/+browse" RemoveCommand "@a/comm_list/+buy" RemoveCommand "@a/comm_list/+deposit" RemoveCommand "@a/comm_list/+give" RemoveCommand "@a/comm_list/+income" RemoveCommand "@a/comm_list/+job" RemoveCommand "@a/comm_list/+exchange" RemoveCommand "@a/comm_list/+sell" RemoveCommand "@a/comm_list/+will" RemoveCommand "@a/comm_list/+withdraw" RemoveCommand #0 "@a/prog_list/" prog "@a/name" getpropstr strcat remove_prop RecOldActions ">> Uninstalled. Please edit the online manual as appropriate." Tell ; (************************ Begin bank functions ************************) : DoAccountHelp ( -- ) (* show help screen for +account *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $com command is used to show your balance at the current " "bank. You must be at a bank location. Use the $banks command " "To get a listing of banks and locations." strcat strcat command @ "$com" subst "+banks" GetCommandName "$banks" subst Tell " " Tell " $com ........... Display your account balance at current bank" command @ "$com" subst Tell " " Tell ; : DoBankHelp ( -- ) (* display help screen for +banks *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $command command is used to list available banks. Staff members " "may also use it to add or remove bank locations." strcat Tell " " Tell " $com .............. List available banks" command @ "$com" subst Tell " $com #list ........ List available banks" command @ "$com" subst Tell " $com #add .. Add current location as a branch of (staff)" command @ "$com" subst Tell " $com #remove ...... Remove current location from bank system (staff)" command @ "$com" subst Tell ; : DoTransactionHelp ( -- ) (* display help for +depost & +withdraw *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $deposit and $withdraw commands are used to depost or withdraw " "money from banks." strcat "+deposit" GetCommandName "$deposit" subst "+withdraw" GetCommandName "$withdraw" subst Tell " " Tell " $com .... Deposit " "+deposit" GetCommandName "$com" subst Tell " $com .... Withdraw " "+withdraw" GetCommandName "$com" subst Tell ; : DoWillHelp ( -- ) (* display help for +will *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $com command is used to designate or remove players from the " "list of beneficiaries in your will. If you die because of IC " "events, any money you have in the bank will be divided among your " "beneficiaries. You can leave your money to 'charity' in lieu of " "specific players. You must be at a bank location to modify your " "will. When you enter the command, a list of your current " "beneficiaries will be shown, then a prompt will let you add or " "remove members from the list." strcat strcat strcat strcat strcat strcat strcat command @ "$com" subst Tell " " Tell " $com ........... Follow prompts to add or remove beneficiaries" command @ "$com" subst Tell " " Tell ; : DoShowAccount ( -- ) (* show balance at current bank *) loc @ "@a/banks/bank" getpropstr dup if ourString ! else ">> This location is not a bank." Tell ">> Cannot show balance." Tell exit then ">> Your balance at $bank:" ourString @ "$bank" subst Tell " " Tell " $large : $numlarge" ourDataObj @ "@a/sysparms/large_coins" getpropstr CapAll "$large" subst ourDataObj @ "@a/banks/$bank/$me/large_coins" ourString @ "$bank" subst me @ intostr "$me" subst getpropstr "$numlarge" subst Tell " $small : $numsmall" ourDataObj @ "@a/sysparms/small_coins" getpropstr CapAll "$small" subst ourDataObj @ "@a/banks/$bank/$me/small_coins" ourString @ "$bank" subst me @ intostr "$me" subst getpropstr "$numsmall" subst Tell " " Tell ; : DoListBanks ( -- ) (* list bank locations *) ourDataObj @ "@a/banks/" nextprop dup not if ">> No banks have been defined for this realm." Tell pop pid kill then begin (* begin bank-listing loop *) dup while dup "/branches" strcat "/" "//" subst ourDataObj @ over getpropstr if dup "" "@a/banks/" subst "" "/branches" subst ">> $bank Branches:" swap "$bank" subst Tell ourDataObj @ over REF-allrefs ourCounter ! (* get branches *) begin (* begin branch-listing loop *) ourCounter @ while " " over name strcat over "_directions" getpropstr dup if " (" swap strcat ")" strcat strcat else pop then Tell pop ourCounter @ 1 - ourCounter ! repeat (* end branch-listing loop *) pop else pop then ourDataObj @ swap nextprop repeat (* end branch-listing loop *) pop (* notify if loc is a bank location *) loc @ "@a/banks/bank" getpropstr dup if ">> This location is a $bank branch." swap "$bank" subst Tell else pop then ; : DoRemoveBank ( -- ) (* remove loc from bank system *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then (* loop through banks; remove curent branch from any *) ourDataObj @ "@a/banks/" nextprop begin dup while dup "/branches" strcat "/" "//" subst ourDataObj @ over getpropstr if ourDataObj @ swap loc @ REF-delete else pop then ourDataObj @ swap nextprop repeat pop loc @ "@a/banks/bank" remove_prop ">> Current location removed from the bank system." Tell ; : DoAddBank ( -- ) (* add loc to bank system *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then ourArg @ if ourArg @ ourOption @ smatch if ">> What bank is this location to be part of?" Tell ">> [Enter bank name, or .q to quit]" Tell ReadLine strip QCheck ourArg ! then else ">> What bank is this location to be part of?" Tell ">> [Enter bank name, or .q to quit]" Tell ReadLine strip QCheck ourArg ! then DoRemoveBank ourDataObj @ "@a/banks/$bank/branches" ourArg @ "$bank" subst loc @ REF-add loc @ "@a/banks/bank" ourArg @ setprop ">> Set." Tell ">> $loc is now part of the $bank bank." loc @ name "$loc" subst ourArg @ "$bank" subst Tell ; : DoMakeDeposit ( -- ) (* deposit X of Y currency at current bank *) (* check: approved? *) me @ ArgoCheck not if ">> Sorry, you need to set up your character before you can use " Tell " Argo money commands." Tell NukeStack exit then (* check: arg supplied? *) ourArg @ not if ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit then (* check: at a bank? *) loc @ "@a/banks/" nextprop not if ">> Sorry, this location isn't a bank." Tell NukeStack exit then (* check: currency ok? *) ourArg @ " " instr if ourArg @ dup " " instr strcut strip ourString ! strip ourCounter ! else ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit then (* check: amount ok? *) ourCounter @ number? not if ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit then (* check: positive amount? *) ourCounter @ atoi 0 < if ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit ">> must be positive." Tell then ourString @ GetDenom ourString ! (* check: has enough money? *) me @ "@a/money/$denom" ourString @ "$denom" subst getpropstr atoi ourCounter @ atoi < if ">> You don't have that to deposit." Tell NukeStack exit then (* deposit specified amount in bank *) ourDataObj @ "@a/banks/$bank/$me/$denom" loc @ "@a/banks/bank" getpropstr "$bank" subst me @ intostr "$me" subst ourString @ "$denom" subst over over getpropstr atoi ourCounter @ atoi + intostr setprop (* remove specified amount from player *) me @ "@a/money/$denom" ourString @ "$denom" subst over over getpropstr atoi ourCounter @ atoi - intostr setprop (* convert balance to least coins *) ourDataObj @ "@a/banks/$bank/$me/" loc @ "@a/banks/bank" getpropstr "$bank" subst me @ intostr "$me" subst scratch ! begin ourDataObj @ scratch @ "small_coins" strcat getpropstr atoi 100 > while ourDataObj @ scratch @ "large_coins" strcat over over getpropstr atoi 1 + intostr setprop ourDataObj @ scratch @ "small_coins" strcat over over getpropstr atoi 100 - intostr setprop repeat (* notify *) ">> You deposit $num $denom at $bank." ourCounter @ "$num" subst ourDataObj @ "@a/sysparms/" ourString @ strcat getpropstr "$denom" subst loc @ "@a/banks/bank" getpropstr "$bank" subst Tell loc @ me @ ">> $name makes a bank deposit." me @ name "$name" subst notify_except ; : DoMakeWithdraw ( -- ) (* withdraw X of Y currency from current bank *) (* check: approved? *) me @ ArgoCheck not if ">> Sorry, you need to set up your character before you can use " Tell " Argo money commands." Tell NukeStack exit then (* check: arg supplied? *) ourArg @ not if ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit then (* check: at a bank? *) loc @ "@a/banks/" nextprop not if ">> Sorry, this location isn't a bank." Tell NukeStack exit then (* check: both args supplied? *) ourArg @ " " instr if ourArg @ dup " " instr strcut strip ourString ! strip ourCounter ! else ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit then (* check: amount ok? *) ourCounter @ number? not if ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit then (* check: amount positive? *) ourCounter @ atoi 0 < if ">> Syntax: $com " ourCom @ "$com" subst Tell NukeStack exit ">> must be positive." Tell then ourString @ GetDenom ourString ! (* convert balance to small_coins to simplify amount check *) ourDataObj @ "@a/banks/$bank/$me/large_coins" loc @ "@a/banks/bank" getpropstr "$bank" subst me @ intostr "$me" subst getpropstr atoi 100 * ourDataObj @ "@a/banks/$bank/$me/small_coins" loc @ "@a/banks/bank" getpropstr "$bank" subst me @ intostr "$me" subst getpropstr atoi + (* check: user has enough in back? *) ourCounter @ atoi ourString @ "large_coins" smatch if 100 * then < if ">> You don't have that much in the bank." Tell NukeStack exit then (* remove specified amount from balance *) "@a/banks/$bank/$me/" loc @ "@a/banks/bank" getpropstr "$bank" subst me @ intostr "$me" subst scratch ! begin ourDataObj @ scratch @ "large_coins" strcat getpropstr atoi while ourDataObj @ scratch @ "large_coins" strcat over over getpropstr atoi 1 - intostr setprop ourDataObj @ scratch @ "small_coins" strcat over over getpropstr atoi 100 + intostr setprop repeat ourDataObj @ scratch @ "small_coins" strcat over over getpropstr atoi ourCounter @ atoi ourString @ "large_coins" smatch if 100 * then - intostr setprop (* convert back to least amount of coins *) begin ourDataObj @ scratch @ "small_coins" strcat getpropstr atoi 100 > while ourDataObj @ scratch @ "large_coins" strcat over over getpropstr atoi 1 + intostr setprop ourDataObj @ scratch @ "small_coins" strcat over over getpropstr atoi 100 - intostr setprop repeat (* add specified amount to player *) me @ "@a/money/" ourString @ strcat over over getpropstr atoi ourCounter @ atoi + intostr setprop (* notify *) ">> You withdraw $num $denom from $bank." ourCounter @ "$num" subst ourDataObj @ "@a/sysparms/" ourString @ strcat ourCounter @ "1" smatch if dup strlen 1 - strcut pop then getpropstr "$denom" subst loc @ "@a/banks/bank" getpropstr "$bank" subst Tell loc @ me @ ">> $name makes a bank withdrawal." me @ name "$name" subst notify_except ; : DoGetCharity ( -- s ) (* return a random silly charity *) "" ourString ! random 3 % dup 0 = if NukeStack "Lady Dalrymple's " "Sister Clarice's " "Sister Hortense's " "Sister Chastity's " "Sister Hermione's " "Our Lady of Perpetual Motion's " "Sister Bob's " random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat ourString @ "Home for " strcat ourString ! "Repentent " "Unrepentent " "Intransigent " "Nonviolent " "Rehabilitated " "Unrehabilitated " "Wayward " "Rabid " "Lascivious " "Insolvent " "Unwed " "Obstreperous " random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat "Lepers" "Recycling Recidivists" "Chicken Lovers" "Anarchists" "Can Collectors" "Tractor Pull Enthusiasts" "Foot Fetishists" "Triskadecaphobics" "Spelunkers" "Cracker Salters" "Lawyers" "Microsoft Employees" "Designated Hitters" "VB Coders" "Snipers" "Mensa Members" "Talk Show Hosts" "Celine Dione Fans" "Women's Prison Movie Enthusiasts" "Wrestling Fans" random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat else 2 = if "The Weehawken " "The Sioux Falls " "The Jersey City " "The Far Rockaway " "The Bearcreek " "The Port St. Lucie " "The French Lick " "The Paducah " "The Bogata " "The La Paz " "The Kill Devil Hills " "The San Jaun Capistrano " "The San Luis Obispo " "The Ponca City " "The Kilgore " "The Liverpool " "The South Snitch " random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat ourString @ "Shelter for " strcat ourString ! "Mangy " "Overfed " "Stunned " "Nailbiting " "Bedwetting " "Headbanging " "Disoriented " "Obtuse " "Ill-Tempered " "Evil " "Underachieving " "Surly " "Feisty " "Overindulged " "Liberal " "Pathological " "Conservative " "Culturally Deprived " "Disenfranchised " "Incorrigable " "Disorganized " "Homeless " "Paranoid " "Highbrow " random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat "Weasels" "Ferrets" "Otters" "Badgers" "Skunks" "Minks" "Chinchillas" "Sidewinders" "Iguanas" "Poodles" "Kimoto Dragons" "Selicanth" "Sea Lions" "Dogs" "Cats" "Halibut" "Bass" "Sharks" "Sea Bass" "Wombats" "Cows" "Goats" "Yeti" "Platypusses" "Nutria" "Bobcats" "Palmetto Bugs" "Chiggers" "Bobwhites" "Mammoths" "Vietnamese Pot-Bellied Pigs" "Newts" random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat else "The Cure Flatulence Now Society" "The Society of Associations" "The Associations of Societies" "The Society for Psychic Transvestites (Men Who Think They Are " "Women Who Think They Can Tell the Future)" strcat "The Bald Club for Men" "The Benevolent Society for Cats Who Think They Are Pirates" "The Society for Creative Arachnids" "The Soup Group" "The Society for Downwardly Mobile Lower Highbrows from the " "Upper Middle Class" strcat "The Society for the Rehabilitation of Jerry Springer Show Guests" "The People Who Want Money Foundation" "The Government" random depth 1 - % 1 + ourCounter ! begin depth while depth ourCounter @ = if ourString @ over strcat ourString ! then pop repeat then then ourString @ if ourString @ strip else "The Society for Creative Arachnids" then ; : DoShowWill ( -- ) (* list beneficiaries *) me @ "@a/money/charity" getpropstr if DoGetCharity ">> All your money will go to $charity." swap "$charity" subst else me @ "@a/money/will" getpropstr if ">> Your will includes $ben." me @ "@a/money/will" REF-list "$ben" subst else ">> You have no named beneficaries." then then Tell ; : DoAddtoWill ( -- ) (* add a player to user's will *) begin ">> Who do you want to add to your will?" Tell ">> [Enter player name, or .q to quit]" Tell ReadLine strip QCheck dup "charity" smatch if me @ "@a/money/charity" "yes" setprop me @ "@a/money/will" remove_prop DoShowWill break then .pmatch dup if me @ "@a/money/charity" remove_prop me @ "@a/money/will" 3 pick REF-add DoShowWill break else ">> Player not found." Tell pop then repeat ; : DoRemovefromWill ( -- ) (* remove a player from user's will *) me @ "@a/money/will" getpropstr if begin ">> Who do you want to remove from your will?" Tell ">> [Enter player name, or .q to quit]" Tell ReadLine strip QCheck .pmatch dup if me @ "@a/money/will" 3 pick REF-inlist? if me @ "@a/money/will" 3 pick REF-delete ">> $player disinherited." else ">> $player wasn't a beneficiary in your will." then swap name "$player" subst Tell DoShowWill break else ">> Player not found." Tell pop then repeat else ">> You haven't named any beneficiaries. No one to remove." Tell then ; (*********************** Begin browse functions ***********************) : DoGetPrice ( s -- i1 i2 ) (* get price for s at location *) (* i2 is true if we got a price *) (* search inventory, contents, and room, in order, for a price. Return first found. Store source in ourSource *) me @ contents begin dup while dup "@a/source/buy/$object/cost" 4 pick "$object" subst getpropstr dup if swap ourSource ! swap pop atoi 1 exit else pop then next repeat pop loc @ contents begin dup while dup "@a/source/buy/$object/cost" 4 pick "$object" subst getpropstr dup if swap ourSource ! swap pop atoi 1 exit else pop then next repeat pop loc @ "@a/source/buy/$object/cost" 3 pick "$object" subst getpropstr dup if swap pop atoi 1 loc @ ourSource ! exit then pop 0 0 ; : DoBrowseList ( -- ) (* show list of items that can be bought at loc *) ">> OBJECTS AVAILABLE TO BUY AT THIS LOCATION:" Tell " " Tell NukeStack (* clear stack *) (* put room, and all players & things in room & inv on stack *) me @ contents begin dup while dup thing? if dup next else next then repeat pop loc @ contents begin dup while dup player? over thing? or if dup next else next then repeat pop loc @ (* create a propdir holding all objects available from the items on the stack *) begin depth while dup "@a/source/buy/" nextprop begin dup while ourDataObj @ scratch @ 3 pick "" "@a/source/buy/" subst strcat 4 pick 4 pick "/cost" strcat getpropstr setprop over swap nextprop repeat pop pop repeat (* display entries in temp dir *) ourDataObj @ scratch @ nextprop begin dup while dup "" scratch @ subst " [" strcat ourDataObj @ 3 pick getpropstr atoi dup 100 / intostr "." strcat rot swap strcat swap 100 % intostr dup strlen 1 = if "0" swap strcat then strcat "]" strcat ourDataObj @ rot nextprop repeat pop (* display results *) depth if depth 2-col else " " " " " " Tell Tell Tell then ; : DoBrowseObject ( -- ) (* show info for object ourArg *) ourArg @ DoGetPrice "-- " ourArg @ toupper " (" strcat strcat rot ExpressLowestMoney dup not if pop "free" then strcat ")" strcat " ------------------------------------------------------------------" strcat 76 strcut pop Tell ourDataObj @ "@a/objects/$object/desc" ourArg @ "$object" subst ShowList "---------------------------------------------------------------------------" Tell ; (************************* Begin buy functions ************************) : DoBuyHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $command command is used to buy objects made available through " "the Argo system." strcat command @ "$command" subst Tell " " Tell "Syntax:" Tell " " Tell " $command ............... List objects & prices for your location" command @ "$command" subst Tell " $command ...... Buy " command @ "$command" subst Tell " " Tell "Sources may be configured such that there is only a chance that " "an object will be available at any given time, or such that a " "given amount of time must pass between availability. So, it is " "possible that attempts to buy objects that appear in the available " "list will fail." strcat strcat strcat strcat Tell ; : DoGetPrice ( s -- i1 i2 ) (* get price for s at location *) (* i2 is true if we got a price *) (* search inventory, contents, and room, in order, for a price. Return first found. Store source in ourSource *) me @ contents begin dup while dup "@a/source/buy/$object/cost" 4 pick "$object" subst getpropstr dup if swap ourSource ! swap pop atoi 1 exit else pop then next repeat pop loc @ contents begin dup while dup "@a/source/buy/$object/cost" 4 pick "$object" subst getpropstr dup if swap ourSource ! swap pop atoi 1 exit else pop then next repeat pop loc @ "@a/source/buy/$object/cost" 3 pick "$object" subst getpropstr dup if swap pop atoi 1 loc @ ourSource ! exit then pop 0 0 ; : DoBuyList ( -- ) (* show list of items that can be bought at loc *) ">> OBJECTS AVAILABLE TO BUY AT THIS LOCATION:" Tell NukeStack (* clear stack *) (* put room, and all players & things in room & inv on stack *) me @ contents begin dup while dup thing? if dup next else next then repeat pop loc @ contents begin dup while dup player? over thing? or if dup next else next then repeat pop loc @ (* create a propdir holding all objects available from the items on the stack *) "@a/temp/$me/" me @ intostr "$me" subst scratch ! #0 scratch @ RemoveDir-r begin depth while dup "@a/source/buy/" nextprop begin dup while ourDataObj @ over "@a/objects/" "@a/source/buy/" subst "/" strcat nextprop not if over over nextprop 3 pick rot remove_prop continue then ourDataObj @ scratch @ 3 pick "" "@a/source/buy/" subst strcat 4 pick 4 pick "/cost" strcat getpropstr setprop over swap nextprop repeat pop pop repeat (* display entries in temp dir *) ourDataObj @ scratch @ nextprop begin dup while dup "" scratch @ subst " [" strcat ourDataObj @ 3 pick getpropstr atoi dup 100 / intostr "." strcat rot swap strcat swap 100 % intostr dup strlen 1 = if "0" swap strcat then strcat "]" strcat ourDataObj @ rot nextprop repeat pop (* display results *) depth if depth 3-col else " " Tell then ; : DoStaffBuy ( -- ) (* buy ourArg, no restrictions *) ourArg @ if (* check for a program call to buy *) ourDataObj @ "@a/objects/$obj/class/" ourArg @ "$obj" subst nextprop begin dup while dup dup "/" rinstr strcut swap pop #0 "@a/calls/buy" 3 pick strcat getprop dup if rot pop "#buy" rot strcat swap call exit else pop pop then ourDataObj @ swap nextprop repeat pop ourDataObj @ "@a/objects/$object/" ourArg @ "$object" subst nextprop if me @ ourArg @ CreateObject ">> Done." Tell else ">> Object '$object' not found." ourArg @ CapAll "$object" subst Tell then else #0 "@a/prog_list/asys-list" getprop dup if "objects" swap call else pop DoBuyList then then ; : DoBuyObject ( -- ) (* attempt to buy ourArg *) StaffCheck if DoStaffBuy exit then ourArg @ if (* check: object specified? *) (* check for a program call to buy *) ourDataObj @ "@a/objects/$obj/class/" ourArg @ "$obj" subst nextprop begin dup while dup dup "/" rinstr strcut swap pop #0 "@a/calls/buy" 3 pick strcat getprop dup if rot pop "#buy" rot strcat swap call exit else pop pop then ourDataObj @ swap nextprop repeat pop ourArg @ VerifyObject if (* check: valid object? *) ourArg @ DoGetPrice if (* check: valid price? *) me @ over CheckFunds if (* check: can afford? *) (* check for a program call to buy *) ourDataObj @ "@a/objects/$obj/class/" ourArg @ "$obj" subst nextprop begin dup while dup dup "/" rinstr strcut swap pop #0 "@a/calls/buy" 3 pick strcat getprop dup if rot pop "#buy" rot strcat swap call exit else pop pop then ourDataObj @ swap nextprop repeat pop (* store data dir in scratch *) "@a/source/buy/$object/" ourArg @ "$object" subst scratch ! (* check: has enough time passed? *) ourSource @ scratch @ "last" strcat getprop ourSource @ scratch @ "time" strcat getprop over over and if + systime > if pop ourSource @ scratch @ "fail" strcat getpropstr dup if Tell else pop then ourSource @ scratch @ "ofail" strcat getpropstr dup if me @ name " " strcat swap strcat loc @ me @ rot notify_except else pop then exit then else pop pop then (* check: does percent chance succeed? *) ourSource @ scratch @ "chance" strcat getpropstr atoi dup if random 100 % 1 + < if NukeStack ourSource @ scratch @ "fail" strcat getpropstr dup if Tell else pop then ourSource @ scratch @ "ofail" strcat getpropstr dup if me @ name " " strcat swap strcat loc @ me @ rot notify_except else pop then ourSource @ scratch @ "last" strcat systime setprop exit then else pop then (* passed all checks! *) me @ ourArg @ CreateObject pop (* create object *) me @ over Charge (* charge for it *) ourSource @ scratch @ "succ" strcat getpropstr dup if Tell else ">> Done." Tell pop then (* notify *) ourSource @ scratch @ "osucc" strcat getpropstr dup if me @ name " " strcat swap strcat loc @ me @ rot notify_except else pop then ourSource @ scratch @ "last" strcat systime setprop pop pop else ">> Sorry, you can't afford that right now." Tell pop exit then else ">> Sorry, $object is not available at this location." ourArg @ CapAll "$object" subst Tell then else ">> Sorry, $object is not available at this location." ourArg @ CapAll "$object" subst Tell then else DoBuyList then ; (************************* Begin give functions ***********************) : DoGiveHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The " command @ strcat " command is used to give or pay money to other players." strcat Tell " " Tell "Syntax: " command @ strcat " to " strcat Tell " " Tell "Staff members may give money to players anywhere on the MUCK, and " "may 'give' negative amounts. Non-staff may only give positive amou" "nts to players in the same room." strcat strcat Tell ; : ShowGiveSyntax ( -- ) (* show command syntax *) ">> Syntax: " command @ strcat " to " strcat Tell ; : DoGiveMoney ( s -- ) (* give something to somebody *) me @ ArgoCheck not if ">> Sorry, you need to set up your character before you can use " Tell " Argo money commands." Tell exit then ourArg @ not if ShowGiveSyntax exit then ourArg @ "to" instr not if ShowGiveSyntax exit then ourArg @ "to" STRsplit strip FindOther ourPlayer ! ourPlayer @ ArgoCheck not if ">> " ourPlayer @ name strcat " is not an Argo player." strcat Tell exit then " " STRsplit strip GetDenom ourDenom ! strip dup number? not if ">> Unable to determine amount you want to give " ourPlayer @ name strcat "." strcat Tell pop exit then scratch ! (* non-staff can't steal by giving negative money *) StaffCheck not if scratch @ atoi 0 < if ">> You can't give negative money." Tell exit then (* ... or create wealth by giving money they don't have *) me @ "@a/money/" ourDenom @ strcat getpropstr atoi scratch @ atoi < if ">> You don't have that much." Tell exit then then (* give payee the money *) ourPlayer @ "@a/money/" ourDenom @ strcat over over getpropstr atoi scratch @ atoi + intostr setprop (* subtract transfer from payers funds *) StaffCheck not if me @ "@a/money/" ourDenom @ strcat over over getpropstr atoi scratch @ atoi - intostr setprop then (* notify *) ">> You give " ourPlayer @ name strcat " " strcat scratch @ strcat " " strcat ourDataObj @ "@a/sysparms/" ourDenom @ strcat scratch @ "1" smatch if dup strlen 1 - strcut pop then getpropstr strcat "." strcat ourPlayer @ "@a/store/veron" getpropstr if ourPlayer @ "@a/store/verstring" getpropstr strcat then Tell ourPlayer @ ">> " me @ name strcat " gives you " strcat scratch @ strcat " " strcat ourDataObj @ "@a/sysparms/" ourDenom @ strcat scratch @ "1" smatch if dup strlen 1 - strcut pop then getpropstr strcat "." strcat ourPlayer @ "@a/store/veron" getpropstr if ourPlayer @ "@a/store/verstring" getpropstr strcat then notify ourPlayer @ me @ dbcmp me @ "W" flag? not and if ">> (That was kind of dumb.)" Tell then ; : DoAutoTransfer ( -- i ) (* handle an automatic funds transfer *) (* eg, when someone picks up a money object *) (* verify: an Argo object? *) trig "@a/version" getpropstr not if exit then trig "@a/money/large_coins" getpropstr (* format info, notify *) trig "@a/money/small_coins" getpropstr and if ">> You get $lnum $lcoins and $snum $scoins." trig "@a/money/large_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/large_coin" getpropstr else ourDataObj @ "@a/sysparms/large_coins" getpropstr then rot rot "$lnum" subst swap "$lcoins" subst trig "@a/money/small_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/small_coin" getpropstr else ourDataObj @ "@a/sysparms/small_coins" getpropstr then rot rot "$snum" subst swap "$scoins" subst Tell else trig "@a/money/large_coins" getpropstr if ">> You get $lnum $lcoins." trig "@a/money/large_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/large_coin" getpropstr else ourDataObj @ "@a/sysparms/small_coins" getpropstr then rot rot "$lnum" subst swap "$lcoins" subst Tell else trig "@a/money/small_coins" getpropstr if ">> You get $snum $scoins." trig "@a/money/small_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/small_coin" getpropstr else ourDataObj @ "@a/sysparms/small_coins" getpropstr then rot rot "$snum" subst swap "$scoins" subst Tell else exit then then then (* transfer funds *) me @ "@a/money/large_coins" over over getpropstr atoi trig "@a/money/large_coins" getpropstr atoi + intostr setprop me @ "@a/money/small_coins" over over getpropstr atoi trig "@a/money/small_coins" getpropstr atoi + intostr setprop trig "@a/money/" RemoveDir (* make obj harmless; set for recycle *) trig "_/sc" remove_prop trig me @ owner setown me @ owner "@a/to_recycle" trig REF-add ; (*********************** Begin exchange functions *********************) : DoExchangeHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $com command is used to exchange units of one currency " "denomination to the other." command @ "$com" subst Tell " " Tell "Syntax: " Tell " " command @ strcat Tell " \(exchange as many " ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat " as possible for " strcat ourDataObj @ "@a/sysparms/large_coins" getpropstr strcat "," strcat Tell " minimizing total number of coins\)" Tell " " Tell " " command @ strcat " " strcat Tell " \(exchange specified number of specified denomination " "for equivalent" strcat Tell " amount of the other denomination)" Tell " " Tell "Examples: " Tell " " command @ strcat " 3 " strcat ourDataObj @ "@a/sysparms/large_coins" getpropstr strcat Tell " \(exchanges 3 " ourDataObj @ "@a/sysparms/large_coins" getpropstr strcat " for 300 " strcat ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat "\)" strcat Tell " " Tell " " command @ strcat " 300 " strcat ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat Tell " \(exchanges 300 " ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat " for 3 " strcat ourDataObj @ "@a/sysparms/large_coins" getpropstr strcat "\)" strcat Tell ; : MinMoney ( -- ) (* exchange user's small coins for large coins *) begin (* begin exchange loop *) me @ "@a/money/small_coins" over over getpropstr atoi 100 >= while over over getpropstr atoi 100 - intostr setprop me @ "@a/money/large_coins" over over getpropstr atoi 1 + intostr setprop repeat (* end exchange loop *) pop pop ; : DoExchangeMoney ( s -- ) (* exchange currency *) (* default case: minimize number of coins *) ourArg @ not if MinMoney ">> All " ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat " exchanged for " strcat ourDataObj @ "@a/sysparms/large_coins" getpropstr strcat "." strcat .tell exit then (* get currency to be exchanged *) ourArg @ " " STRsplit strip GetDenom ourDenom ! atoi scratch ! (* check: has specified amount? *) me @ "@a/money/" ourDenom @ strcat getpropstr atoi scratch @ < if ">> You don't have that many " ourDataObj @ "@a/sysparms/" ourDenom @ strcat getpropstr strcat "." strcat Tell exit then ourDenom @ "small" instr 100 scratch @ > and if ">> You need at least 100 " ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat " to exchange for 1 " strcat ourDataObj @ "@a/sysparms/large_coin" getpropstr strcat "." strcat Tell exit then (* do exchange *) scratch @ ourDenom @ "large" instr if me @ "@a/money/large_coins" getpropstr atoi me @ "@a/money/small_coins" getpropstr atoi begin (* begin large-to-small exchange loop *) scratch @ 3 pick 0 > and while 100 + swap 1 - swap scratch @ 1 - scratch ! repeat (* end large-to-small exchange loop *) me @ "@a/money/small_coins" rot intostr setprop me @ "@a/money/large_coins" rot intostr setprop ">> " over intostr strcat " " strcat over 1 = if ourDataObj @ "@a/sysparms/large_coin" else ourDataObj @ "@a/sysparms/large_coins" then getpropstr strcat " exchanged for " strcat swap 100 * intostr strcat " " strcat ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat "." strcat else me @ "@a/money/large_coins" getpropstr atoi me @ "@a/money/small_coins" getpropstr atoi begin (* begin small-to-large exchange loop *) dup 100 > scratch @ 100 > and while 100 - swap 1 + swap scratch @ 100 - scratch ! repeat (* end small-to-large exchange loop *) me @ "@a/money/small_coins" rot intostr setprop me @ "@a/money/large_coins" rot intostr setprop ">> " over dup 100 % - intostr strcat " " strcat ourDataObj @ "@a/sysparms/small_coins" getpropstr strcat " exchanged for " strcat over 100 / intostr strcat " " strcat swap 100 / 1 = if ourDataObj @ "@a/sysparms/large_coin" else ourDataObj @ "@a/sysparms/large_coins" then getpropstr strcat "." strcat then Tell ; (*********************** Begin income functions ***********************) : DoIncomeHelp ( -- ) (* display help screen *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The " command @ strcat " command is used to receive a regular, " "scheduled income, provided that one has been set for you by " "the MUCK staff, or that you have a job. A certain amount of time " "(specified by the Argo " "system parameter income_interval) must pass between uses of " "the command. For example, if the interval is set to 1 week, " "then you must wait at least 1 week between times you use the " "command. The current interval here is xix." strcat strcat strcat strcat strcat strcat strcat strcat ourDataObj @ "@a/sysparms/income_interval" getpropstr "xix" subst Tell " " Tell "This system rewards players who log on frequently and who are " "attentive to their income. This is intentional." strcat Tell " " Tell "Syntax:" Tell " " Tell " $com ......................... Receive your income" command @ "$com" subst Tell " $com #show ................... Show your income" command @ "$com" subst Tell " $com ................ Show income (staff)" command @ "$com" subst Tell " $com = .... Set income (staff)" ourDataObj @ "@a/sysparms/small_coins" getpropstr "$denom" subst command @ "$com" subst Tell " " Tell ; : DoSetIncome ( -- ) (* set a player's income *) StaffCheck not if (* check permission *) ">> Permission denied." Tell exit then ourArg @ dup "=" instr strcut (* parse ourArg *) dup number? not if ">> Income amount must be a number." Tell exit then swap dup strlen 1 - strcut pop strip .pmatch dup not if ">> Player not found." Tell pop exit then dup #-2 dbcmp if ">> Ambiguous. I don't know which you mean." Tell pop exit then dup "@a/version" getpropstr not if ">> " swap name strcat " is not an Argo player." strcat Tell exit then (* income of zero removes income *) over "0" smatch if dup "@a/money/income" remove_prop ">> " swap name "'s income removed." strcat Tell pop exit then (* set and notify *) dup "@a/money/income" 4 pick setprop ">> " swap name strcat "'s income set to " strcat swap atoi ExpressLowestMoney strcat " per " strcat ourDataObj @ "@a/sysparms/income_interval" getpropstr strcat "." strcat Tell ; : DoShowIncome ( -- ) (* show a player's income *) StaffCheck not if (* check permission *) me @ ourPlayer ! then "#show" ourArg @ stringpfx if (* parse ourArg *) me @ ourPlayer ! else ourArg @ .pmatch dup not if ">> Player not found." Tell exit then dup #-2 dbcmp if ">> Ambiguous. I don't know who you mean." Tell exit then ourPlayer ! then (* show this way if no income is set *) ourPlayer @ "@a/money/income" getpropstr not ourPlayer @ "@a/money/job" getpropstr not and if ourPlayer @ me @ dbcmp if ">> You don't have an income." else ">> $player does not have an income." ourPlayer @ name "$player" subst then Tell exit then (* or show this way if we have an income *) ourPlayer @ me @ dbcmp if ">> Your" else ">> " ourPlayer @ name strcat "'s" strcat then " income is xax per xix." strcat ourPlayer @ "@a/money/income" getpropstr dup not if pop ourDataObj @ "@a/jobs/$job/salary" me @ "@a/money/job" getpropstr "$job" subst getpropstr then atoi ExpressLowestMoney "xax" subst ourDataObj @ "@a/sysparms/income_interval" getpropstr "xix" subst Tell ; : DoGetIncome ( -- ) (* give user hes income *) StaffCheck not if (* check permission *) Approved? then (* check: does user have an income? *) me @ "@a/money/income" getpropstr not me @ "@a/money/job" getpropstr not and if ">> You do not have an income." Tell exit then (* check: has enough time passed? *) me @ "@a/commands/" ourCom @ strcat getprop dup if systime ourDataObj @ "@a/sysparms/income_interval" getpropstr ParseTimeString if - < not if ">> You may next run this command %A, %D, at %R %p." me @ "@a/commands/" ourCom @ strcat getprop ourDataObj @ "@a/sysparms/income_interval" getpropstr ParseTimeString pop + timefmt ">> Sorry, not enough time has passed since your last income." Tell Tell exit then else ">> ERROR: The income interval is set incorrectly." Tell ">> Cannot complete command." Tell ">> Please contact a staff member." Tell pop then else pop then (* give income and notify *) me @ "@a/money/income" getpropstr if (* this way for fixed income *) me @ "@a/money/large_coins" over over getpropstr atoi me @ "@a/money/income" getpropstr atoi 100 / + intostr setprop me @ "@a/money/small_coins" over over getpropstr atoi me @ "@a/money/income" getpropstr atoi 100 % + intostr setprop me @ "@a/commands/" ourCom @ strcat systime setprop ">> You receive your regular income of " me @ "@a/money/income" getpropstr atoi ExpressLowestMoney strcat "." strcat Tell else (* this way for jobs *) me @ "@a/money/job" getpropstr scratch ! scratch @ not if ">> You don't have an income." Tell exit then ourDataObj @ "@a/jobs/$job/" scratch @ "$job" subst nextprop not if ">> Your job is not defined in this realm." Tell ">> Please contract a staff member." Tell exit then 3 6 0 Dice dup 4 <= if ">> You got a bonus!" Tell me @ "@a/money/small_coins" over over getpropstr atoi ourDataObj @ "@a/jobs/$job/salary" scratch @ "$job" subst getpropstr atoi 100 < if 10 else 100 then + intostr setprop then dup 17 >= if random 3 % if ">> You were temporarily laid off. No income this period." Tell pop exit else ">> Bad news... you got fired." Tell me @ "@a/money/job" remove_prop exit then then pop ourDataObj @ "@a/jobs/$job/injchance" scratch @ "$job" subst getpropstr dup if atoi 1 100 0 Dice >= if me @ "@a/stats/dam" over over getpropstr atoi ourDataObj @ "@a/jobs/$job/injdam" scratch @ "$job" subst getpropstr dup if "d" explode pop atoi swap dup "+" instr if "+" explode pop strip atoi swap strip atoi else dup "-" instr if "-" explode pop strip atoi swap strip atoi else atoi 0 then then else 1 6 0 then Dice + intostr setprop ">> You were injured on the job!" Tell me @ CheckDeath then else pop then me @ "@a/money/large_coins" over over getpropstr atoi ourDataObj @ "@a/jobs/$job/salary" scratch @ "$job" subst getpropstr atoi 100 / + intostr setprop me @ "@a/money/small_coins" over over getpropstr atoi ourDataObj @ "@a/jobs/$job/salary" scratch @ "$job" subst getpropstr atoi 100 % + intostr setprop me @ "@a/commands/" ourCom @ strcat systime setprop ">> You receive your regular income of " ourDataObj @ "@a/jobs/$job/salary" scratch @ "$job" subst getpropstr atoi ExpressLowestMoney strcat "." strcat Tell then ; (************************* Begin job functions ************************) : DoJobHelp ( -- ) (* show help screen for +jobs *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $com command is used to find, quit, or display Argo jobs. " "Use the $info command to list available jobs, their salaries, " "prequisites, hiring modifiers, and chance for injury. If you " "qualify for a job, you can attempt to get hired by typing " "'+job #find'. To quit your job, type '+job #quit'." strcat strcat strcat strcat command @ "$com" subst Tell " " Tell " $com .................... Display your current job" command @ "$com" subst Tell " $com #find .............. Follow prompts to find a job" command @ "$com" subst Tell " $com #quit .............. Confirm at prompt to quit your job" command @ "$com" subst Tell " " Tell ; : DoListJobs ( -- ) (* list defined jobs *) "@a/jobs/" 3-coln-prop ; : DoFindJobByNumber ( -- ) (* find job scratch *) scratch @ atoi scratch ! "" ourString ! 0 ourCounter ! ourDataObj @ "@a/jobs/" nextprop begin dup while ourCounter @ 1 + ourCounter ! ourCounter @ scratch @ = if dup ourString ! break then ourDataObj @ swap nextprop repeat pop ; : DoFindJobByName ( -- ) (* find job scratch *) ourDataObj @ "@a/jobs/$job/" scratch @ "$job" subst nextprop if "@a/jobs/$job" scratch @ "$job" subst ourString ! else "" ourString ! then ; : DoQuitJob ( -- ) (* user quits current job *) me @ "@a/money/job" getpropstr not if (* does user _have_ a job? *) ">> You don't have a job to quit." Tell ">> Use the '$income #job' command to get a job." "+income" GetCommandName "$income" subst Tell background 3 sleep ">> Then you can quit that job." Tell exit then (* get confirmation *) ">> Please confirm: You want to quit your job as $job? (y/n)" me @ "@a/money/job" getpropstr A-An "$job" subst Tell ReadYesNo if ">> You very professionally tell your boss to take this job and " "shove it." strcat Tell me @ "@a/money/job" remove_prop me @ "@a/money/incom" remove_prop else (* rag on weenies who keep working *) ">> You chicken out and keep working at your lousy job." Tell background 10 sleep ">> Your boss says, 'I knew you wouldn't leave." VerTell 10 sleep ">> Your boss is a jerk, really." VerTell 30 sleep me @ "@a/money/job" getpropstr if ">> Maybe you should quit after all." VerTell then 15 sleep me @ "@a/money/job" getpropstr if ">> Or maybe you shouldn't." VerTell then exit then ; : DoFindJob ( -- ) (* user attempts to find a job *) ourDataObj @ "@a/jobs/" nextprop not if (* check: are there jobs? *) ">> Sorry, no jobs have been defined for this realm." Tell exit then (* set a window on job attempts *) me @ "@a/money/hiretry" getprop dup if dup systime > if ">> Sorry, you'll have to wait until %c to try again." swap timefmt Tell exit else pop then else pop then (* find job user is trying for *) begin ">> What job do you want to try to get?" Tell ">> [Enter job, or .l to list choices, or .q to quit]" Tell ReadLine strip QCheck ".list" over stringpfx if DoListJobs NukeStack continue then scratch ! scratch @ number? if DoFindJobByNumber else DoFindJobByName then ourString @ if ourString @ "" "@a/jobs/" subst CapAll scratch ! else ">> Job not found." Tell NukeStack continue then (* check: user has perqs? *) scratch @ me @ "jobs" scratch @ CheckPerqs not if ">> Sorry, you don't have the prerequisites for that job." Tell exit then (* make a presence roll to see if user gets the job *) me @ "@a/stats/pre" GetModAbility ourDataObj @ ourString @ "/hmod" strcat getpropstr atoi + 3 6 0 Dice >= if me @ "@a/money/job" scratch @ setprop me @ "@a/money/hiretry" remove_prop ">> Congratulations. You successfully obtained a job as $job." scratch @ A-An "$job" subst Tell else ">> You try but are unable to find work as $job." scratch @ A-An "$job" subst Tell me @ "@a/money/hiretry" ourDataObj @ "@a/sysparms/income_interval" getpropstr ParseTimeString not if 604800 then systime + setprop then break repeat ">> Done." Tell ; (************************* Begin sell functions ***********************) : DoSellHelp ( -- ) (* display help screen for +sell *) " " Tell prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell "The $com command is used to sell objects made available through " "the Argo system." strcat command @ "$com" subst Tell " " Tell "Syntax:" Tell " " Tell " $com ............... List objects that can be sold at your location" command @ "$com" subst Tell " $com ...... Sell " command @ "$com" subst Tell " " Tell "The prices offered may be different at different places, or at the same " "place at different times, will not always be the same." strcat Tell " " Tell ; : DoClearOldTimes ( -- ) (* clear outdated price freeze times *) ourSource @ "@a/source/sell/freezes/" nextprop dup if ourSource @ swap "/" strcat nextprop begin dup while ourSource @ over getprop systime < if ourSource @ over nextprop ourSource @ rot remove_prop else ourSource @ swap nextprop then repeat pop else pop then ; : DoHasObject? ( -- i ) (* check: does user have an s? *) (* if so, store obj in ourObject and return true *) ourArg @ match (* try a name match first *) dup ok? over #-1 dbcmp not and if dup "@a/version" getpropstr if ourObject ! else pop then else pop (* if not found, search user's inventory *) me @ contents begin dup while dup owner me @ dbcmp if dup name ourArg @ smatch if dup "@a/version" getpropstr if ourObject ! break then then dup "@a/name" getpropstr dup if ourArg @ smatch if ourObject ! break then else pop then then next repeat pop then (* check: did we find the object? if so, return true *) ourObject @ if ourObject @ "@a/name" getpropstr ourArg ! 1 else 0 then ; : DoSellList ( -- ) (* show list of items that can be bought at loc *) ">> OBJECTS THAT CAN BE SOLD AT THIS LOCATION:" Tell NukeStack (* clear stack *) (* put room, and all players & things in room & inv on stack *) me @ contents begin dup while dup thing? if dup next else next then repeat pop loc @ contents begin dup while dup player? over thing? or if dup next else next then repeat pop loc @ (* create a propdir holding all objects available from the items on the stack *) begin depth while dup "@a/source/sell/" nextprop begin dup while ourDataObj @ over "@a/objects/" "@a/source/sell/" subst "/" strcat nextprop not if over over nextprop 3 pick rot remove_prop continue then ourDataObj @ scratch @ 3 pick "" "@a/source/sell/" subst strcat 4 pick 4 pick "/maxprice" strcat getpropstr setprop over swap nextprop repeat pop pop repeat (* display entries in temp dir *) scratch @ not if " " Tell exit then ourDataObj @ scratch @ nextprop begin dup while dup "" scratch @ subst ourDataObj @ rot nextprop repeat pop (* display results *) depth if depth 3-col else " " Tell then ; : DoSellObject ( -- ) (* attempt to sell ourArg *) ourArg @ if (* check: object specified? *) DoHasObject? if (* check: valid price? *) (* check: valid object? *) ourObject @ "@a/name" getpropstr VerifyObject if ourArg @ DoGetPrice if (* check: can we get a price? *) (* check for a program call to sell *) ourDataObj @ "@a/objects/$obj/class/" ourArg @ "$obj" subst nextprop begin dup while dup dup "/" rinstr strcut swap pop #0 "@a/calls/sell" 3 pick strcat getprop dup if rot pop "#sell" rot strcat swap call exit else pop pop then ourDataObj @ swap nextprop repeat pop DoClearOldTimes (* clear old price freezes *) (* get price: either a freeze, or a new price *) ourSource @ "@a/source/sell/freezes/" ourObject @ intostr strcat "/" strcat nextprop dup if dup "/" rinstr strcut swap pop atoi swap pop else pop ourSource @ "@a/source/sell/$object/minprice" ourArg @ "$object" subst getpropstr dup if atoi over swap - random swap % 1 + - else pop then then scratch ! (* show price offered: see if user wants to sell *) ">> You can get $price for $object here." scratch @ ExpressLowestMoney dup not if pop "zilch" then "$price" subst ourObject @ name "$object" subst Tell ">> Do you want to sell it at that price? (y/n)" Tell ReadYesNo if (* if so, credit and recycle *) me @ scratch @ Credit MinMoney ourSource @ "@a/source/sell/$object/succ" ourObject @ name "$object" subst getpropstr dup if scratch @ ExpressLowestMoney "%price" subst Tell else ">> Done." Tell pop then ourSource @ "@a/source/sell/$object/osucc" ourObject @ name "$object" subst getpropstr dup if scratch @ ExpressLowestMoney "%price" subst loc @ me @ dup name " " strcat 4 rotate strcat notify_except else pop then ourObject @ recycle exit then (* otherwise, set price freeze if needed, and exit *) ourSource @ "@a/source/sell/$object/time" ourArg @ "$object" subst getprop dup if systime + ourSource @ "@a/source/sell/freezes/" ourObject @ intostr strcat "/" strcat scratch @ intostr strcat rot setprop then ">> Done." Tell else ">> Sorry, $object cannot be sold at this location." ourArg @ CapAll "$object" subst Tell then else ">> Sorry, $object cannot be sold at this location." ourArg @ CapAll "$object" subst Tell then else ">> Sorry, you don't have one of those to sell." Tell then else DoSellList then ; (********************** Begin top-level functions *********************) : DoAccount ( -- ) (* show account at current bank *) ourOption @ if "#help" ourOption @ stringpfx if DoAccountHelp exit else ">> #Option not understood." Tell exit then then DeadCheck Approved? DoShowAccount ; : DoBanks ( -- ) (* parse and find bank function *) ourArg @ if "#help" ourArg @ stringpfx if DoBankHelp else DeadCheck "#list" ourArg @ stringpfx if DoListBanks else "#add" ourArg @ stringpfx if DoAddBank else "#remove" ourArg @ stringpfx if DoRemoveBank else ">> #Option not understood." Tell then then then then else DoListBanks then ; : DoBrowse ( -- ) (* attempt to browse *) "@a/temp/" me @ intostr strcat "/" strcat scratch ! ourArg @ if DoBrowseObject else DoBrowseList then ; : DoBuy ( -- ) (* parse and find buy function *) ourArg @ if "#help" ourArg @ stringpfx if DoBuyHelp exit else DeadCheck DoBuyObject then else DoBuyList then ; : DoDeposit ( -- ) (* make depost at current bank *) ourOption @ if "#help" ourOption @ stringpfx if DoTransactionHelp exit else ">> #Option not understood." Tell exit then then DeadCheck Approved? DoMakeDeposit ; : DoExchange ( -- ) (* exchange denominations *) ourOption @ if "#help" ourOption @ stringpfx if DoExchange exit else ">> #Option not understood." Tell exit then then DoExchangeMoney ; : DoGive ( -- ) (* give money to someone *) ourOption @ if "#help" ourOption @ stringpfx if DoGiveHelp exit else ">> #Option not understood." Tell exit then then DoGiveMoney ; : DoIncome ( -- ) (* set, show, or get player income *) ourOption @ if "#help" ourOption @ stringpfx if DoIncomeHelp exit else DeadCheck Approved? "#show" ourOption @ stringpfx if DoShowIncome exit else ">> #Option not understood." Tell exit then then then DeadCheck Approved? ourArg @ if ourArg @ "=" instr if DoSetIncome else DoShowIncome then else DoGetIncome then ; : DoJob ( -- ) (* user tries to get a job *) ourOption @ if "#help" ourOption @ stringpfx if DoJobHelp exit else DeadCheck Approved? "#find" ourOption @ stringpfx if DoFindJob exit else "#quit" ourOption @ stringpfx if DoQuitJob exit else ">> #Option not understood." Tell exit then then then then DeadCheck Approved? me @ "@a/money/job" getpropstr dup if ">> Your job is '$job'." swap CapAll "$job" subst Tell else ">> You don't have a job." Tell pop then ; : DoSell ( -- ) (* sell something *) ourArg @ if "#help" ourArg @ stringpfx if DoSellHelp exit else DeadCheck Approved? DoSellObject then else DoSellList then ; : DoWithdraw ( -- ) (* make withdrawal at current bank *) ourOption @ if "#help" ourOption @ stringpfx if DoTransactionHelp exit else ">> #Option not understood." Tell exit then then DeadCheck Approved? DoMakeWithdraw ; : DoWill ( -- ) (* add or remove someone from user's will *) ourOption @ if "#help" ourOption @ stringpfx if DoWillHelp exit else ">> #Option not understood." Tell exit then then DeadCheck Approved? DoShowWill me @ "@a/money/will" getpropstr if begin ">> Do you want to add or remove someone from your will?" Tell ">> [Enter 'add', 'remove', or .q to quit]" Tell ReadLine strip QCheck "add" over stringpfx if pop DoAddtoWill break then "remove" over stringpfx if pop DoRemovefromWill break then ">> Invalid entry." Tell pop repeat else DoAddtoWill then ">> Done." Tell ; : DoAutoTrans ( -- i ) (* handle an automated transfer of money *) (* eg, picking up a money object *) (* check: trig is an argo obj? *) trig "@a/version" getpropstr not if 0 exit then trig "@a/money/large_coins" getpropstr (* notify w/ amount *) trig "@a/money/small_coins" getpropstr and if ">> You get $lnum $lcoins and $snum $scoins." trig "@a/money/large_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/large_coin" getpropstr else ourDataObj @ "@a/sysparms/large_coins" getpropstr then rot rot "$lnum" subst swap "$lcoins" subst trig "@a/money/small_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/small_coin" getpropstr else ourDataObj @ "@a/sysparms/small_coins" getpropstr then rot rot "$snum" subst swap "$scoins" subst Tell else trig "@a/money/large_coins" getpropstr if ">> You get $lnum $lcoins." trig "@a/money/large_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/large_coin" getpropstr else ourDataObj @ "@a/sysparms/small_coins" getpropstr then rot rot "$lnum" subst swap "$lcoins" subst Tell else trig "@a/money/small_coins" getpropstr if ">> You get $snum $scoins." trig "@a/money/small_coins" getpropstr dup "1" smatch if ourDataObj @ "@a/sysparms/small_coin" getpropstr else ourDataObj @ "@a/sysparms/small_coins" getpropstr then rot rot "$snum" subst swap "$scoins" subst Tell else 1 exit then then then me @ "@a/money/large_coins" over over (* transfer funds *) getpropstr atoi trig "@a/money/large_coins" getpropstr atoi + intostr setprop me @ "@a/money/small_coins" over over getpropstr atoi trig "@a/money/small_coins" getpropstr atoi + intostr setprop trig "@a/money/" RemoveDir (* make obj useless; set for recycle *) trig "_/sc" remove_prop trig me @ owner setown me @ owner "@a/to_recycle" trig REF-add 1 ; : main "me" match me ! (* initialize *) GetDataObj ourDataObj ! strip ourArg ! trig "@a/name" getpropstr ourCom ! Update ourArg @ if ourArg @ "#" stringpfx if ourArg @ " " instr if ourArg @ dup " " instr strcut strip ourArg ! strip ourOption ! else ourArg @ strip ourOption ! then "#auto" ourOption @ stringpfx if DoAutoTransfer exit else "#enable" ourOption @ stringpfx if DoEnable exit else "#disable" ourOption @ stringpfx if DoDisable exit else "#version" ourOption @ stringpfx if DoVersion exit else "#install" ourOption @ stringpfx if DoInstall exit else "#uninstall" ourOption @ stringpfx if DoUninstall exit else then then then then then then then then me @ ArgoPermCheck Disabled? ourCom @ "+account" smatch if DoAccount exit then ourCom @ "+banks" smatch if DoBanks exit then ourCom @ "+browse" smatch if DoBrowse exit then ourCom @ "+buy" smatch if DoBuy exit then ourCom @ "+exchange" smatch if DoExchange exit then ourCom @ "+give" smatch if DoGive exit then ourCom @ "+deposit" smatch if DoDeposit exit then ourCom @ "+income" smatch if DoIncome exit then ourCom @ "+job" smatch if DoJob exit then ourCom @ "+sell" smatch if DoSell exit then ourCom @ "+will" smatch if DoWill exit then ourCom @ "+withdraw" smatch if DoWithdraw exit then ">> ERROR: Command not found." Tell ; . c q @set asys-money=W