-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathproject9.pas
99 lines (82 loc) · 2.27 KB
/
project9.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
program project7;
uses
classes, sysutils,StrUtils;
type
tmyarray = array of string;
var
arquivo: textfile;
linha:string;
nmitens, i,pos1,pos2,pos3, lista1,lista2,quantidade,codeerr:integer;
listaitens:tmyarray;
mmove,ffrom,tto:string;
procedure move (var a:string; var b:string; quantos:integer);
var i:integer;
tam:integer;
begin
for i:=1 to quantos do
begin
if (a<>'') then
begin
b:=a[1]+b;
tam:=length(a) -1;
a:=copy(a,2,tam);
end;
end;
end;
procedure preenche(linha:string; var lista:tmyarray);
var i,posicao:integer;
begin
for i:=1 to (length(linha) div 4)+1 do
begin
if (i=1) then
posicao:=2
else
posicao:=2+(4*(i-1));
if linha[posicao] <> ' ' then
lista[i-1]:=lista[i-1]+linha[posicao];
end;
end;
begin
i:=0;
Assign(arquivo,'c:\projetos\advent\entrada5.txt');
reset (arquivo);
readln(arquivo,linha);
while linha[2] <> '1' do
begin
nmitens := (length(linha)+1) div 4;
setlength(listaitens,nmitens);
preenche(linha, listaitens);
readln(arquivo,linha);
end;
while not eof(arquivo) do
begin
readln(arquivo,linha);
if linha[1] <> ' ' then
begin
mmove:='move';
ffrom:='from';
tto:='to';
pos1:=pos(mmove,linha)+5;
pos2:=pos(ffrom,linha);
pos3:=pos(tto,linha);
val(copy(linha,(pos2+5),(pos3-pos2-6)),lista1,codeerr);
val(copy(linha,pos3+3,length(linha)-pos3),lista2,codeerr);
val(copy(linha,pos1,pos2-pos1-1),quantidade,codeerr);
writeln('movendo ',quantidade, ' de ',listaitens[lista1 -1],' a ',listaitens[lista2 -1]);
for i:=0 to length(listaitens)-1 do
writeln(listaitens[i]);
writeln('---');
move(listaitens[lista1 -1], listaitens[lista2-1],quantidade);
for i:=0 to length(listaitens)-1 do
writeln(listaitens[i]);
writeln ('----------');
end;
end;
for i:=0 to length(listaitens)-1 do
begin
writeln (listaitens[i]);
end;
write('final');
for i:=0 to length(listaitens)-1 do
write(listaitens[i][1]);
end.