@program fleabay.muf.i386.so.1.0 1 1000 d i $include $lib/alynna $def GIL me @ "gil" getprop $def AYB "/a/" $def AUCTIONEER "$avatar" match $def AUCT AUCTIONEER swap "Auction " swap strcat force $def RESERVEMET reserve @ if bid @ reserve @ >= else 0 then $def QUICKBUY? RESERVEMET not bid @ quickbuy @ <= and $def PRINT dup tostr tellme lvar param lvar item lvar itemdesc lvar price lvar reserve lvar quickbuy lvar btime lvar etime lvar bid lvar bidder lvar seller ( Define this if you will place this program into MUFCron ) $def MUFCRON "Yea" $ifdef MUFCRON $include $muf/cron $endif : yn if "Yes" else " No" then ; : xname ( d -- s ) dup #-2 dbcmp if pop "*Nobody*" else name then ; ( "String" DIVIDER tellme tellme "long string" linetell FOOTER tellme ) : linetellme (s --) (tell's a string as a list of lines.) 71 line_split begin swap 71 centre LINE " " strcat swap strcat LINE strcat .tell 1 - dup not until pop ; : linetellhere (s --) (tell's a string as a list of lines.) 71 line_split begin swap 71 centre LINE " " strcat swap strcat LINE strcat .otell 1 - dup not until pop ; : delitem ( i/s -- ) var target toint tostr target ! AUCTIONEER str "@set me=" AYB target @ ":" cat force AUCTIONEER str "Auction Item " target @ " taken off the auction." cat force ; : resolveitem ( i/s -- i ) var target var item var propcheck tostr target ! ( Check for numeric match ) target @ toint 0 > if AUCTIONEER AYB target @ "/item" strcat strcat getprop tostr "" stringcmp if AUCTIONEER AYB target @ "/item" strcat strcat getpropstr if target @ toint exit ( Number points at a valid auction ) else 0 exit then then then ( Check for item name match, return item number ) AUCTIONEER AYB array_get_propdirs foreach item ! pop AUCTIONEER AYB item @ "/item" strcat strcat getpropstr propcheck ! propcheck @ "" stringcmp propcheck @ target @ stringpfx and if item @ toint exit then repeat ( Or else return 0 ) 0 ; : delitem ( i/s -- ) var target toint tostr target ! AUCTIONEER str "@set me=" AYB target @ ":" cat force AUCTIONEER str "Auction Item " target @ " taken off the auction." cat force ; : loaditem ( i/s -- ) var btimex resolveitem tostr btimex ! AUCTIONEER str AYB btimex @ "/item" cat getpropstr item ! AUCTIONEER str AYB btimex @ "/itemdesc" cat getpropstr itemdesc ! AUCTIONEER str AYB btimex @ "/price" cat getpropval price ! AUCTIONEER str AYB btimex @ "/reserve" cat getpropval reserve ! AUCTIONEER str AYB btimex @ "/quickbuy" cat getpropval quickbuy ! AUCTIONEER str AYB btimex @ "/btime" cat getpropval btime ! AUCTIONEER str AYB btimex @ "/etime" cat getpropval etime ! AUCTIONEER str AYB btimex @ "/bidder" cat getprop bidder ! AUCTIONEER str AYB btimex @ "/seller" cat getprop seller ! AUCTIONEER str AYB btimex @ "/bid" cat getpropval bid ! ; : saveitem ( i -- ) var btimex toint tostr btimex ! AUCTIONEER str AYB btimex @ "/item" cat item @ setprop AUCTIONEER str AYB btimex @ "/itemdesc" cat itemdesc @ setprop AUCTIONEER str AYB btimex @ "/price" cat price @ setprop AUCTIONEER str AYB btimex @ "/reserve" cat reserve @ setprop AUCTIONEER str AYB btimex @ "/quickbuy" cat quickbuy @ setprop AUCTIONEER str AYB btimex @ "/btime" cat btime @ setprop AUCTIONEER str AYB btimex @ "/etime" cat etime @ setprop AUCTIONEER str AYB btimex @ "/bidder" cat bidder @ setprop AUCTIONEER str AYB btimex @ "/seller" cat seller @ setprop AUCTIONEER str AYB btimex @ "/bid" cat bid @ setprop ; : arcitem AUCTIONEER str "mv me=" AYB "/" btime @ ",me=/arc/" btime @ cat force ; : displayitem ( -- ) HEADER .tell item @ DIVIDER pop .tell str " Item number: [^CYAN^" btime @ "^NORMAL^]" " Starting bid: [^GREEN^" price @ tostr 5 rj "^NORMAL^]" cat linetellme str " Seller: [^CYAN^" seller @ xname tostr 12 lj "^NORMAL^]" " Auction start: [^CYAN^" "%x %X" btime @ timefmt "^NORMAL^]" cat linetellme str " Current bid: [^GREEN^" bid @ tostr 5 rj "^NORMAL^]" " High bidder: [^CYAN^" bidder @ xname tostr 12 lj "^NORMAL^]" cat linetellme str " Reserve? [^YELLOW^" reserve @ yn "^NORMAL^]" reserve @ if " met? [^YELLOW^" reservemet yn "^NORMAL^]" then " QuickBuy? [^YELLOW^" quickbuy? yn "^NORMAL^]" quickbuy? if " price: [^GREEN^" quickbuy @ tostr 5 rj "^NORMAL^]" then cat linetellme str " Time left: [^CYAN^" btime @ etime @ + systime - timex "^NORMAL^]" cat linetellme "Description" DIVIDER .tell .tell itemdesc @ linetellme FOOTER .tell ; : sellitem "Please enter the name of the item you are placing up for auction:" "Auction" pretty tellme read item ! "Please enter a description for the item:" "Auction" pretty tellme read itemdesc ! "Please enter the price to start the bidding at (lowest is 1 gil):" "Auction" pretty tellme read toint price ! price @ 1 < if "The bidding price must be higher than 0 gil." "Auction" pretty tellme exit then "If you set a reserve here, the reserve price must be met or exceeded, or you don't have to sell." "Auction" pretty tellme "Please enter a reserve price, or 0 for no reserve:" "Auction" pretty tellme read toint reserve ! "A 'Quickbuy' price is a price that can be paid to get the item immediately, if the reserve hasnt been met, or in auctions without a reserve, before the first bid is made." "Auction" pretty tellme "Please enter the 'Quickbuy' price, or 0 for no 'Quickbuy':" "Auction" pretty tellme read toint quickbuy ! "And how many hours would you like the auction to last? (0 for the default, 72 OOC hours)" "Auction" pretty tellme read dup toint not if tofloat else toint tofloat then etime ! etime @ 0.0 <= if 72.0 etime ! then etime @ 3600.0 * toint etime ! systime btime ! #-2 bidder ! me @ seller ! price @ bid ! displayitem "Do you want to place the item as shown above up for auction? (Y/N)" "Auction" pretty tellme read "y" stringpfx not if "Aborted." "Auction" pretty tellme exit then btime @ saveitem str "Item (" btime @ ") placed up for auction by " seller @ xname ", item name '" item @ "', starting bid " bid @ " gil." cat dup AUCT "Auction" pretty tellme ; : buyitem var itemx param @ itemx ! itemx @ resolveitem dup 0 > if itemx ! else pop str "Couldn't match your item '" itemx @ "'." cat "Auction" pretty tellme exit then itemx @ loaditem quickbuy? not if "This item is not quickbuyable. Bid on the items per standard rules please." "Auction" pretty tellme exit then GIL quickbuy @ < if str "You do not have enough gil to quickbuy this item. You need ^GREEN^" quickbuy @ "^NORMAL^." cat "Auction" tellme exit then str "This item '" item @ "' costs ^GREEN^" quickbuy @ "^NORMAL^ to buy. Are you sure? (Y/N)" cat "Auction" pretty tellme read "y" stringpfx not if "Aborted" "Auction" pretty tellme exit then ( update item data ) me @ bidder ! quickbuy @ bid ! btime @ saveitem ( deduct gil ) bidder @ "gil" bidder @ "gil" getstatint quickbuy @ - setstat seller @ "gil" seller @ "gil" getstatint quickbuy @ + setstat ( Announce ) str bidder @ xname " quickbought the item '" item @ "', auction ended." cat AUCT ( mail information ) ( inform bidder and seller ) AUCTIONEER str "p #mail " bidder @ xname " " seller @ xname "=Auction " btime @ " has ended and " bidder @ xname " has won the item '" item @ "' for " bid @ " gil using quickbuy! +auctionarc/view " btime @ " to view the details of this finished auction." reservemet not if " -- Note: The reserve on this auction has not been met, there is no requirement to sell." then cat force arcitem ; : biditem var itemx var amount param @ "=" explode 2 = not if "Syntax, +auction/bid =" "Auction" pretty tellme exit then tostr itemx ! toint amount ! itemx @ resolveitem dup 0 > if itemx ! else pop str "Couldn't match your item '" itemx @ "'." cat "Auction" pretty tellme exit then itemx @ loaditem btime @ etime @ + systime - 1 < if "This auction is over, no more bids permitted." "Auction" pretty tellme exit then amount @ bid @ <= if str "You need to bid higher than [^YELLOW^" bid @ "^NORMAL^] on this item '" item @ "'." cat "Auction" pretty tellme else str "You have bid [^YELLOW^" amount @ "^NORMAL^] on the item '" item @ "'." cat "Auction" pretty tellme amount @ bid ! me @ bidder ! etime @ 300 + etime ! str bidder @ " has bid [^YELLOW^" amount @ "^NORMAL^] on the item '" item @ "'. 5 minutes has been added to the auction." cat AUCT then itemx @ saveitem ; : listitems "^BCYAN^Number____ Name_______________________ Res QB_ Bid__ High Bidder_ TimeLeft^NORMAL^" tellme AUCTIONEER AYB array_get_propdirs foreach item ! pop item @ toint loaditem str btime @ tostr 10 lj " " item @ tostr 27 lj " " reserve @ yn " " quickbuy @ yn " " bid @ tostr 5 rj " " bidder @ xname tostr 12 lj " " str "{stimestr:" btime @ etime @ + systime - "}" cat mpime " " cat tellme repeat ; : showitem param @ resolveitem dup 0 > if dup loaditem displayitem else str "Couldn't match your item '" param @ "'." cat "Auction" pretty tellme then ; : showitemarc var btimex param @ btimex ! AUCTIONEER str "/arc/" btimex @ "/item" cat getpropstr item ! AUCTIONEER str "/arc/" btimex @ "/itemdesc" cat getpropstr itemdesc ! AUCTIONEER str "/arc/" btimex @ "/price" cat getpropval price ! AUCTIONEER str "/arc/" btimex @ "/reserve" cat getpropval reserve ! AUCTIONEER str "/arc/" btimex @ "/quickbuy" cat getpropval quickbuy ! AUCTIONEER str "/arc/" btimex @ "/btime" cat getpropval btime ! AUCTIONEER str "/arc/" btimex @ "/etime" cat getpropval etime ! AUCTIONEER str "/arc/" btimex @ "/bidder" cat getprop bidder ! AUCTIONEER str "/arc/" btimex @ "/seller" cat getprop seller ! AUCTIONEER str "/arc/" btimex @ "/bid" cat getpropval bid ! HEADER .tell item @ DIVIDER pop .tell str " Item number: [^CYAN^" btime @ "^NORMAL^]" " Starting bid: [^GREEN^" price @ tostr 5 rj "^NORMAL^]" cat linetellme str " Seller: [^CYAN^" seller @ xname tostr 12 lj "^NORMAL^]" " Auction start: [^CYAN^" "%x %X" btime @ timefmt "^NORMAL^]" cat linetellme str " Final bid: [^GREEN^" bid @ tostr 5 rj "^NORMAL^]" " High bidder: [^CYAN^" bidder @ xname tostr 12 lj "^NORMAL^]" cat linetellme str " Reserve? [^YELLOW^" reserve @ yn "^NORMAL^]" reserve @ if " met? [^YELLOW^" reservemet yn "^NORMAL^]" then " QuickBuy? [^YELLOW^" quickbuy? yn "^NORMAL^]" quickbuy? if " price: [^GREEN^" quickbuy @ tostr 5 rj "^NORMAL^]" then cat linetellme str " Auction ended: [^CYAN^" "%x %X" btime @ etime @ + timefmt "^NORMAL^]" cat linetellme "Description" DIVIDER .tell .tell itemdesc @ linetellme FOOTER .tell ; : auctionheart background $ifndef MUFCRON "Auction heart activated." AUCT begin $endif AUCTIONEER AYB array_get_propdirs foreach item ! pop item @ toint loaditem systime btime @ etime @ + >= if bidder @ #-2 dbcmp not if ( Did anyone bid on the item? ) ( inform channel ) str "Auction " btime @ " has ended and ^CYAN^" bidder @ xname " has won the item '^YELLOW^" item @ "^NORMAL^' for ^GREEN^" bid @ "^NORMAL^ gil. +auctionarc/view " btime @ " to view the details of this finished auction." reservemet not if " -- Note: The reserve on this auction has not been met, there is no requirement to sell." then cat AUCT ( inform bidder and seller ) AUCTIONEER str "p #mail " bidder @ xname " " seller @ xname "=Auction " btime @ " has ended and " bidder @ xname " has won the item '" item @ "' for " bid @ " gil. +auctionarc/view " btime @ " to view the details of this finished auction." reservemet not if " -- Note: The reserve on this auction has not been met, there is no requirement to sell." then cat force else ( inform channel ) str "Auction " btime @ " has ended and ^CYAN^noone^NORMAL^ bid on the item '^YELLOW^" item @ "^NORMAL^'. +auctionarc/view " btime @ " to view the details of this finished auction." cat AUCT ( inform bidder and seller ) AUCTIONEER str "p #mail " seller @ xname "=We're sorry, but auction " btime @ " has ended and noone has bid on the item '" item @ "'. +auctionarc/view " btime @ " to view the details of this finished auction." cat force then arcitem then repeat $ifndef MUFCRON 60 sleep repeat $endif ; : auctionhelp "Fleabay auction system v1 by Ariel Taggart (Alynna)" tellme " +auction This help" tellme " /sell Put an item up for auction" tellme " /bid Bid on an item on an auction" tellme " /buy Buy an item on 'Buy it now' status, if it has no bids or has not met reserve" tellme " /view Show the details of a particular item" tellme " /list List all items on the auction block" tellme " /del Remove an item from the auction. " tellme " +auctionarc/view" tellme " Show the details of a particular item, after the auction is over." tellme ; : main param ! $ifdef MUFCRON param @ mufcron? if auctionheart exit then $else command @ "Queued event." stringcmp not if auctionheart exit then $endif command @ "+auction/sell" stringcmp not if sellitem exit then command @ "+auction/buy" stringcmp not if buyitem exit then command @ "+auction/bid" stringcmp not if biditem exit then command @ "+auction/list" stringcmp not if listitems exit then command @ "+auction/show" stringcmp not if showitem exit then command @ "+auction/view" stringcmp not if showitem exit then command @ "+auctionarc/show" stringcmp not if showitemarc exit then command @ "+auctionarc/view" stringcmp not if showitemarc exit then listitems "Type '+help auction' for help." "Auction" pretty tellme ; . c q