{ 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.