Mercurial > rg

comparison items.pas @ 0:62966dd383ed default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial
author Radomir Dopieralski <sheep-devel@sheep.art.pl>
date Sun, 08 Dec 2013 19:39:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:62966dd383ed
1 { Items handling routines. }
2
3 UNIT Items;
4
5 INTERFACE
6
7 USES Global;
8
9 FUNCTION GetItemWeight(what: ItemSlot): INTEGER; { Counts the weight of an item. }
10 FUNCTION IsInThere(what,where: ItemSlot):BOOLEAN; { Checks if item WHAT is somwhere inside item WHERE. }
11 PROCEDURE GetItemLooks(VAR a:BYTE;VAR c:CHAR;what:ItemSlot); { Sets A and C to fit items looks. }
12 FUNCTION GetItemDesc(what: ItemSlot): STRING; { Returns item description. }
13 FUNCTION ItemName(what: ItemSlot): STRING; { Returns the name of an item. }
14 PROCEDURE ShowItem(what: ItemSlot); { Tells what kind of item is there. }
15
16 FUNCTION GenerateItem(id:BYTE):pItem; { Creates a new item from definitions. }
17 PROCEDURE DestroyItem(what: ItemSlot); { Destroys an item. }
18 PROCEDURE MoveInto(what,where: ItemSlot); { Tries to put item from WHAT into container in slot WHERE. }
19 PROCEDURE MoveItem(what,where: ItemSlot); { Tries to put item from WHAT into slot WHERE. }
20 PROCEDURE DropItem(what,where: ItemSlot); { Drops item from WHAT into slot WHERE, creating a pile if needed. }
21 PROCEDURE PutToPack(what: ItemSlot); { Tries to put an item into pack. }
22
23 FUNCTION ListItems(where: ItemSlot):ItemSlot; { Lists all items in the container and picks one. }
24 PROCEDURE SelectItem(what: ItemSlot); { Shows item description,asks for action and performs it. }
25 PROCEDURE CheckPile(where: ItemSlot); { Destroys a pile if itsn't needed anymore. }
26 PROCEDURE ExamInv; { Displays equipment. }
27
28 IMPLEMENTATION
29
30 USES Console;
31
32 TYPE pStack=^StackRec;
33 StackRec=RECORD
34 slt: pItem;
35 next: pStack;
36 END;
37
38 VAR stack: pStack;
39
40 { ------------------------------------------- Item information ---------- }
41
42 PROCEDURE StackPush(what: pItem); { Pushes an item entry on stack. }
43 VAR tmp: pStack;
44 BEGIN
45 New(tmp);
46 tmp^.slt:=what;
47 tmp^.next:=stack;
48 stack:=tmp;
49 END;
50
51 PROCEDURE StackPop(VAR what: pItem); { Pops an item entry from stack. }
52 VAR tmp: pStack;
53 BEGIN
54 IF stack=NIL THEN Exit;
55 what:=stack^.slt;
56 tmp:=stack;
57 stack:=stack^.next;
58 Dispose(tmp);
59 END;
60
61
62 FUNCTION GetItemWeight(what: ItemSlot): INTEGER; { Counts the weight of an item. }
63 VAR weight: INTEGER;
64 p: pItem;
65 BEGIN
66 stack:=NIL; { The stack is empty. }
67 weight:=what^^.def^.wgt*what^^.qnt; { Base weight. }
68 StackPush(what^^.con); { Now we search all the tree. }
69 REPEAT
70 StackPop(p);
71 WHILE p<>NIL DO BEGIN
72 Inc(weight,p^.def^.wgt*p^.qnt);
73 IF p^.con<>NIL THEN StackPush(p^.con);
74 p:=p^.next;
75 END;
76 UNTIL p=NIL;
77 GetItemWeight:=weight;
78 END;
79
80 FUNCTION IsInThere(what,where: ItemSlot):BOOLEAN; { Checks if item WHAT is somwhere inside item WHERE. }
81 VAR p: pItem;
82 BEGIN
83 IsInThere:=FALSE;
84 stack:=NIL;
85 StackPush(where^);
86 REPEAT
87 StackPop(p);
88 WHILE p<>NIL DO BEGIN
89 IF p=what^ THEN IsInThere:=TRUE;
90 IF p^.con<>NIL THEN StackPush(p^.con);
91 p:=p^.next;
92 END;
93 UNTIL p=NIL;
94 END;
95
96 PROCEDURE GetItemLooks(VAR a:BYTE;VAR c:CHAR;what:ItemSlot); { Sets A and C to fit items looks. }
97 VAR tmp: ItemDef;
98 BEGIN
99 IF (SLOT_KNOWN IN what^^.flg) THEN tmp:=what^^.def
100 ELSE tmp:=FindItem(what^^.def^.unk);
101 c:=tmp^.chr;
102 a:=tmp^.atr;
103 END;
104
105 FUNCTION GetItemDesc(what: ItemSlot): STRING; { Returns item description. }
106 BEGIN
107 IF (SLOT_KNOWN IN what^^.flg)OR(what^^.def^.unk=0) THEN { If item is known -- we return its description. }
108 GetItemDesc:=what^^.def^.dsc
109 ELSE GetItemDesc:=FindItem(what^^.def^.unk)^.dsc; { But if not, we return description of item type. }
110 END;
111
112 FUNCTION ItemName(what: ItemSlot): STRING; { Returns the name of an item. }
113 VAR s: STRING;
114 BEGIN
115 ItemName:='';
116 IF (what^=NIL) THEN BEGIN { If there is nothing, we return 'nothing'. }
117 ItemName:=FindItem(0)^.nam;
118 Exit;
119 END;
120
121 IF (SLOT_KNOWN IN what^^.flg) THEN s:=what^^.def^.nam { If item is known, we return its real name. }
122 ELSE s:=FindItem(what^^.def^.unk)^.nam;
123
124 { When there are many items of the same kind, we tell how many. }
125 IF (ITEM_MULTIPLE IN what^^.def^.flg) AND (what^^.qnt>1) THEN
126 s:=Replace(Plural(s),'@a',Num(what^^.qnt))
127 ELSE BEGIN { Elsewhen we add 'a' or 'an'. }
128 s:=Replace(s,'@a a','an a');
129 s:=Replace(s,'@a e','an e');
130 s:=Replace(s,'@a i','an i');
131 s:=Replace(s,'@a o','an o');
132 s:=Replace(s,'@a u','an u');
133 s:=Replace(s,'@a ' ,'a ');
134 s:=Replace(s,'@a' ,'a');
135 s:=Replace(s,'@s','');
136 END;
137 ItemName:=s;
138 END;
139
140 PROCEDURE ShowItem(what: ItemSlot); { Tells what kind of item is there. }
141 BEGIN
142 IF what^=NIL THEN Exit; { If there is nothing -- we won't bother. }
143 Msg(Replace(msgs[13],'@v',ItemName(what)));
144 END;
145
146 { ------------------------------------------- Item moving and creation -- }
147
148 FUNCTION GenerateItem(id:BYTE):pItem; { Creates a new item from definitions. }
149 VAR item: ItemDef;
150 tmp: pItem;
151 BEGIN
152 New(tmp); { We make room for item. }
153 item:=FindItem(id); { We find according definitions. }
154 tmp^.def:=item; { We fill in all data necessary. }
155 tmp^.qnt:=item^.qnt+Random(item^.qnt);
156 tmp^.flg:=[];
157 tmp^.con:=NIL;
158 tmp^.next:=NIL;
159 IF (ITEM_KNOWN IN item^.flg) THEN tmp^.flg:=tmp^.flg+[SLOT_KNOWN];
160 GenerateItem:=tmp; { And we have brand new item. }
161 END;
162
163 PROCEDURE DestroyItem(what: ItemSlot); { Destroys an item. }
164 VAR tmp: pItem;
165 BEGIN
166 tmp:=what^; { We take item from any container it may be in. }
167 what^:=tmp^.next; { We update this container's list of items. }
168 Dispose(tmp); { And we relase memory. }
169 END;
170
171 PROCEDURE MoveInto(what,where: ItemSlot); { Tries to put item from WHAT into container in slot WHERE. }
172 VAR tmp: pItem;
173 BEGIN
174 IF IsInThere(where,what) THEN Exit; { We dont want to put something into itself! }
175 tmp:=what^; { Now, we take item from any container it may be in. }
176 what^:=tmp^.next; { We update this container's list of items. }
177 tmp^.next:=where^^.con; { We put all items from WHERE behind our item. }
178 where^^.con:=tmp; { We put our item into item in slot WHERE. }
179 END;
180
181 PROCEDURE MoveItem(what,where: ItemSlot); { Tries to put item from WHAT into slot WHERE. }
182 VAR tmp: pItem;
183 BEGIN
184 IF where^<>NIL THEN Exit; { Is there something already? }
185 tmp:=what^; { Now, we take item from any container it may be in. }
186 what^:=tmp^.next; { We update this container's list of items. }
187 tmp^.next:=NIL; { Our item is the only one here. }
188 where^:=tmp; { We put our item into slot WHERE. }
189 END;
190
191 PROCEDURE DropItem(what,where: ItemSlot); { Drops item from WHAT into slot WHERE, creating a pile if needed. }
192 VAR tmp: ItemSlot;
193 p: pItem;
194 BEGIN
195 IF where^=NIL THEN BEGIN { If WHERE is empty, we simply put our item there. }
196 MoveItem(what,where);
197 Exit;
198 END;
199
200 IF where^^.def^.id=PILEITEM THEN BEGIN { If there is a pile already, we just add our item to the pile. }
201 MoveInto(what,where)
202 END ELSE BEGIN { If there is an item already... }
203 New(tmp); { We need 'third hand'. }
204 tmp^:=NIL;
205 MoveItem(where,tmp); { We pick the item from the floor. }
206 p:=GenerateItem(PILEITEM); { Then we create a pile... }
207 MoveItem(@p,where); { And put it on the floor. }
208 MoveInto(tmp,where); { Then we put both items into the pile. }
209 MoveInto(what,where);
210 Dispose(tmp); { W don't need third hand anymore. }
211 END;
212 END;
213
214 PROCEDURE PutToPack(what: ItemSlot); { Tries to put an item into pack. }
215 BEGIN
216 IF (pc.inv[INV_PACK]=NIL) OR { Have we any pack to put into? }
217 NOT (ITEM_EMPTY IN pc.inv[INV_PACK]^.def^.flg) THEN Exit;
218 { We inform the player about what we are doing. }
219 Msg(Replace(Replace(msgs[15],'@1',ItemName(@(pc.inv[INV_PACK]))),'@v',ItemName(what)));
220 MoveInto(what,@(pc.inv[INV_PACK])); { And we do it. }
221 END;
222
223 { ------------------------------------------- Menus and handling -------- }
224
225 PROCEDURE CheckCmd(VAR a:INTEGER;c:CHAR;b:BYTE);{ Checks if key C belong to command B }
226 BEGIN { and sets A to this command if so. }
227 IF c=cmd[b] THEN a:=b;
228 END;
229
230 FUNCTION ListItems(where: ItemSlot):ItemSlot; { Lists all items in the container and picks one. }
231 VAR p,page: ItemSlot;
232 c,k: CHAR;
233 BEGIN
234 ListItems:=NIL;
235 ClrMsg;
236 p:=@(where^^.con);
237 REPEAT { Tell what item we are looking into. }
238 Msg(Replace(msgs[29],'@v',ItemName(where)));
239
240 page:=p; { Mark the top of actual page. }
241 c:='a'; { Show a-p items. }
242 WHILE (p^<>NIL) AND (c<='p') DO BEGIN
243 Msg(Replace(Replace(msgs[30],'@1',c),'@v',ItemName(p)));
244 Inc(c);
245 p:=@(p^^.next);
246 END;
247 { Tell if there is more. }
248 IF (p^<>NIL) THEN Msg(msgs[19]);
249
250 k:=GetKey; { Get players choice. }
251 ClrMsg; { And find this item. }
252 IF (k>='a') AND (k<c) THEN BEGIN
253 p:=page;
254 c:='a';
255 WHILE (c<>k) DO BEGIN
256 Inc(c);
257 p:=@(p^^.next);
258 END;
259 ListItems:=p;
260 END;
261 IF k<>cmd[CMDMORE] THEN Exit; { If the player picked something -- we finish. }
262 IF p^=NIL THEN p:=@(where^^.con);
263 UNTIL FALSE; { And if not, we display another page. }
264 END;
265
266 PROCEDURE SelectItem(what: ItemSlot); { Shows item description,asks for action and performs it. }
267 VAR c: CHAR;
268 l: INTEGER;
269 tmp: pItem;
270 s: STRING;
271
272 AllowLoot, AllowPutInto, AllowHold, AllowDrop, AllowPack: BOOLEAN;
273 WhereEquip: BYTE;
274
275 BEGIN
276 REPEAT
277 IF (what=NIL) OR (what^=NIL) OR { We won't select an empty item nor pile. }
278 (what^^.def^.id=PILEITEM) THEN BEGIN
279 Msg(msgs[10]);
280 Exit;
281 END;
282
283 ClrMsg;
284 Msg(Replace(msgs[17],'@v',ItemName(what))); { We show item's name and description. }
285 {IF (ITEM_KNOWN IN what^^.flg) THEN}
286 Msg(GetItemDesc(what));
287
288 l:=GetItemWeight(what); { We display item's weight. }
289 IF l=1 THEN s:=Replace(msgs[33],'@s','')
290 ELSE s:=Plural(msgs[33]);
291 Msg(Replace(s,'@v',Num(l)));
292
293 AllowHold:=FALSE; { Now we determine what actions can be performed. }
294 AllowPutInto:=FALSE;
295 AllowLoot:=FALSE;
296 AllowDrop:=FALSE;
297 AllowPack:=FALSE;
298 WhereEquip:=0;
299
300 IF (pc.inv[INV_PACK]<>NIL)AND { If we have pack and the item we have selected isn't that pack, }
301 (ITEM_EMPTY IN pc.inv[INV_PACK]^.def^.flg)AND{we can put our item into pack. }
302 NOT(IsInThere(what,@(pc.inv[INV_PACK])))AND
303 (pc.inv[INV_PACK]<>what^) THEN AllowPack:=TRUE;
304
305 IF pc.inv[INV_HELD]=NIL THEN AllowHold:=TRUE; { If the player character is empty handed, we can hold something. }
306
307 IF (pc.inv[INV_HELD]<>NIL)AND { If the player holds something, and selected item is a container,
308 { he can put held item in. }
309 NOT(IsInThere(what,@(pc.inv[INV_HELD])))AND { But we have to make sure he won't put it into itself! }
310 (ITEM_EMPTY IN what^^.def^.flg) THEN AllowPutInto:=TRUE;
311
312 IF (what^^.con<>NIL) THEN AllowLoot:=TRUE; { If it isn't empty, we can loot it. }
313
314 { Dropping only when the item isn't on floor already. }
315 IF NOT(IsInThere(what,@(GetMap(playchr^.x,playchr^.y)^.slt))) THEN AllowDrop:=TRUE;
316
317 WhereEquip:=what^^.def^.eqp; { And we can equip is if it can be equipped. :) }
318
319 IF AllowHold THEN Msg(msgs[41]); { We display action names. }
320 IF AllowPutInto THEN Msg(msgs[42]);
321 IF WhereEquip>0 THEN Msg(msgs[44]);
322 IF AllowPack THEN Msg(msgs[45]);
323 IF AllowLoot THEN Msg(msgs[40]);
324 IF AllowDrop THEN Msg(msgs[43]);
325
326 l:=CMDNOTHING; { Ask for action. }
327 c:=GetKey;
328 ClrMsg;
329 IF AllowPack THEN CheckCmd(l,c,CMDPUTTOPACK);
330 IF AllowLoot THEN CheckCmd(l,c,CMDLOOT);
331 IF AllowHold THEN CheckCmd(l,c,CMDUPINAIR);
332 IF AllowPutInto THEN CheckCmd(l,c,CMDUPINAIR);
333 IF WhereEquip>0 THEN CheckCmd(l,c,CMDEQUIP);
334 IF AllowDrop THEN CheckCmd(l,c,CMDDROP);
335
336 CASE l OF { Perform the action. }
337 CMDLOOT: BEGIN { We list items inside and wait allow to select an item. }
338 what:=ListItems(what);
339 END;
340 CMDPUTTOPACK: BEGIN
341 PutToPack(what); { Simple. }
342 what:=NIL; { We don't want to select this item again. }
343 END;
344 CMDUPINAIR: IF AllowHold THEN BEGIN
345 MoveItem(what,@(pc.inv[INV_HELD]));
346 what:=NIL;
347 END ELSE IF AllowPutInto THEN BEGIN
348 MoveInto(@(pc.inv[INV_HELD]),what);
349 Msg(Replace(Replace(msgs[15],'@1',ItemName(what)) ,'@v',ItemName(@(pc.inv[INV_HELD]))));
350 what:=NIL;
351 END;
352 CMDDROP:BEGIN
353 DropItem(what,@(GetMap(playchr^.x,playchr^.y)^.slt));
354 ShowItem(@(GetMap(playchr^.x,playchr^.y)^.slt));
355 what:=NIL;
356 END;
357 CMDEQUIP:BEGIN { If there is an item equipped and player character is empty handed, we hold equipped item. }
358 IF pc.inv[WhereEquip]<>NIL THEN
359 IF pc.inv[INV_HELD]=NIL THEN MoveItem(@(pc.inv[WhereEquip]),@(pc.inv[INV_HELD]));
360
361 { If the slot is free, we equip selected item. }
362 IF pc.inv[WhereEquip]=NIL THEN MoveItem(what,@(pc.inv[WhereEquip]))
363 ELSE Msg(msgs[32]);
364 what:=NIL;
365 END;
366 CMDNOTHING:BEGIN { If no action, we cancel selection. }
367 Msg(msgs[10]);
368 what:=NIL;
369 END;
370 END;
371 UNTIL what=NIL; { If the player haven't selected another item, we finish. }
372 END;
373
374 PROCEDURE CheckPile(where: ItemSlot); { Destroys a pile if itsn't needed anymore. }
375 VAR tmp: ItemSlot;
376 BEGIN
377 IF where^=NIL THEN Exit; { If there is nothing there, we finish. }
378 IF where^^.def^.id<>PILEITEM THEN Exit; { If there is no pile, we finish too. }
379
380 IF where^^.con=NIL THEN BEGIN { If the pile is empty, we simply destroy it. }
381 DestroyItem(where);
382 Exit;
383 END;
384 IF (where^^.con^.next=NIL) THEN BEGIN { If there is only one item in the pile.. }
385 New(tmp); { We need 'third hand'. }
386 tmp^:=NIL;
387 MoveItem(@(where^^.con),tmp); { We take the item out of pile. }
388 DestroyItem(where); { We destroy the pile. }
389 MoveItem(tmp,where); { Then we put the item on the floor. }
390 Dispose(tmp); { We don't need third hand. }
391 END;
392 END;
393
394 PROCEDURE ExamInv; { Displays equipment. }
395 VAR c:CHAR;
396 BEGIN
397 ClrMsg;
398 Msg(Concat('@Ma@m)HELD: @M',ItemName(@(pc.inv[INV_HELD]))));
399 Msg(Concat('@Mb@m)PACK: @M',ItemName(@(pc.inv[INV_PACK]))));
400 Msg(Concat('@Mc@m)WEAR: @M',ItemName(@(pc.inv[INV_WEAR]))));
401 c:=GetKey;
402 ClrMsg;
403 CASE c OF
404 'a': SelectItem(@pc.inv[INV_HELD]);
405 'b': SelectItem(@pc.inv[INV_PACK]);
406 'c': SelectItem(@pc.inv[INV_WEAR]);
407 END;
408 END;
409
410 END.