|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 7936 (0x1f00)
Types: TextFile
Names: »TFIN.PAS«
└─⟦11e151dc0⟧ Bits:30009789/_.ft.Ibm2.50006589.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »TFIN.PAS«
└─⟦514567ecc⟧ Bits:30009789/_.ft.Ibm2.50006603.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »TFIN.PAS«
(********************************************************************)
(* *)
(* INPUT MODULE starts *)
var
files : array(.1..max_includes.) of record
in_file_name : name;
(* name of input file *)
in_file : text;
(* input file *)
line_nr : integer;
(* line number of last line read *)
divide_file : file of integer;
(* file for new divide-points *)
divide_points : boolean
(* true if any new divide-points *)
end;
level : integer;
(* nesting level of includes. 1 for main file *)
attr : attribute_set;
(* current attributes *)
position : array(.index.) of 1..input_line_length;
(* converts indices for new divide-points to input-line indices.
Valid for the last line read *)
(*************************************)
(* local procedures for input module *)
procedure insert_divide_points;
(* called after reading an input file is finished
and the file has been closed, if new divide points
were defined in the file *)
var revised_file : text;
updates, update_line, update_pos : integer;
buffer : string(.input_line_length.);
procedure write_line;
begin
if length(buffer) > max_line_len then
writeln('Advarsel: Linie ', files(.level.).line_nr,
' er blevet for lang ved indsættelse af delepunkter');
writeln(revised_file, buffer);
end;
begin
with files(.level.) do begin
close(divide_file);
if in_file_name(.2.) = ':' then
assign(revised_file,
copy(in_file_name, 1, 2)+revised_file_name)
else
assign(revised_file, revised_file_name);
rewrite(revised_file);
reset(in_file); reset(divide_file);
readln(in_file, buffer); line_nr := 1; updates := 0;
while not eof(divide_file) do begin
read(divide_file, update_line, update_pos);
while line_nr < update_line do begin
write_line;
readln(in_file, buffer);
line_nr := line_nr+1; updates := 0;
end;
insert('^-', buffer, update_pos+2*updates);
updates := updates+1;
end;
while not eof(in_file) do begin
write_line;
readln(in_file, buffer);
line_nr := line_nr+1;
end;
write_line;
close(revised_file); close(in_file); close(divide_file);
erase(in_file); rename(revised_file, in_file_name);
erase(divide_file)
end;
end; (* insert_divide_points *)
procedure close_what_can_be;
(* closes any input files that can be *)
function more_to_close : boolean;
begin
if level = 0 then more_to_close := false
else more_to_close := eof(files(.level.).in_file)
end;
begin
while more_to_close do begin
with files(.level.) do begin
close(in_file);
if divide_points then insert_divide_points;
end;
level := level-1;
end;
end;
(* end of local procedures for input module *)
(********************************************)
procedure init_input;
begin
level := 0;
attr := (..)
end;
procedure include_input(filename : name; var ok : boolean);
(* may be called only after all calls of "insert_dividepoint_input"
pertaining to the last line read have been performed *)
begin
close_what_can_be;
if level = max_includes then
ok := false
else begin
level := level+1;
with files(.level.) do begin
in_file_name := filename;
assign(in_file, in_file_name);
(*$I-*) reset(in_file); (*$I+*)
ok := ioresult = 0;
divide_points := false; line_nr := 0;
end;
if not ok then level := level-1;
end;
end;
function eof_input : boolean;
var lev : integer; eofile : boolean;
begin
lev := level; eofile := true;
while (lev >= 1) and eofile do begin
if not eof(files(.lev.).in_file) then eofile := false;
lev := lev-1;
end;
eof_input := eofile;
end;
procedure get_line_input(var line : f_string);
(* may be called only when eof_input=false *)
var buffer : string(.input_line_length.);
i : integer;
line_len : index0;
begin
close_what_can_be;
with files(.level.) do begin
readln(in_file, buffer);
line_nr := line_nr+1; line_len := 0; i := 1;
while i <= length(buffer) do begin
if buffer(.i.) = '^' then begin
i := i+1;
if i > length(buffer) then insert(cr, buffer, i);
case buffer(.i.) of
'U' : attr := attr+(.underscore.);
'u' : attr := attr-(.underscore.);
'F' : attr := attr+(.bold.);
'f' : attr := attr-(.bold.);
'K' : attr := attr+(.italic.);
'k' : attr := attr-(.italic.);
'P' : attr := attr+(.proportional.);
'p' : attr := attr-(.proportional.);
'B' : attr := attr+(.nlq.);
'b' : attr := attr-(.nlq.);
'E' : attr := attr+(.unidirectional.);
'e' : attr := attr-(.unidirectional.);
's' : attr := attr-(.superscript.)+(.subscript.);
'S' : attr := attr-(.subscript.)+(.superscript.);
'N', 'n' : attr := attr-(.superscript, subscript.);
'-' : attr := attr+(.dividepoint.);
'^' : begin
line_len := line_len+1;
position(.line_len.) := i-1;
line(.line_len.).ch := '^';
line(.line_len.).attr := attr;
attr := attr-(.dividepoint.)
end;
' ', cr : begin
line_len := line_len+1;
position(.line_len.) := i-1;
line(.line_len.).ch := forced_space;
line(.line_len.).attr := attr;
attr := attr-(.dividepoint.)
end;
else
(* nothing *)
end;
i := i+1;
end else begin (* not a ^ *)
line_len := line_len+1;
position(.line_len.) := i;
line(.line_len.).ch := buffer(.i.);
line(.line_len.).attr := attr;
attr := attr-(.dividepoint.);
i := i+1;
end;
end; (* while *)
attr := attr-(.dividepoint.);
if line_len > 0 then begin
while (line(.line_len.).ch = ' ') and (line_len > 1) do
line_len := line_len-1;
if line(.line_len.).ch = ' ' then line_len := 0;
end;
f_fill(cr, (..), line, line_len+1, f_len)
end; (* with *)
end; (* get_line_input *)
procedure insert_dividepoint_input(pos : index);
(* specifies that a new divide-point shall be inserted before
the character at the stated position in the line last read.
It is assumed that divide-points are inserted from left to right *)
var p : integer;
begin
with files(.level.) do begin
p := position(.pos.);
if not divide_points then begin
assign(divide_file, divide_file_name+
chr(level div 10 +ord('0'))+
chr(level mod 10 +ord('0')) );
rewrite(divide_file);
divide_points := true
end;
write(divide_file, line_nr, p);
end;
end;
procedure terminate_input;
(* may be called only when eof_input=true *)
begin
close_what_can_be; (* that ought to be everything *)
end;
(* INPUT MODULE ends *)
(* *)
(********************************************************************)
«eof»