--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/items.pas	Sun Dec 08 19:39:15 2013 +0100
@@ -0,0 +1,410 @@
+{ Items handling routines. }
+
+UNIT Items;
+
+INTERFACE
+
+USES Global;
+
+FUNCTION  GetItemWeight(what: ItemSlot): INTEGER;       { Counts the weight of an item. }
+FUNCTION  IsInThere(what,where: ItemSlot):BOOLEAN;      { Checks if item WHAT is somwhere inside item WHERE. }
+PROCEDURE GetItemLooks(VAR a:BYTE;VAR c:CHAR;what:ItemSlot);    { Sets A and C to fit items looks. }
+FUNCTION  GetItemDesc(what: ItemSlot): STRING;                  { Returns item description. }
+FUNCTION  ItemName(what: ItemSlot): STRING;                     { Returns the name of an item. }
+PROCEDURE ShowItem(what: ItemSlot);             { Tells what kind of item is there. }
+
+FUNCTION  GenerateItem(id:BYTE):pItem;          { Creates a new item from definitions. }
+PROCEDURE DestroyItem(what: ItemSlot);          { Destroys an item. }
+PROCEDURE MoveInto(what,where: ItemSlot);       { Tries to put item from WHAT into container in slot WHERE. }
+PROCEDURE MoveItem(what,where: ItemSlot);       { Tries to put item from WHAT into slot WHERE. }
+PROCEDURE DropItem(what,where: ItemSlot);       { Drops item from WHAT into slot WHERE, creating a pile if needed. }
+PROCEDURE PutToPack(what: ItemSlot);            { Tries to put an item into pack. }
+
+FUNCTION  ListItems(where: ItemSlot):ItemSlot;  { Lists all items in the container and picks one. }
+PROCEDURE SelectItem(what: ItemSlot);           { Shows item description,asks for action and performs it. }
+PROCEDURE CheckPile(where: ItemSlot);           { Destroys a pile if itsn't needed anymore. }
+PROCEDURE ExamInv;                              { Displays equipment. }
+
+IMPLEMENTATION
+
+USES Console;
+
+TYPE    pStack=^StackRec;
+        StackRec=RECORD
+                slt: pItem;
+                next: pStack;
+        END;
+
+VAR     stack: pStack;
+
+{ ------------------------------------------- Item information ---------- }
+
+PROCEDURE StackPush(what: pItem);       { Pushes an item entry on stack. }
+VAR     tmp: pStack;
+BEGIN
+        New(tmp);
+        tmp^.slt:=what;
+        tmp^.next:=stack;
+        stack:=tmp;
+END;
+
+PROCEDURE StackPop(VAR what: pItem);    { Pops an item entry from stack. }
+VAR     tmp: pStack;
+BEGIN
+        IF stack=NIL THEN Exit;
+        what:=stack^.slt;
+        tmp:=stack;
+        stack:=stack^.next;
+        Dispose(tmp);
+END;
+
+
+FUNCTION GetItemWeight(what: ItemSlot): INTEGER;        { Counts the weight of an item. }
+VAR     weight: INTEGER;
+        p: pItem;
+BEGIN
+        stack:=NIL;                                     { The stack is empty. }
+        weight:=what^^.def^.wgt*what^^.qnt;             { Base weight. }
+        StackPush(what^^.con);                          { Now we search all the tree. }
+        REPEAT
+                StackPop(p);
+                WHILE p<>NIL DO BEGIN
+                        Inc(weight,p^.def^.wgt*p^.qnt);
+                        IF p^.con<>NIL THEN StackPush(p^.con);
+                        p:=p^.next;
+                END;
+        UNTIL p=NIL;
+        GetItemWeight:=weight;
+END;
+
+FUNCTION IsInThere(what,where: ItemSlot):BOOLEAN;       { Checks if item WHAT is somwhere inside item WHERE. }
+VAR     p: pItem;
+BEGIN
+        IsInThere:=FALSE;
+        stack:=NIL;
+        StackPush(where^);
+        REPEAT
+                StackPop(p);
+                WHILE p<>NIL DO BEGIN
+                        IF p=what^ THEN IsInThere:=TRUE;
+                        IF p^.con<>NIL THEN StackPush(p^.con);
+                        p:=p^.next;
+                END;
+        UNTIL p=NIL;
+END;
+
+PROCEDURE GetItemLooks(VAR a:BYTE;VAR c:CHAR;what:ItemSlot);    { Sets A and C to fit items looks. }
+VAR     tmp: ItemDef;
+BEGIN
+        IF (SLOT_KNOWN IN what^^.flg) THEN tmp:=what^^.def
+                                      ELSE tmp:=FindItem(what^^.def^.unk);
+        c:=tmp^.chr;
+        a:=tmp^.atr;
+END;
+
+FUNCTION GetItemDesc(what: ItemSlot): STRING;                   { Returns item description. }
+BEGIN
+        IF (SLOT_KNOWN IN what^^.flg)OR(what^^.def^.unk=0) THEN { If item is known -- we return its description. }
+                GetItemDesc:=what^^.def^.dsc
+        ELSE    GetItemDesc:=FindItem(what^^.def^.unk)^.dsc;    { But if not, we return description of item type. }
+END;
+
+FUNCTION ItemName(what: ItemSlot): STRING;                      { Returns the name of an item. }
+VAR     s: STRING;
+BEGIN
+        ItemName:='';
+        IF (what^=NIL) THEN BEGIN                               { If there is nothing, we return 'nothing'. }
+                ItemName:=FindItem(0)^.nam;
+                Exit;
+        END;
+
+        IF (SLOT_KNOWN IN what^^.flg) THEN s:=what^^.def^.nam   { If item is known, we return its real name. }
+                                      ELSE s:=FindItem(what^^.def^.unk)^.nam;
+
+                              { When there are many items of the same kind, we tell how many. }
+        IF (ITEM_MULTIPLE IN what^^.def^.flg) AND (what^^.qnt>1) THEN
+                s:=Replace(Plural(s),'@a',Num(what^^.qnt))
+        ELSE BEGIN                                              { Elsewhen we add 'a' or 'an'. }
+                s:=Replace(s,'@a a','an a');
+                s:=Replace(s,'@a e','an e');
+                s:=Replace(s,'@a i','an i');
+                s:=Replace(s,'@a o','an o');
+                s:=Replace(s,'@a u','an u');
+                s:=Replace(s,'@a ' ,'a ');
+                s:=Replace(s,'@a'  ,'a');
+                s:=Replace(s,'@s','');
+        END;
+        ItemName:=s;
+END;
+
+PROCEDURE ShowItem(what: ItemSlot);             { Tells what kind of item is there. }
+BEGIN
+        IF what^=NIL THEN Exit;                 { If there is nothing -- we won't bother. }
+        Msg(Replace(msgs[13],'@v',ItemName(what)));
+END;
+
+{ ------------------------------------------- Item moving and creation -- }
+
+FUNCTION GenerateItem(id:BYTE):pItem;           { Creates a new item from definitions. }
+VAR     item: ItemDef;
+        tmp: pItem;
+BEGIN
+        New(tmp);                               { We make room for item. }
+        item:=FindItem(id);                     { We find according definitions. }
+        tmp^.def:=item;                         { We fill in all data necessary. }
+        tmp^.qnt:=item^.qnt+Random(item^.qnt);
+        tmp^.flg:=[];
+        tmp^.con:=NIL;
+        tmp^.next:=NIL;
+        IF (ITEM_KNOWN IN item^.flg) THEN tmp^.flg:=tmp^.flg+[SLOT_KNOWN];
+        GenerateItem:=tmp;                      { And we have brand new item. }
+END;
+
+PROCEDURE DestroyItem(what: ItemSlot);          { Destroys an item. }
+VAR     tmp: pItem;
+BEGIN
+        tmp:=what^;                             { We take item from any container it may be in. }
+        what^:=tmp^.next;                       { We update this container's list of items. }
+        Dispose(tmp);                           { And we relase memory. }
+END;
+
+PROCEDURE MoveInto(what,where: ItemSlot);       { Tries to put item from WHAT into container in slot WHERE. }
+VAR     tmp: pItem;
+BEGIN
+        IF IsInThere(where,what) THEN Exit;     { We dont want to put something into itself! }
+        tmp:=what^;                             { Now, we take item from any container it may be in. }
+        what^:=tmp^.next;                       { We update this container's list of items. }
+        tmp^.next:=where^^.con;                 { We put all items from WHERE behind our item. }
+        where^^.con:=tmp;                       { We put our item into item in slot WHERE. }
+END;
+
+PROCEDURE MoveItem(what,where: ItemSlot);       { Tries to put item from WHAT into slot WHERE. }
+VAR     tmp: pItem;
+BEGIN
+        IF where^<>NIL THEN Exit;               { Is there something already? }
+        tmp:=what^;                             { Now, we take item from any container it may be in. }
+        what^:=tmp^.next;                       { We update this container's list of items. }
+        tmp^.next:=NIL;                         { Our item is the only one here. }
+        where^:=tmp;                            { We put our item into slot WHERE. }
+END;
+
+PROCEDURE DropItem(what,where: ItemSlot);       { Drops item from WHAT into slot WHERE, creating a pile if needed. }
+VAR     tmp: ItemSlot;
+        p: pItem;
+BEGIN
+        IF where^=NIL THEN BEGIN                { If WHERE is empty, we simply put our item there. }
+                MoveItem(what,where);
+		Exit;
+        END;
+	
+        IF where^^.def^.id=PILEITEM THEN BEGIN  { If there is a pile already, we just add our item to the pile. }
+                MoveInto(what,where)
+        END ELSE BEGIN                          { If there is an item already... }
+		New(tmp);                       { We need 'third hand'. }
+		tmp^:=NIL;
+		MoveItem(where,tmp);            { We pick the item from the floor. }
+                p:=GenerateItem(PILEITEM);      { Then we create a pile... }
+                MoveItem(@p,where);             { And put it on the floor. }
+		MoveInto(tmp,where);		{ Then we put both items into the pile. }
+		MoveInto(what,where);
+                Dispose(tmp);                   { W don't need third hand anymore. }
+        END;
+END;
+
+PROCEDURE PutToPack(what: ItemSlot);            { Tries to put an item into pack. }
+BEGIN
+        IF (pc.inv[INV_PACK]=NIL) OR            { Have we any pack to put into? }
+           NOT (ITEM_EMPTY IN pc.inv[INV_PACK]^.def^.flg) THEN Exit;
+                                                { We inform the player about what we are doing. }
+        Msg(Replace(Replace(msgs[15],'@1',ItemName(@(pc.inv[INV_PACK]))),'@v',ItemName(what)));
+        MoveInto(what,@(pc.inv[INV_PACK]));     { And we do it. }
+END;
+
+{ ------------------------------------------- Menus and handling -------- }
+
+PROCEDURE CheckCmd(VAR a:INTEGER;c:CHAR;b:BYTE);{ Checks if key C belong to command B }
+BEGIN                                           { and sets A to this command if so. }
+        IF c=cmd[b] THEN a:=b;
+END;
+
+FUNCTION ListItems(where: ItemSlot):ItemSlot;   { Lists all items in the container and picks one. }
+VAR     p,page: ItemSlot;
+        c,k: CHAR;
+BEGIN
+        ListItems:=NIL;
+        ClrMsg;
+        p:=@(where^^.con);
+        REPEAT                                  { Tell what item we are looking into. }
+                Msg(Replace(msgs[29],'@v',ItemName(where)));
+
+                page:=p;                        { Mark the top of actual page. }
+                c:='a';                         { Show a-p items. }
+                WHILE (p^<>NIL) AND (c<='p') DO BEGIN
+                        Msg(Replace(Replace(msgs[30],'@1',c),'@v',ItemName(p)));
+                        Inc(c);
+                        p:=@(p^^.next);
+                END;
+                                                { Tell if there is more. }
+                IF (p^<>NIL) THEN Msg(msgs[19]);
+
+                k:=GetKey;                      { Get players choice. }
+                ClrMsg;                         { And find this item. }
+                IF (k>='a') AND (k<c) THEN BEGIN
+                        p:=page;
+                        c:='a';
+                        WHILE (c<>k) DO BEGIN
+                                Inc(c);
+                                p:=@(p^^.next);
+                        END;
+                        ListItems:=p;
+                END;
+                IF k<>cmd[CMDMORE] THEN Exit;   { If the player picked something -- we finish. }
+                IF p^=NIL THEN p:=@(where^^.con);
+        UNTIL FALSE;                            { And if not, we display another page. }
+END;
+
+PROCEDURE SelectItem(what: ItemSlot);           { Shows item description,asks for action and performs it. }
+VAR     c: CHAR;
+        l: INTEGER;
+        tmp: pItem;
+        s: STRING;
+
+        AllowLoot, AllowPutInto, AllowHold, AllowDrop, AllowPack: BOOLEAN;
+        WhereEquip: BYTE;
+
+BEGIN
+   REPEAT
+        IF (what=NIL) OR (what^=NIL) OR                 { We won't select an empty item nor pile. }
+           (what^^.def^.id=PILEITEM) THEN BEGIN
+                Msg(msgs[10]);
+                Exit;
+        END;
+
+        ClrMsg;
+        Msg(Replace(msgs[17],'@v',ItemName(what)));     { We show item's name and description. }
+        {IF (ITEM_KNOWN IN what^^.flg) THEN}
+        Msg(GetItemDesc(what));
+
+        l:=GetItemWeight(what);                         { We display item's weight. }
+        IF l=1 THEN s:=Replace(msgs[33],'@s','')
+               ELSE s:=Plural(msgs[33]);
+        Msg(Replace(s,'@v',Num(l)));
+
+        AllowHold:=FALSE;                               { Now we determine what actions can be performed. }
+        AllowPutInto:=FALSE;
+        AllowLoot:=FALSE;
+        AllowDrop:=FALSE;
+        AllowPack:=FALSE;
+        WhereEquip:=0;
+
+        IF (pc.inv[INV_PACK]<>NIL)AND                   { If we have pack and the item we have selected isn't that pack, }
+           (ITEM_EMPTY IN pc.inv[INV_PACK]^.def^.flg)AND{we can put our item into pack. }
+	   NOT(IsInThere(what,@(pc.inv[INV_PACK])))AND
+	   (pc.inv[INV_PACK]<>what^) THEN AllowPack:=TRUE;
+
+        IF pc.inv[INV_HELD]=NIL THEN AllowHold:=TRUE;   { If the player character is empty handed, we can hold something. }
+
+        IF (pc.inv[INV_HELD]<>NIL)AND			{ If the player holds something, and selected item is a container,
+							{ he can put held item in. }
+           NOT(IsInThere(what,@(pc.inv[INV_HELD])))AND  { But we have to make sure he won't put it into itself! }
+           (ITEM_EMPTY IN what^^.def^.flg) THEN AllowPutInto:=TRUE;
+
+        IF (what^^.con<>NIL) THEN AllowLoot:=TRUE;      { If it isn't empty, we can loot it. }
+
+							{ Dropping only when the item isn't on floor already. }
+	IF NOT(IsInThere(what,@(GetMap(playchr^.x,playchr^.y)^.slt))) THEN AllowDrop:=TRUE;
+
+        WhereEquip:=what^^.def^.eqp;                    { And we can equip is if it can be equipped. :) }
+
+        IF AllowHold    THEN Msg(msgs[41]);             { We display action names. }
+        IF AllowPutInto THEN Msg(msgs[42]);
+        IF WhereEquip>0 THEN Msg(msgs[44]);
+        IF AllowPack    THEN Msg(msgs[45]);
+        IF AllowLoot    THEN Msg(msgs[40]);
+        IF AllowDrop    THEN Msg(msgs[43]);
+
+        l:=CMDNOTHING;                                  { Ask for action. }
+        c:=GetKey;
+        ClrMsg;
+        IF AllowPack    THEN CheckCmd(l,c,CMDPUTTOPACK);
+        IF AllowLoot    THEN CheckCmd(l,c,CMDLOOT);
+        IF AllowHold    THEN CheckCmd(l,c,CMDUPINAIR);
+        IF AllowPutInto THEN CheckCmd(l,c,CMDUPINAIR);
+        IF WhereEquip>0 THEN CheckCmd(l,c,CMDEQUIP);
+        IF AllowDrop    THEN CheckCmd(l,c,CMDDROP);
+
+        CASE l OF                                       { Perform the action. }
+                CMDLOOT: BEGIN                          { We list items inside and wait allow to select an item. }
+                                what:=ListItems(what);
+                        END;
+                CMDPUTTOPACK: BEGIN
+                                PutToPack(what);        { Simple. }
+                                what:=NIL;              { We don't want to select this item again. }
+                        END;
+                CMDUPINAIR: IF AllowHold THEN BEGIN
+                                MoveItem(what,@(pc.inv[INV_HELD]));
+                                what:=NIL;
+                        END ELSE IF AllowPutInto THEN BEGIN
+                                MoveInto(@(pc.inv[INV_HELD]),what);
+                                Msg(Replace(Replace(msgs[15],'@1',ItemName(what)) ,'@v',ItemName(@(pc.inv[INV_HELD]))));
+                                what:=NIL;
+                        END;
+                CMDDROP:BEGIN
+                                DropItem(what,@(GetMap(playchr^.x,playchr^.y)^.slt));
+                                ShowItem(@(GetMap(playchr^.x,playchr^.y)^.slt));
+                                what:=NIL;
+                        END;
+                CMDEQUIP:BEGIN		{ If there is an item equipped and player character is empty handed, we hold equipped item. }
+                                IF pc.inv[WhereEquip]<>NIL THEN
+                                         IF pc.inv[INV_HELD]=NIL THEN MoveItem(@(pc.inv[WhereEquip]),@(pc.inv[INV_HELD]));
+
+                                                        { If the slot is free, we equip selected item. }
+                                IF pc.inv[WhereEquip]=NIL THEN MoveItem(what,@(pc.inv[WhereEquip]))
+                                                          ELSE Msg(msgs[32]);
+                                what:=NIL;
+                         END;
+                CMDNOTHING:BEGIN                        { If no action, we cancel selection. }
+                                Msg(msgs[10]);
+                                what:=NIL;
+                        END;
+        END;
+   UNTIL what=NIL;                                      { If the player haven't selected another item, we finish. }
+END;
+
+PROCEDURE CheckPile(where: ItemSlot);                   { Destroys a pile if itsn't needed anymore. }
+VAR     tmp: ItemSlot;
+BEGIN
+        IF where^=NIL THEN Exit;                        { If there is nothing there, we finish. }
+        IF where^^.def^.id<>PILEITEM THEN Exit;         { If there is no pile, we finish too. }
+
+        IF where^^.con=NIL THEN BEGIN                   { If the pile is empty, we simply destroy it. }
+                DestroyItem(where);
+                Exit;
+        END;
+        IF (where^^.con^.next=NIL) THEN BEGIN           { If there is only one item in the pile.. }
+		New(tmp);                               { We need 'third hand'. }
+		tmp^:=NIL;
+		MoveItem(@(where^^.con),tmp);           { We take the item out of pile. }
+                DestroyItem(where);                     { We destroy the pile. }
+                MoveItem(tmp,where);                    { Then we put the item on the floor. }
+                Dispose(tmp);                           { We don't need third hand. }
+        END;
+END;
+
+PROCEDURE ExamInv;                                      { Displays equipment. }
+VAR     c:CHAR;
+BEGIN
+        ClrMsg;
+        Msg(Concat('@Ma@m)HELD: @M',ItemName(@(pc.inv[INV_HELD]))));
+        Msg(Concat('@Mb@m)PACK: @M',ItemName(@(pc.inv[INV_PACK]))));
+        Msg(Concat('@Mc@m)WEAR: @M',ItemName(@(pc.inv[INV_WEAR]))));
+        c:=GetKey;
+        ClrMsg;
+        CASE c OF
+                'a': SelectItem(@pc.inv[INV_HELD]);
+                'b': SelectItem(@pc.inv[INV_PACK]);
+                'c': SelectItem(@pc.inv[INV_WEAR]);
+        END;
+END;
+
+END.
\ No newline at end of file