OH GOD MULTI USER FORTH WAS HORRIBLE I DON'T MISS IT ONE BIT

Phones.muf

(** BuyPhone.muf [c] Nilesta, 2000 http://members.home.net/tiadasia/    **)
 
$def PPROG #277    (** DBREF of Phones.muf                              **)
 
(** The following are for costs.  If you don't want costs, set them all **)
(** to 0.  Per-month cost is added up and stored on the phone object    **)
(** under '@phone/upkeep'                                               **)
(** This /does not/ actually charge them the per-month costs.  You'll   **)
(** need to program something to do that if you want it done.           **)
 
$def CW-COST  25   (** Upfront cost of Call-waiting                     **)
$def CW-CPM   10   (** Per month cost of Call-waiting                   **)
$def CC-COST  25   (** Upfront cost of Conference calling               **)
$def CC-CPM   10   (** Per month cost of conference calling             **)
$def CID-COST 25   (** Upfront cost of caller ID                        **)
$def CID-CPM  10   (** Per month cost of caller ID                      **)
$def VM-COST  25   (** Upfront cost of voice mail                       **)
$def VM-CPM   10   (** Per month cost of voice mail                     **)
$def BASE     50   (** Upfront cost for basic phone                     **)
$def BASE-CPM 20   (** Per month cost for phone service                 **)
 
(** End Customization                                                   **)
 
LVAR CW
LVAR CC
LVAR CID
LVAR VM
 
$include $lib/middleman
$include $lib/strings
 
: print-screen
  "Option               Taken? Cost Per Month" .tell
  "------------------------------------------" .tell
  "Basic Phone Service  YES    " BASE intostr 4 .right strcat " "
    strcat BASE-CPM intostr strcat .tell
  "Call Waiting         " CW @ if "YES    " else "NO     " then strcat
    CW @ if CW-COST else 0 then intostr 4 .right strcat " " strcat
    CW @ if CW-CPM else 0 then intostr strcat .tell
  "Conference Calling   " CC @ if "YES    " else "NO     " then strcat
    CC @ if CC-COST else 0 then intostr 4 .right strcat " " strcat
    CC @ if CC-CPM else 0 then intostr strcat .tell
  "Caller ID            " CID @ if "YES    " else "NO     " then strcat
    CID @ if CID-COST else 0 then intostr 4 .right strcat " " strcat
    CID @ if CID-CPM else 0 then intostr strcat .tell
  "Voice Mail           " VM @ if "YES    " else "NO     " then strcat
    VM @ if VM-COST else 0 then intostr 4 .right strcat " " strcat
    VM @ if VM-CPM else 0 then intostr strcat .tell
  "------------------------------------------" .tell
  "                            "
  BASE CW @ if CW-COST + then
  CC @ if CC-COST + then
  CID @ if CID-COST + then
  VM @ if VM-COST + then intostr 4 .right strcat " " strcat
  BASE-CPM CW @ if CW-CPM + then
  CC @ if CC-CPM + then
  CID @ if CID-CPM + then
  VM @ if VM-CPM + then intostr strcat .tell " " .tell
  "Commands: [CC] - Toggle Conference Calling; [CW]  - Toggle Call Waiting;" .tell
  "          [VM] - Toggle Voice Mail;         [CID] - Toggle Caller ID;" .tell
  "          [C]  - Cancel without buying;     [Q]   - Buy this phone" .tell
;
 
: make-number
  begin
  random 9 % 1 + intostr
  random 10 % intostr strcat
  random 10 % intostr strcat
  random 10 % intostr strcat
  PPROG "@phone/phones/" 3 pick strcat getprop not if
    break
  then pop repeat
;
 
: make-phone
  me @ "Phone" newobject
  dup me @ setlink
  make-number
  PPROG "@phone/phones/" 3 pick strcat 4 pick setprop
  over "@phone/code" 3 pick atoi setprop
  swap dup "@phone/CW?" cw @ if "YES" else "NO" then setprop
  dup "@phone/CC?" cc @ if "YES" else "NO" then setprop
  dup "@phone/CID?" cid @ if "YES" else "NO" then setprop
  dup "@phone/VM?" vm @ if "YES" else "NO" then setprop
  dup "call;answer;talk;cid;vmail;click;discon;status;sd" newexit PPROG setlink
  dup "@phone/upkeep"
  BASE-CPM CW @ if CW-CPM + then
  CC @ if CC-CPM + then
  CID @ if CID-CPM + then
  VM @ if VM-CPM + then setprop
  "Enter an ID for this phone, now:" .arg
  over "@phone/ID" rot setprop
  pop "Your phone number is " swap strcat .tell
  "See 'call #help' for information on how to use your phone." .tell
;
 
: main
  0 CW ! 0 CC ! 0 CID ! 0 VM !
  begin
  print-screen
  read strip dup not if pop "Invalid option." .tell continue then
  toupper
  dup "Q" stringcmp not if 1 break then
  dup "C" stringcmp not if 0 break then
  dup "CW" stringcmp not if pop CW @ if 0 else 1 then CW ! continue then
  dup "CC" stringcmp not if pop CC @ if 0 else 1 then CC ! continue then
  dup "CID" stringcmp not if pop CID @ if 0 else 1 then CID ! continue then
  dup "VM" stringcmp not if pop VM @ if 0 else 1 then VM ! continue then
  pop "Invalid option." .tell repeat
  not if "Aborting." .tell exit then
  BASE CW @ if CW-COST + then
  CC @ if CC-COST + then
  CID @ if CID-COST + then
  VM @ if VM-COST + then
  "Buying this phone will cost " over intostr strcat " credits. Continue?" strcat .confirm
  not if "Aborting." .tell exit then
  me @ pennies over < if "You don't have that much money." .tell exit then
  me @ swap -1 * addpennies make-phone
;