home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #7 / amigamamagazinepolishissue1998.iso / rozrywka / rpg / amigamud / src / basics / util2.m < prev    next >
Text File  |  1997-08-07  |  30KB  |  1,178 lines
  1. /*
  2.  * Amiga MUD
  3.  *
  4.  * Copyright (c) 1997 by Chris Gray
  5.  */
  6.  
  7. /*
  8.  * util2.m - more utility stuff. These are a bunch of small modules.
  9.  */
  10.  
  11. private tp_util2 CreateTable()$
  12. use tp_util2
  13.  
  14. /***************************************************************************/
  15.  
  16. /*
  17.  * AddLight - introduce a source of light to the current room.
  18.  */
  19.  
  20. define t_util proc public AddLight()void:
  21.     if not CanSee(Here(), Me()) then
  22.     if DoRoomLightChecks(Here()) ~= fail then
  23.         ignore ShowRoomToMe(false);
  24.         ForEachAgent(Here(), ShowRoomToAgent);
  25.     fi;
  26.     fi;
  27. corp;
  28.  
  29. /*
  30.  * ActiveLightObject - an object is made to now emit light.
  31.  */
  32.  
  33. define t_util proc public ActiveLightObject()status:
  34.     thing it;
  35.     string name;
  36.  
  37.     it := It();
  38.     name := FormatName(it@p_oName);
  39.     if it@p_oLight then
  40.     Print("The " + name + " is already lit.\n");
  41.     fail
  42.     else
  43.     Print("You light the " + name + ".\n");
  44.     OPrint(Capitalize(CharacterNameG(Me())) +
  45.            AAn(" lights", name) + ".\n");
  46.     AddLight();
  47.     it@p_oLight := true;
  48.     /* want these to be succeed to allow proper use with VerbHere, etc. */
  49.     succeed
  50.     fi
  51. corp;
  52.  
  53. /*
  54.  * RemoveLight - remove a source of light from the current room.
  55.  */
  56.  
  57. define t_util proc public RemoveLight()void:
  58.     if not CanSee(Here(), Me()) then
  59.     UnShowRoomFromMe();
  60.     ForEachAgent(Here(), UnShowRoomFromAgent);
  61.     fi;
  62. corp;
  63.  
  64. /*
  65.  * ActiveUnLightObject - an object is made to no longer emit light.
  66.  */
  67.  
  68. define t_util proc public ActiveUnLightObject()status:
  69.     thing it;
  70.     string name;
  71.  
  72.     it := It();
  73.     name := FormatName(it@p_oName);
  74.     if not it@p_oLight then
  75.     Print("The " + name + " is not lit.\n");
  76.     fail
  77.     else
  78.     Print("You extinguish the " + name + ".\n");
  79.     it@p_oLight := false;
  80.     RemoveLight();
  81.     succeed
  82.     fi
  83. corp;
  84.  
  85. /*
  86.  * PassiveUnLightObject - an object is going out, independent of any player.
  87.  */
  88.  
  89. define t_util proc public PassiveUnLightObject(thing object)void:
  90.     thing who, where;
  91.     character ch;
  92.  
  93.     object@p_oLight := false;
  94.     who := object@p_oCarryer;
  95.     where := object@p_oWhere;
  96.     if who ~= nil then
  97.     SPrint(who, "Your " + FormatName(object@p_oName) + " has gone out.\n");
  98.     ch := Character(who@p_pName);
  99.     if ch ~= nil and CharacterThing(ch) = who then
  100.         where := CharacterLocation(ch);
  101.         if not LightAt(where) then
  102.         ForEachAgent(where, UnShowRoomFromAgent);
  103.         fi;
  104.     fi;
  105.     elif where ~= nil and not LightAt(where) then
  106.     ForEachAgent(where, UnShowRoomFromAgent);
  107.     fi;
  108. corp;
  109.  
  110.  
  111. /***************************************************************************/
  112.  
  113. /*
  114.  * GetDocument - get a long document - e.g. description, letter, etc.
  115.  *    Callable by player or machine - will do nothing for a machine.
  116.  *    There are some things to watch out for here. We want these routines
  117.  *    to be 'utility' so that they can be used properly by the build code.
  118.  */
  119.  
  120. define tp_util2 p_pOldDoc CreateStringProp()$
  121. define tp_util2 p_pEndAction CreateActionProp()$
  122. define tp_util2 p_pRawDocument CreateBoolProp()$
  123. define tp_util2 p_pTempString CreateStringProp()$
  124. define tp_util2 p_pSavePrompt CreateStringProp()$
  125. define tp_util2 p_pSaveAction CreateActionProp()$
  126.  
  127. /* 'docReset' is replaced later, when its references can be satisfied */
  128. define tp_util2 proc docReset()void: corp;
  129.  
  130. /* Append the given string to the document being built up. This was
  131.    originally set up for the line-by-line mode, but is also used for
  132.    its handling of the end-of-input condition (s = ".") */
  133. define tp_util2 proc utility appendToDocument(string line)void:
  134.     action endAction;
  135.     thing me, letter;
  136.     string s;
  137.     int len;
  138.  
  139.     me := Me();
  140.     s := me@p_pTempString;
  141.     len := Length(s);
  142.     if line = "." or line = "$" then
  143.     if len >= 4000 then
  144.         Print("*** Warning - input may have been truncated. ***\n");
  145.     fi;
  146.     endAction := me@p_pEndAction;
  147.     docReset();
  148.     /* call this so that, e.g. a normal person using the build code can
  149.        modify his own objects that are ts_readonly */
  150.     call(endAction, void)(s);
  151.     else
  152.     if len >= 4000 then
  153.         Print("*** Warning - input has been truncated. ***\n");
  154.     else
  155.         if me@p_pRawDocument then
  156.         me@p_pTempString := s + line + "\n";
  157.         else
  158.         if line ~= "" then
  159.             if s ~= "" then
  160.             s := s + " ";
  161.             fi;
  162.             me@p_pTempString := s + line;
  163.         fi;
  164.         fi;
  165.     fi;
  166.     fi;
  167. corp;
  168.  
  169. /* Called when the player exits MUD while still entering a document. */
  170. define tp_util2 proc utility docIdleAction()void:
  171.  
  172.     Me()@p_pTempString := Me()@p_pOldDoc;
  173.     appendToDocument(".");
  174. corp;
  175.  
  176. /* Called by 'activeAction' if the database was saved while the player
  177.    was entering a document, and the server was later restarted from that
  178.    saved database. */
  179. define tp_util2 proc docActiveAction()void:
  180.  
  181.     Print("\n* You were editing/entering something when the last backup "
  182.       "was made. That text change has been lost. *\n\n");
  183.     docIdleAction();
  184. corp;
  185.  
  186. /* We can now define the full body of this. Basically, just clean up after
  187.    doing a GetDocument. */
  188. replace docReset()void:
  189.     thing me;
  190.  
  191.     me := Me();
  192.     DelElement(me@p_pEnterActions, docActiveAction);
  193.     DelElement(me@p_pExitActions, docIdleAction);
  194.     if me@p_pSaveAction ~= nil then
  195.     /* not setup if using 'EditString' */
  196.     ignore SetCharacterInputAction(me@p_pSaveAction);
  197.     me -- p_pSaveAction;
  198.     ignore SetPrompt(me@p_pSavePrompt);
  199.     me -- p_pSavePrompt;
  200.     fi;
  201.     me -- p_pTempString;
  202.     me -- p_pOldDoc;
  203.     me -- p_pEndAction;
  204.     me -- p_pRawDocument;
  205. corp;
  206.  
  207. /* Called when the user finished editting the document, as part of
  208.    'EditString'. */
  209. define tp_util2 proc utility docEndAction(string s; bool ok)void:
  210.     thing me;
  211.  
  212.     me := Me();
  213.     if ok then
  214.     me@p_pTempString := s;
  215.     else
  216.     me@p_pTempString := me@p_pOldDoc;
  217.     fi;
  218.     appendToDocument(".");
  219. corp;
  220.  
  221. /* Set things up so that user input will be accumulated into a document
  222.    of some kind, which will then be passed to 'endAction'. Also handle
  223.    cases of input not completed when player exits, or when a backup is
  224.    made and later used. */
  225. define t_util proc utility GetDocument(string prompt, intro, oldDoc;
  226.     action endAction; bool isRaw)bool:
  227.     thing me;
  228.     action oldAction;
  229.  
  230.     me := Me();
  231.     if CanEdit() then
  232.     if Editing() then
  233.         Print("You are alreadying editing something!\n");
  234.         false
  235.     else
  236.         me@p_pTempString := "";
  237.         me@p_pEndAction := endAction;
  238.         me@p_pRawDocument := isRaw;
  239.         me@p_pOldDoc := oldDoc;
  240.         AddHead(me@p_pEnterActions, docActiveAction);
  241.         AddHead(me@p_pExitActions, docIdleAction);
  242.         EditString(oldDoc, docEndAction,
  243.                if isRaw then EDIT_RAW else EDIT_COOKED fi,
  244.                intro);
  245.         true
  246.     fi
  247.     else
  248.     oldAction := SetCharacterInputAction(appendToDocument);
  249.     if oldAction = nil then
  250.         /* must have been a machine! */
  251.         OPrint(Capitalize(CharacterNameS(me)) + " is confused.\n");
  252.         false
  253.     else
  254.         me@p_pTempString := "";
  255.         me@p_pEndAction := endAction;
  256.         me@p_pRawDocument := isRaw;
  257.         me@p_pOldDoc := oldDoc;
  258.         AddHead(me@p_pEnterActions, docActiveAction);
  259.         AddHead(me@p_pExitActions, docIdleAction);
  260.         me@p_pSavePrompt := SetPrompt("* " + prompt);
  261.         me@p_pSaveAction := oldAction;
  262.         Print(intro +
  263.         ". End with a line containing only a single period.\n");
  264.         true
  265.     fi
  266.     fi
  267. corp;
  268.  
  269. /*
  270.  * GetCheckedDescription - variant which lets a routine of the callers handle
  271.  *    each of the input lines. Note that since we need line-by-line
  272.  *    processing, there is no 'EditString' variation here.
  273.  */
  274.  
  275. define t_util proc utility GetCheckedEnd()void: corp;    /* replaced later */
  276.  
  277. define tp_util2 proc checkedActiveAction()void:
  278.  
  279.     Print("\n* You were entering something when the last backup "
  280.       "was made. Those changes have been lost. *\n\n");
  281.     GetCheckedEnd();
  282. corp;
  283.  
  284. /*
  285.  * GetCheckedEnd - this can be called by other code (e.g. the handler for
  286.  *    this checked description) to terminate this input mode, e.g.
  287.  *    because of erroneous user input.
  288.  */
  289.  
  290. replace GetCheckedEnd()void:
  291.     thing me;
  292.  
  293.     me := Me();
  294.     ignore SetCharacterInputAction(me@p_pSaveAction);
  295.     me -- p_pSaveAction;
  296.     ignore SetPrompt(me@p_pSavePrompt);
  297.     me -- p_pSavePrompt;
  298.     DelElement(me@p_pEnterActions, checkedActiveAction);
  299.     DelElement(me@p_pExitActions, GetCheckedEnd);
  300. corp;
  301.  
  302. define t_util proc utility GetCheckedDescription(string prompt;
  303.     action lineHandler)bool:
  304.     thing me;
  305.     action oldAction;
  306.  
  307.     me := Me();
  308.     oldAction := SetCharacterInputAction(lineHandler);
  309.     if oldAction = nil then
  310.     /* must have been a machine! */
  311.     OPrint(Capitalize(CharacterNameS(me)) + " is confused.\n");
  312.     false
  313.     else
  314.     me@p_pSaveAction := oldAction;
  315.     me@p_pSavePrompt := SetPrompt("* " + prompt);
  316.     AddHead(me@p_pEnterActions, checkedActiveAction);
  317.     AddHead(me@p_pExitActions, GetCheckedEnd);
  318.     true
  319.     fi
  320. corp;
  321.  
  322.  
  323. /***************************************************************************/
  324.  
  325. /*
  326.  * Paginate - paginate a string within the output screen size.
  327.  */
  328.  
  329. define tp_util2 p_pPaginateSetup CreateBoolProp()$
  330. define tp_util2 p_pPaginateString CreateStringProp()$
  331. define tp_util2 p_pPaginateLen CreateIntProp()$
  332. define tp_util2 p_pPaginatePrompt CreateStringProp()$
  333. define tp_util2 p_pPaginateHandler CreateActionProp()$
  334.  
  335. define tp_util2 proc paginateReset()void:
  336.     thing me;
  337.  
  338.     me := Me();
  339.     me -- p_pPaginateString;
  340.     me -- p_pPaginateLen;
  341.     if me@p_pPaginateSetup then
  342.     me -- p_pPaginateSetup;
  343.     DelElement(me@p_pEnterActions, paginateReset);
  344.     DelElement(me@p_pExitActions, paginateReset);
  345.     ignore SetPrompt(me@p_pPaginatePrompt);
  346.     me -- p_pPaginatePrompt;
  347.     ignore SetCharacterInputAction(me@p_pPaginateHandler);
  348.     me -- p_pPaginateHandler;
  349.     fi;
  350. corp;
  351.  
  352. define tp_util2 proc paginateParse(string line)void: corp;
  353.  
  354. define tp_util2 proc paginateShowPage()void:
  355.     thing me;
  356.     string s;
  357.     int len, i, line, height, width;
  358.  
  359.     me := Me();
  360.     s := me@p_pPaginateString;
  361.     len := me@p_pPaginateLen;
  362.     height := TextHeight(0) - 1;
  363.     width := TextWidth(0);
  364.     line := 1;
  365.     while len > 0 and line <= height do
  366.     i := Index(s, "\n");
  367.     if i = -1 then
  368.         Print(s);
  369.         Print("\n");
  370.         len := 0;
  371.     else
  372.         Print(SubString(s, 0, i + 1));
  373.         s := SubString(s, i + 1, len - i - 1);
  374.         len := len - i - 1;
  375.         if i <= width then
  376.         line := line + 1;
  377.         else
  378.         line := line + (i + width - 4) / (width - 9);
  379.         fi;
  380.     fi;
  381.     od;
  382.     if len = 0 then
  383.     paginateReset();
  384.     else
  385.     me@p_pPaginateString := s;
  386.     me@p_pPaginateLen := len;
  387.     if not me@p_pPaginateSetup then
  388.         me@p_pPaginateSetup := true;
  389.         me@p_pPaginatePrompt := SetPrompt("[M O R E] ");
  390.         me@p_pPaginateHandler := SetCharacterInputAction(paginateParse);
  391.         AddHead(me@p_pEnterActions, paginateReset);
  392.         AddHead(me@p_pExitActions, paginateReset);
  393.     fi;
  394.     fi;
  395. corp;
  396.  
  397. replace paginateParse(string line)void:
  398.  
  399.     if line = "" then
  400.     paginateShowPage();
  401.     elif line == "q" then
  402.     paginateReset();
  403.     else
  404.     Print("Options are:\n  q - quit\n  empty line - next page\n");
  405.     fi;
  406. corp;
  407.  
  408. define t_util proc Paginate(string s)void:
  409.     thing me;
  410.     int len;
  411.  
  412.     len := Length(s);
  413.     if SubString(s, len - 1, 1) ~= "\n" then
  414.     s := s + "\n";
  415.     fi;
  416.     me := Me();
  417.     if GType(nil) == "amiga" then
  418.     /* using full MUD client - no reason to paginate */
  419.     Print(s);
  420.     elif Character(me@p_pName) = nil then
  421.     OPrint(Capitalize(CharacterNameS(me)) + " is confused.\n");
  422.     else
  423.     me@p_pPaginateString := s;
  424.     me@p_pPaginateLen := len;
  425.     paginateShowPage();
  426.     fi;
  427. corp;
  428.  
  429.  
  430. /***************************************************************************/
  431.  
  432. /* code, etc. to assist/handle buying things in stores */
  433.  
  434. /* pre-create the lost and found room, so that we can set the 'home' of
  435.    things that people buy */
  436.  
  437. define tp_misc r_lostAndFound CreateThing(r_indoors)$
  438. SetupRoom(r_lostAndFound, "in the lost and found room",
  439.     "Things lost often end up here.")$
  440.  
  441. /*
  442.  * AddForSale - add an item for sale at the given location.
  443.  *    Note: we WANT this one 'utility' so that it does not execute with
  444.  *    SysAdmin privileges.
  445.  */
  446.  
  447. define t_util proc utility public AddForSale(thing room; string name, desc;
  448.     int price; action doBuy)thing:
  449.     thing model;
  450.     list thing lt;
  451.  
  452.     model := CreateThing(nil);
  453.     /* other players need to read it when shopping or buying */
  454.     SetThingStatus(model, ts_readonly);
  455.     model@p_oName := name;
  456.     if desc ~= "" then
  457.     model@p_oDesc := desc;
  458.     fi;
  459.     model@p_oPrice := price;
  460.     if doBuy ~= nil then
  461.     model@p_oBuyChecker := doBuy;
  462.     fi;
  463.     model@p_oHome := r_lostAndFound;
  464.     lt := room@p_rBuyList;
  465.     if lt = nil then
  466.     lt := CreateThingList();
  467.     room@p_rBuyList := lt;
  468.     fi;
  469.     if FindElement(lt, model) = -1 then
  470.     AddTail(lt, model);
  471.     fi;
  472.     model
  473. corp;
  474.  
  475. /*
  476.  * AddObjectForSale - make an already defined object be for sale.
  477.  */
  478.  
  479. define t_util proc utility public AddObjectForSale(thing room, model;
  480.     int price; action doBuy)void:
  481.     list thing lt;
  482.  
  483.     model@p_oPrice := price;
  484.     if doBuy ~= nil then
  485.     model@p_oBuyChecker := doBuy;
  486.     fi;
  487.     lt := room@p_rBuyList;
  488.     if lt = nil then
  489.     lt := CreateThingList();
  490.     room@p_rBuyList := lt;
  491.     fi;
  492.     if FindElement(lt, model) = -1 then
  493.     AddTail(lt, model);
  494.     fi;
  495. corp;
  496.  
  497. /*
  498.  * SubObjectForSale - make an object no longer for sale.
  499.  */
  500.  
  501. define t_util proc utility public SubObjectForSale(thing room, model)bool:
  502.     list thing lt;
  503.  
  504.     lt := room@p_rBuyList;
  505.     if lt ~= nil then
  506.     if FindElement(lt, model) ~= -1 then
  507.         DelElement(lt, model);
  508.         model -- p_oPrice;
  509.         model -- p_oBuyChecker;
  510.         true
  511.     else
  512.         false
  513.     fi
  514.     else
  515.     false
  516.     fi
  517. corp;
  518.  
  519. /*
  520.  * ShowForSale - show the things for sale at a player's current location.
  521.  */
  522.  
  523. define t_util proc public ShowForSale()void:
  524.     list thing lt;
  525.     int count, n, price;
  526.     thing model;
  527.  
  528.     lt := Here()@p_rBuyList;
  529.     if lt = nil then
  530.     Print("There is nothing for sale here.\n");
  531.     else
  532.     if not Me()@p_pHidden then
  533.         OPrint(Capitalize(CharacterNameG(Me())) +
  534.            " examines the merchandise.\n");
  535.     fi;
  536.     Print("For sale here:\n");
  537.     count := Count(lt);
  538.     n := 0;
  539.     while n ~= count do
  540.         model := lt[n];
  541.         Print("  " + FormatName(model@p_oName) + " - ");
  542.         price := model@p_oPrice;
  543.         if price = 0 then
  544.         Print("free");
  545.         elif price = 1 then
  546.         Print("1 bluto");
  547.         else
  548.         IPrint(price);
  549.         Print(" blutos");
  550.         fi;
  551.         Print("\n");
  552.         n := n + 1;
  553.     od;
  554.     fi;
  555. corp;
  556.  
  557. /*
  558.  * StoreBuy - let the user buy something at a store. This is used as the
  559.  *    'buy' action at the store location.
  560.  *    Note: this is NOT a utility proc, since we want the object to
  561.  *          be owned by SysAdmin, and since we use OPrint.
  562.  *    Note: intended only to be called by the player doing the buy.
  563.  *          Looks like it would work for machines too, however.
  564.  */
  565.  
  566. define t_util proc public StoreBuy(string what)bool:
  567.     thing here, model, me, th;
  568.     string name;
  569.     int price, money;
  570.     action buyAction;
  571.     status st;
  572.  
  573.     here := Here();
  574.     if here@p_rBuyList = nil then
  575.     Print("There is nothing for sale here.\n");
  576.     false
  577.     else
  578.     name := FormatName(what);
  579.     st := FindName(here@p_rBuyList, p_oName, what);
  580.     if st = fail then
  581.         Print(AAn("You cannot buy", name) + " here.\n");
  582.         false
  583.     elif st = continue then
  584.         Print(Capitalize(name) + " is ambiguous here.\n");
  585.         false
  586.     else
  587.         model := FindResult();
  588.         me := Me();
  589.         price := model@p_oPrice;
  590.         money := me@p_pMoney;
  591.         name := FormatName(model@p_oName);
  592.         if price > money and not me@p_pPrivileged then
  593.         Print(AAn("You cannot afford", name) + ".\n");
  594.         false
  595.         else
  596.         /* Skip past one level of inheritance if that is there. This
  597.            allows using the same model, with different price, in
  598.            different stores. */
  599.         th := Parent(model);
  600.         if th ~= nil and th@p_oPrice ~= 0 then
  601.             th := CreateThing(th);
  602.         else
  603.             th := CreateThing(model);
  604.         fi;
  605.         /* We want the thing public so that anyone can do things to
  606.            it. ts_readonly would work not bad, but that prevents
  607.            a builder from modifying it. We want it owned by SysAdmin
  608.            so that all the code that is setuid SysAdmin has no
  609.            trouble with it. We have to do the SetThingStatus BEFORE
  610.            we give it away, else we will not have access to do so. */
  611.         SetThingStatus(th, ts_public);
  612.         GiveThing(th, SysAdmin);
  613.         if model@p_oContents ~= nil then
  614.             th@p_oContents := CreateThingList();
  615.         fi;
  616.         th@p_oCreator := me;
  617.         buyAction := model@p_oBuyChecker;
  618.         st := continue;
  619.         if buyAction ~= nil then
  620.             SetIt(th);
  621.             st := call(buyAction, status)();
  622.         fi;
  623.         if st = continue and not CarryItem(th) then
  624.             st := fail;
  625.         fi;
  626.         if st ~= fail and not me@p_pPrivileged then
  627.             me@p_pMoney := money - price;
  628.         fi;
  629.         if st = continue then
  630.             Print(AAn("You have just bought", name) + ".\n");
  631.             if not me@p_pHidden then
  632.             OPrint(Capitalize(CharacterNameG(me)) +
  633.                    " makes a purchase.\n");
  634.             fi;
  635.         else
  636.             /* This call will destroy the object. */
  637.             ClearThing(th);
  638.         fi;
  639.         true
  640.         fi
  641.     fi
  642.     fi
  643. corp;
  644.  
  645. /*
  646.  * MakeStore - make a room a store.
  647.  */
  648.  
  649. define t_util proc utility public MakeStore(thing room)void:
  650.  
  651.     room@p_rBuyAction := StoreBuy;
  652. corp;
  653.  
  654. /*
  655.  * IsStore - ask if room is a store.
  656.  */
  657.  
  658. define t_util proc utility public IsStore(thing room)bool:
  659.  
  660.     room@p_rBuyAction = StoreBuy
  661. corp;
  662.  
  663. /*
  664.  * UnmakeStore - make a room no longer a store.
  665.  */
  666.  
  667. define t_util proc utility public UnmakeStore(thing room)void:
  668.  
  669.     room -- p_rBuyList;
  670.     room -- p_rBuyAction;
  671. corp;
  672.  
  673.  
  674. /***************************************************************************/
  675.  
  676. /* Some stuff to implement banks. Note that these properties are private,
  677.    so no-one else can change bank accounts. Note also that the routines are
  678.    NOT utility routines, since we want the things created to represent the
  679.    accounts to not be owned by the player. */
  680.  
  681. define tp_util2 p_rBankAccounts CreateThingListProp()$    /* bank account list */
  682. define tp_util2 p_oAccountValue CreateIntProp()$     /* value in account */
  683. define tp_util2 p_oAccountOwner CreateThingProp()$     /* who owns account */
  684.  
  685. define tp_util2 proc bankDeposit()void:
  686.     list thing lt;
  687.     int money, amount, count, i;
  688.     thing me, account;
  689.     string st, name;
  690.  
  691.     st := GetWord();
  692.     if st = "" then
  693.     Print("You must say how many blutos you wish to deposit.\n");
  694.     else
  695.     amount := StringToInt(st);
  696.     if amount < 0 then
  697.         Print("Invalid amount - must be a number.\n");
  698.     else
  699.         lt := Here()@p_rBankAccounts;
  700.         if lt = nil then
  701.         Print("*** no account list found ***\n");
  702.         else
  703.         me := Me();
  704.         money := me@p_pMoney;
  705.         if amount > money then
  706.             Print("You do not have that much money on you.\n");
  707.         else
  708.             count := Count(lt);
  709.             i := 0;
  710.             while
  711.             if i = count then
  712.                 false
  713.             else
  714.                 account := lt[i];
  715.                 account@p_oAccountOwner ~= me
  716.             fi
  717.             do
  718.             i := i + 1;
  719.             od;
  720.             name := CharacterNameG(me);
  721.             if i = count then
  722.             Print("Setting up a new account for \"" + name +
  723.                 "\". ");
  724.             account := CreateThing(nil);
  725.             account@p_oAccountOwner := me;
  726.             AddTail(lt, account);
  727.             i := 0;
  728.             else
  729.             i := account@p_oAccountValue;
  730.             fi;
  731.             me@p_pMoney := money - amount;
  732.             amount := amount + i;
  733.             account@p_oAccountValue := amount;
  734.             Print("Thank you for your deposit. Your account now has "
  735.             "a balance of ");
  736.             if amount = 1 then
  737.             Print("one bluto.\n");
  738.             else
  739.             IPrint(amount);
  740.             Print(" blutos.\n");
  741.             fi;
  742.             if not me@p_pHidden and CanSee(Here(), me) then
  743.             OPrint(Capitalize(name) + " makes a transaction.\n");
  744.             fi;
  745.         fi;
  746.         fi;
  747.     fi;
  748.     fi;
  749. corp;
  750.  
  751. define tp_util2 proc bankWithdraw()void:
  752.     list thing lt;
  753.     int amount, count, i;
  754.     thing me, account;
  755.     string st;
  756.  
  757.     st := GetWord();
  758.     if st = "" then
  759.     Print("You must say how many blutos you wish to withdraw.\n");
  760.     else
  761.     amount := StringToInt(st);
  762.     if amount < 0 then
  763.         Print("Invalid amount - must be a number.\n");
  764.     else
  765.         lt := Here()@p_rBankAccounts;
  766.         if lt = nil then
  767.         Print("*** no account list found ***\n");
  768.         else
  769.         me := Me();
  770.         count := Count(lt);
  771.         i := 0;
  772.         while
  773.             if i = count then
  774.             false
  775.             else
  776.             account := lt[i];
  777.             account@p_oAccountOwner ~= me
  778.             fi
  779.         do
  780.             i := i + 1;
  781.         od;
  782.         if i = count then
  783.             Print("I'm sorry, this bank has no account for \"" +
  784.             me@p_pName + "\".\n");
  785.         else
  786.             i := account@p_oAccountValue;
  787.             if amount > i then
  788.             Print("I'm sorry, you do not have that much in "
  789.                 "your account.\n");
  790.             else
  791.             me@p_pMoney := me@p_pMoney + amount;
  792.             amount := i - amount;
  793.             account@p_oAccountValue := amount;
  794.             if amount = 0 then
  795.                 Print("Withdrawal made. Your account is now "
  796.                   "empty and has been closed.\n");
  797.                 DelElement(lt, account);
  798.             else
  799.                 Print("Withdrawal made. Your account now has a "
  800.                 "balance of ");
  801.                 if amount = 1 then
  802.                 Print("one bluto.\n");
  803.                 else
  804.                 IPrint(amount);
  805.                 Print(" blutos.\n");
  806.                 fi;
  807.             fi;
  808.             fi;
  809.             if not me@p_pHidden and CanSee(Here(), me) then
  810.             OPrint(Capitalize(CharacterNameG(me)) +
  811.                 " makes a transaction.\n");
  812.             fi;
  813.         fi;
  814.         fi;
  815.     fi;
  816.     fi;
  817. corp;
  818.  
  819. define tp_util2 proc bankBalance()void:
  820.     list thing lt;
  821.     int amount, count, i;
  822.     thing me, account;
  823.  
  824.     lt := Here()@p_rBankAccounts;
  825.     if lt = nil then
  826.     Print("*** no account list found ***\n");
  827.     else
  828.     me := Me();
  829.     count := Count(lt);
  830.     i := 0;
  831.     while
  832.         if i = count then
  833.         false
  834.         else
  835.         account := lt[i];
  836.         account@p_oAccountOwner ~= me
  837.         fi
  838.     do
  839.         i := i + 1;
  840.     od;
  841.     if i = count then
  842.         Print("I'm sorry, this bank has no account for \"" + me@p_pName +
  843.         "\".\n");
  844.     else
  845.         amount := account@p_oAccountValue;
  846.         Print("Your account has a balance of ");
  847.         if amount = 1 then
  848.         Print("one bluto.\n");
  849.         else
  850.         IPrint(amount);
  851.         Print(" blutos.\n");
  852.         fi;
  853.         if not me@p_pHidden and CanSee(Here(), me) then
  854.         OPrint(Capitalize(CharacterNameG(me)) +
  855.             " makes a transaction.\n");
  856.         fi;
  857.     fi;
  858.     fi;
  859. corp;
  860.  
  861. /*
  862.  * make this one utility, so people can only do it to their own rooms.
  863.  */
  864.  
  865. define t_util proc utility public MakeBank(thing room)void:
  866.  
  867.     room@p_rBankAccounts := CreateThingList();
  868.     AddSpecialCommand(room, "deposit", bankDeposit);
  869.     AddSpecialCommand(room, "withdraw", bankWithdraw);
  870.     AddSpecialCommand(room, "balance", bankBalance);
  871. corp;
  872.  
  873. define t_util proc utility public IsBank(thing room)bool:
  874.  
  875.     room@p_rBankAccounts ~= nil
  876. corp;
  877.  
  878. define t_util proc utility public UnmakeBank(thing room)status:
  879.     list thing accounts;
  880.  
  881.     accounts := room@p_rBankAccounts;
  882.     if accounts = nil then
  883.     continue
  884.     elif Count(accounts) ~= 0 then
  885.     fail
  886.     else
  887.     room -- p_rBankAccounts;
  888.     ignore RemoveSpecialCommand(room, "deposit", bankDeposit);
  889.     ignore RemoveSpecialCommand(room, "withdraw", bankWithdraw);
  890.     ignore RemoveSpecialCommand(room, "balance", bankBalance);
  891.     succeed
  892.     fi
  893. corp;
  894.  
  895.  
  896. /***************************************************************************/
  897.  
  898. /* Some general routines for setting up verbs that do things to things.
  899.    'VerbCarry' requires that the player be carrying the object in order to
  900.    do whatever to it. 'VerbHere' allows it to be either carried or in the
  901.    room the player is in. It would also be possible to look at things that
  902.    are carried by other players/machines, but I chose not to. Note that
  903.    I check the player, then the room, then the specific object.
  904.    Return 'false' if we were not able to do the action on the requested
  905.    thing, because the thing is not available, or the action fails.
  906. */
  907.  
  908. /* A problem has cropped up with the drinking monsters. The code below
  909.    looks for the same properties on the player, the room and the object.
  910.    So, if you try to drink the drinking troll, it will execute the drink
  911.    action on the troll and say that you shouldn't do that. Unfortunately,
  912.    that action is also done when the troll's special action gets the troll
  913.    to 'drink water'. Proper solution is two more properties, sigh. This
  914.    has been done for the indirect case with 'actorCheck'. Thus we do not
  915.    allow the case of attaching a string to the player which is the entire
  916.    result of trying to do that action. */
  917.  
  918. define t_util proc public commonVerbTail(property string direct;
  919.     property action indirect, actorCheck; thing object;
  920.     string failHeader, verbName, name)bool:
  921.     thing me, here;
  922.     action a;
  923.     string directString;
  924.     status st;
  925.     bool doneOne;
  926.  
  927.     /* Note: the status values returned by the handler routines are
  928.        interpreted as follows:
  929.       continue - nothing special - keep looking for something special
  930.       succeed - successfully handled this case
  931.       fail - this case is handled, but cease cases and parsing
  932.        The presence of a 'direct' string property is taken to be the same
  933.        as a routine which prints that string and returns 'succeed', with
  934.        the exception that something on a given object will override a
  935.        direct string on a location.
  936.     */
  937.  
  938.     me := Me();
  939.     here := Here();
  940.     doneOne := false;
  941.     if actorCheck ~= nil then
  942.     a := me@actorCheck;
  943.     if a ~= nil then
  944.         SetIt(object);
  945.         st := call(a, status)();
  946.         if st ~= continue then
  947.         doneOne := true;
  948.         fi;
  949.     fi;
  950.     fi;
  951.     if not doneOne and indirect ~= nil then
  952.     a := here@indirect;
  953.     if a ~= nil then
  954.         SetIt(object);
  955.         st := call(a, status)();
  956.         if st ~= continue then
  957.         doneOne := true;
  958.         fi;
  959.     fi;
  960.     fi;
  961.     if not doneOne and direct ~= nil then
  962.     directString := here@direct;
  963.     if directString ~= "" and
  964.         (object = nil or object@direct = "" and object@indirect = nil)
  965.     then
  966.         doneOne := true;
  967.         Print(directString + "\n");
  968.         st := continue;
  969.     fi;
  970.     fi;
  971.     if not doneOne and object ~= nil and indirect ~= nil then
  972.     a := object@indirect;
  973.     if a ~= nil then
  974.         SetIt(object);
  975.         st := call(a, status)();
  976.         if st ~= continue then
  977.         doneOne := true;
  978.         fi;
  979.     fi;
  980.     fi;
  981.     if not doneOne and object ~= nil and direct ~= nil then
  982.     directString := object@direct;
  983.     if directString ~= "" then
  984.         doneOne := true;
  985.         Print(directString + "\n");
  986.         st := continue;
  987.     fi;
  988.     fi;
  989.     if doneOne then
  990.     st ~= fail
  991.     elif object = nil then
  992.     Print("You must specify what you want to " + verbName + ".\n");
  993.     false
  994.     else
  995.     Print(failHeader + " the " + name + ".\n");
  996.     true
  997.     fi
  998. corp;
  999.  
  1000. define t_util proc public VerbCarry(string verbName; property string direct;
  1001.     property action indirect, actorCheck; string failHeader, what)bool:
  1002.     thing object;
  1003.     string name;
  1004.     status st;
  1005.     bool done, ok;
  1006.     list thing lt;
  1007.     int i, count, oldCount;
  1008.  
  1009.     done := false;
  1010.     if what = "" then
  1011.     object := nil;
  1012.     elif what == "all" then
  1013.     lt := Me()@p_pCarrying;
  1014.     count := Count(lt);
  1015.     i := 0;
  1016.     ok := true;
  1017.     while ok and i ~= count do
  1018.         object := lt[i];
  1019.         if not object@p_oInvisible then
  1020.         done := true;
  1021.         if commonVerbTail(direct, indirect, actorCheck,
  1022.             object, failHeader, verbName, FormatName(object@p_oName))
  1023.         then
  1024.             oldCount := count;
  1025.             count := Count(lt);
  1026.             i := i - (oldCount - count) + 1;
  1027.         else
  1028.             ok := false;
  1029.         fi;
  1030.         else
  1031.         i := i + 1;
  1032.         fi;
  1033.     od;
  1034.     if not done then
  1035.         done := true;
  1036.         Print("You are not carrying anything obvious to " + verbName +
  1037.           ".\n");
  1038.         ok := false;
  1039.     fi;
  1040.     else
  1041.     name := FormatName(what);
  1042.     st := FindName(Me()@p_pCarrying, p_oName, what);
  1043.     if st = fail then
  1044.         Print(AAn("You are not carrying", name) + ".\n");
  1045.         ok := false;
  1046.         done := true;
  1047.     elif st = continue then
  1048.         Print(Capitalize(name) + " is ambiguous here.\n");
  1049.         ok := false;
  1050.         done := true;
  1051.     else
  1052.         object := FindResult();
  1053.         name := FormatName(object@p_oName);
  1054.     fi;
  1055.     fi;
  1056.     if done then
  1057.     ok
  1058.     else
  1059.     commonVerbTail(direct, indirect, actorCheck,
  1060.                object, failHeader, verbName, name)
  1061.     fi
  1062. corp;
  1063.  
  1064. define t_util proc public VerbHere(string verbName; property string direct;
  1065.     property action indirect, actorCheck; string failHeader, what)bool:
  1066.     thing here, object;
  1067.     list thing lt;
  1068.     int count, i, oldCount;
  1069.     string ambig, name;
  1070.     status st;
  1071.     bool done, ok;
  1072.  
  1073.     here := Here();
  1074.     done := false;
  1075.     object := nil;
  1076.     if what == "all" then
  1077.     lt := Me()@p_pCarrying;
  1078.     count := Count(lt);
  1079.     i := 0;
  1080.     ok := true;
  1081.     while ok and i ~= count do
  1082.         object := lt[i];
  1083.         if not object@p_oInvisible then
  1084.         done := true;
  1085.         if commonVerbTail(direct, indirect, actorCheck, object,
  1086.             failHeader, verbName, FormatName(object@p_oName))
  1087.         then
  1088.             oldCount := count;
  1089.             count := Count(lt);
  1090.             i := i - (oldCount - count) + 1;
  1091.         else
  1092.             ok := false;
  1093.         fi;
  1094.         else
  1095.         i := i + 1;
  1096.         fi;
  1097.     od;
  1098.     lt := here@p_rContents;
  1099.     count := Count(lt);
  1100.     i := 0;
  1101.     while ok and i ~= count do
  1102.         object := lt[i];
  1103.         if not object@p_oInvisible then
  1104.         done := true;
  1105.         if commonVerbTail(direct, indirect, actorCheck,
  1106.             object, failHeader, verbName, FormatName(object@p_oName))
  1107.         then
  1108.             oldCount := count;
  1109.             count := Count(lt);
  1110.             i := i - (oldCount - count) + 1;
  1111.         else
  1112.             ok := false;
  1113.         fi;
  1114.         else
  1115.         i := i + 1;
  1116.         fi;
  1117.     od;
  1118.     if not done then
  1119.         done := true;
  1120.         Print("There is nothing obvious here to " + verbName + ".\n");
  1121.         ok := false;
  1122.     fi;
  1123.     elif what ~= "" then
  1124.     name := FormatName(what);
  1125.     ambig := " is ambiguous here.\n";
  1126.     st := FindName(Me()@p_pCarrying, p_oName, what);
  1127.     if st = fail then
  1128.         st := FindName(here@p_rContents, p_oName, what);
  1129.         if st = fail then
  1130.         object := FindAgent(what);
  1131.         if object = nil then
  1132.             if here@p_rBuyList ~= nil and
  1133.             FindName(here@p_rBuyList, p_oName, what) ~= fail
  1134.             then
  1135.             done := true;
  1136.             ok := false;
  1137.             Print("You should buy the " + name +
  1138.                 " before you try to " + verbName + " it.\n");
  1139.             elif MatchName(here@p_rScenery, what) ~= -1 then
  1140.             done := true;
  1141.             ok := false;
  1142.             Print(failHeader + " the " + name + ".\n");
  1143.             fi;
  1144.         fi;
  1145.         elif st = continue then
  1146.         Print(Capitalize(name));
  1147.         Print(ambig);
  1148.         ok := false;
  1149.         done := true;
  1150.         else
  1151.         object := FindResult();
  1152.         name := FormatName(object@p_oName);
  1153.         fi;
  1154.     elif st = continue then
  1155.         Print(Capitalize(name));
  1156.         Print(ambig);
  1157.         ok := false;
  1158.         done := true;
  1159.     else
  1160.         object := FindResult();
  1161.         name := FormatName(object@p_oName);
  1162.     fi;
  1163.     if object = nil and not done then
  1164.         Print(IsAre("There", "no", name, "here.\n"));
  1165.         done := true;
  1166.         ok := false;
  1167.     fi;
  1168.     fi;
  1169.     if done then
  1170.     ok
  1171.     else
  1172.     commonVerbTail(direct, indirect, actorCheck,
  1173.                object, failHeader, verbName, name)
  1174.     fi
  1175. corp;
  1176.  
  1177. unuse tp_util2
  1178.