forked from videogamepreservation/softporn
-
Notifications
You must be signed in to change notification settings - Fork 3
/
SOFTPACK.PAS
92 lines (70 loc) · 1.48 KB
/
SOFTPACK.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
{$C+}
{$R+}
{$U+}
program PACK;
const recsize = 450;
EOL = #$0D;
infile_name = 'SOFTPORN.TXT';
outfile_name = 'SOFTPORN.MSG';
type rectype = array[1..recsize] of char;
str = string[120];
var line : str;
rec : rectype;
infile : text;
outfile : file of rectype;
i : integer;
recpos : integer;
procedure clearrec;
var i : integer;
begin
recpos := 1;
for i:=1 to recsize do
rec[i] := chr(0);
end;
procedure addrec( c : char);
begin
if recpos>recsize then
begin
writeln('Record overflow in :');
writeln(line);
halt;
end;
rec[recpos] := c;
recpos := recpos + 1;
end;
procedure dumprec;
begin
if recpos>1 then
begin
write( outfile, rec );
write( recpos:4 );
end;
clearrec;
end;
begin { Main program }
writeln('Converting ',infile_name,' to ',outfile_name,'. Recsize=',recsize);
writeln;
assign(infile,infile_name);
assign(outfile,outfile_name);
reset(infile);
rewrite(outfile);
clearrec;
randomize;
while not eof(infile) do
begin
readln( infile, line );
if copy(line,1,3)='###' then
dumprec
else if line<>'' then
begin
for i:=1 to length(line) do
addrec(succ(line[i]));
addrec(EOL);
end;
end;
dumprec;
close(infile);
close(outfile);
writeln;
end.