DEADSOFTWARE

76ba270e824156e836d105be310f221b2610447f
[cavecraft.git] / src / inv.mpsrc
1 unit inv;
3 interface
4 const
5 INV_SIZE=35;
8 function getItem(i:integer):integer;
9 function getSum(i:integer):integer;
10 procedure setItem(val, i:integer);
11 procedure setSum(val, i:integer);
12 function isNull(i:integer):boolean;
13 procedure fixNull(i:integer);
15 function giveItem(ityp, isum:integer):integer;
17 procedure resetData;
18 procedure saveData;
19 procedure loadData;
21 implementation
22 uses items_store, vars, jsr75i, items, func;
23 var
24 inv_item: array [0..INV_SIZE] of integer;
25 inv_sum: array [0..INV_SIZE] of integer;
27 function getItem(i:integer):integer;
28 begin
29 getItem:=inv_item[i];
30 end;
32 function getSum(i:integer):integer;
33 begin
34 getSum:=inv_sum[i];
35 end;
37 procedure setItem(val, i:integer);
38 begin
39 inv_item[i]:=val;
40 end;
42 procedure setSum(val, i:integer);
43 begin
44 inv_sum[i]:=val;
45 end;
47 function isNull(i:integer):boolean;
48 begin
49 if (getItem(i)<1) or (getSum(i)<1) then
50 isNull:=true;
51 end;
53 procedure fixNull(i:integer);
54 begin
55 if isNull(i) then
56 begin
57 setItem(0, i);
58 setSum(0, i);
59 end;
60 end;
62 //Добавить предмет в инвентарь, возващает количество не полученых предметов.
63 function giveItem(ityp, isum:integer):integer;
64 var
65 i, item, sum:integer;
66 begin
67 //Ищем такой же предмет только если он имеет возможность делиться
68 if getItemDiv(ityp) then
69 for i:=0 to INV_SIZE do
70 begin
71 item:=getItem(i);
72 sum:=getSum(i);
74 if (item=ityp) and (isNull(i)=false) then
75 if isum<getItemMax(ityp) then
76 begin
77 sum:=sum+isum;
78 isum:=0;
80 if sum>getItemMax(ityp) then
81 begin
82 isum:=sum-getItemMax(ityp);
83 sum:=sum-isum;
84 end;
86 setSum(sum, i);
88 if isum<1 then
89 exit;
90 end;
91 end;
93 for i:=0 to INV_SIZE do
94 if isNull(i) then
95 begin
96 sum:=isum;
97 isum:=0;
99 if sum>getItemMax(ityp) then
100 begin
101 isum:=sum-getItemMax(ityp);
102 sum:=sum-isum;
103 end;
105 setItem(ityp, i);
106 setSum(sum, i);
108 if isum<1 then
109 exit;
110 end;
112 giveItem:=isum;
113 end;
115 procedure resetData;
116 var
117 i:integer;
118 begin
119 for i:=0 to INV_SIZE do
120 begin
121 setItem(0, i);
122 setSum(0, i);
123 end;
124 end;
126 procedure saveData;
127 var
128 i:integer;
129 begin
130 for i:=0 to INV_SIZE do
131 begin
132 write_byte(getItem(i));
133 WriteInt(getSum(i));
134 end;
135 end;
137 procedure loadData;
138 var
139 i:integer;
140 begin
141 for i:=0 to INV_SIZE do
142 begin
143 setItem(read_byte, i);
144 setSum(ReadInt, i);
145 end;
146 end;
148 end.