@q
@program cmd-@create
1 99999 d
i
  
( cmd-@create    v1.0    Jessy @ FurryMUCK    3/00
  
  Cmd-@create emulates the standard @create command and incorporates
  quota control.
  
  INSTALLATION:
  
  Port cmd-@create and set it Wizard. Link a global action named '@create'
  to it.
  
  Cmd-@create requires lib-quota, which should be available at the MUCK
  or website where you obtained this program.
  
  Cmd-@create may be freely ported. Please comment any changes.
)
 
(2345678901234567890123456789012345678901234567890123456789012345678901)
 
lvar ourCost
lvar ourRegname
lvar ourString
lvar ourThing
 
$include $lib/quota
 
$define Tell me @ swap notify $enddef 
$define NukeStack begin depth while pop repeat $enddef
 
: DoHelp
  
  " " Tell
  "@create <object> [=<cost> [=<regname>]]" Tell " " Tell
  
"Creates a new object and places it in your inventory. This costs at "
"least ten pennies. If <cost> is specified, you are charged that many "
"pennies, and in return, the object is endowed with a value according to "
"the formula: ((cost / 5) - 1). Usually the maximum value of an object is "
"100 pennies, which would cost 505 pennies to create. If a <regname> is "
"specified, then the _reg/<regname> property on the player is set to the "
"dbref of the new object. This lets players refer to the object as "
"$<regname> (ie: $mybutton) in @locks, @sets, etc. Only a builder may use "
"this command."
  strcat strcat strcat strcat strcat strcat strcat strcat Tell
;
 
: DoThingQuota  (  --  )   (* return true if user has quota available *)
 
  me @ "things" CheckQuota not if               (* check user's quota *)
    "You are at or over your limit of things." Tell 0 exit
  then
  NukeStack 1
;
 
: DoCheckThingCost  (  -- i )  (* return true if user can afford object,
                                  at either default or specified cost *)
  
  me @ Exempt? if 1 exit then
   
  ourCost @ not if
    "10" ourCost !
  then
  
  ourCost @ number? not if
    "10" ourCost !
  then
  
  ourCost @ atoi 0 < if
    "10" ourCost !
  then
  
  ourCost @ string? not if
    ourCost @ intostr ourCost !
  then
   
  me @ pennies ourCost @ atoi < if
    "Sorry, you don't have enough $pennies."
    "pennies" sysparm "$pennies" subst Tell 0 
  else
    1
  then
; 
 
: DoChargeThingCost  (  --  )               (* charge cost for object *)
  
    (* calculate if value is specified; charge result or default of 1 *)
  ourCost @ not if "10" ourCost ! then
  ourCost @ "10" smatch not if
    ourThing @
    ourCost @ atoi 5 /
    dup 100 > if
      pop 100
    then
    dup me @ pennies > if
      1 - addpennies
    else
      pop 
      ourThing @ me @ pennies addpennies
      me @ dup pennies -1 * addpennies
    then
  then
   
  me @ Exempt? not if
    me @ ourCost @ atoi -1 * addpennies
  then
;    
 
: DoCreate  (  --  )              (* create and register Thing object *)
  
  me @ ourThing @ newobject ourThing !
  "$Thing created with number $dbref."
  ourThing @ name    "$Thing" subst
  ourThing @ intostr "$dbref" subst Tell
  
  DoChargeThingCost
  
  ourRegname @ if
    ourThing @ ourRegname @ RegisterObject
  then
;  
  
: DoParse  (  --  )                         (* parse command and args *)
  
  ourString @ "=" instr if
    ourString @ dup "=" instr strcut strip ourCost !
    strip dup strlen 1 - strcut pop strip ourThing !
    ourCost @ "=" instr if
      ourCost @ dup "=" instr strcut strip ourRegname !
      strip dup strlen 1 - strcut pop strip ourCost !
    then
  else
    ourString @ ourThing !
  then

	DoCheckThingCost not if exit then
  
  ourThing @ CheckName if
    DoCreate
  else
    "That's a silly name for a thing!" Tell
  then
;
 
: main
  
  "me" match me !
  
  me @ "B" flag? not if
    "That command is restricted to authorized builders." Tell exit
  then 
  
  dup if
    ourString !
    "#help" ourString @ stringpfx if DoHelp exit then
    DoThingQuota not if exit then                       (* check cost *)
    DoParse
  else
    "Create what?" Tell
  then
;
.
c
q
@set cmd-@create=W