|
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: 11392 (0x2c80)
Types: TextFile
Names: »TF3.PAS«
└─⟦59c2ecd8d⟧ Bits:30009789/_.ft.Ibm2.50006600.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »TF3.PAS«
(**************************************************************)
(* *)
(* MODULE 3 starts *)
type
buffer_type = array(.1..buffer_size.) of record
line : f_string;
len : index0;
line_spacing : integer;
end;
var
directly_out, first_page, on_top_of_page : boolean;
spacing_of_previous_line : integer;
space_left_on_page : integer;
buffer : buffer_type;
nr_buffer_lines : integer;
buffer_height : integer;
buffer_file : file of buffer_type;
head_foot : array(.place,
1..nr_head_foot_lines,
justification.) of record
line : f_string;
len : index0;
end;
page_nr : integer;
number : array(.1..5.) of char; (* page_nr in print format *)
chars_in_nr : integer; (* no. of valid chars in number *)
hf_left, hf_right, hf_line_spacing,
foot_height, saved_foot_height,
head_height, page_height : integer;
(*********************************)
(* local procedures for module 3 *)
procedure print_head_foot(hf : place; height : integer);
(* prints the head or the foot of a page *)
var nr_lines, white_space,
i, j, pos, t1, p1, chars_missing : integer;
just : justification;
x_line, t_line : f_string;
x_len, t_len : index0;
x_width, t_width : integer;
begin
nr_lines := min(nr_head_foot_lines, height div hf_line_spacing);
for i := 1 to nr_lines do begin
if (head_foot(.hf, i, left_side.).len = 0) and
(head_foot(.hf, i, middle.).len = 0) and
(head_foot(.hf, i, right_side.).len = 0)
then
write_white_space_output(hf_line_spacing)
else begin
(* build a line from the left, the middle and the right part *)
x_len := 0; x_width := 0;
for just := left_side to right_side do begin
(* copy one of the 3 parts to t_line while substituting
the value of the page number for any series of #'s *)
with head_foot(.hf, i, just.) do begin
t_len := 0; pos := 1;
while pos <= len do begin
p1 := pos; pos := f_pos('#', line, pos, len);
if pos < p1 then pos := len+1;
f_copy(line, p1, pos-1, t_line, t_len+1);
t_len := t_len+(pos-p1);
if pos <= len then begin
(* substitute page number for a series of #'s *)
t1 := t_len; p1 := pos;
while (line(.pos.).ch = '#') and (pos <= len) do
pos := pos+1;
(* now positions p1...pos-1 contain #'s *)
(* copy minimum chars_in_nr #'s to t_line : *)
chars_missing := chars_in_nr - (pos-p1);
if chars_missing > 0 then begin
f_fill(line(.p1.).ch, line(.p1.).attr,
t_line, t_len+1, t_len+chars_missing);
t_len := t_len+chars_missing;
end;
f_copy(line, p1, pos-1, t_line, t_len+1);
t_len := t_len+(pos-p1);
(* now subsitute the #'s in t_line with the nr : *)
for j := 1 to (t_len-t1)-chars_in_nr do
t_line(.t1+j.).ch := ' ';
for j := 1 to chars_in_nr do
t_line(.t_len-(j-1).).ch := number(.j.);
end;
end; (* while pos < len *)
t_width := width(t_line, 1, t_len);
end; (* with ... *)
(* calculate how much white space to put into x_line
before the contents of t_line : *)
case just of
left_side :
white_space := hf_left;
middle :
begin
white_space := ( hf_right-hf_left-t_width ) div 2
+ hf_left - x_width;
if white_space < 0 then begin
white_space := 0;
if t_width > 0 then begin
write('Advarsel : I linie ', i, ' i ');
if hf=head then write('hovedet') else write('foden');
writeln(' på side ', page_nr,
' var det ikke muligt at centrere den midterste del');
end;
end;
end;
right_side :
begin
white_space := hf_right - t_width - x_width;
if white_space < 0 then begin
white_space := 0;
if t_width > 0 then begin
write('Advarsel : Linie ', i, ' i ');
if hf=head then write('hovedet') else write('foden');
writeln(' på side ', page_nr, ' er blevet for lang');
end;
end;
end;
end; (* case just of *)
(* put the calculated amount of white space into x_line
followed by the contents of t_line : *)
f_space(white_space, x_line, x_len+1);
x_len := x_len+1; x_width := x_width+white_space;
while x_width + t_width > max_right_margin do begin
t_width := t_width-width(t_line, t_len, t_len);
t_len := t_len-1;
end;
f_copy(t_line, 1, t_len, x_line, x_len+1);
x_len := x_len+t_len; x_width := x_width+t_width;
end; (* for just := ... *)
write_line_output(x_line, x_len, hf_line_spacing);
end; (* if ...len + ...len + ...len *)
end; (* for i := 1 to nr_lines *)
j := height - nr_lines*hf_line_spacing;
if j > 0 then write_white_space_output(j);
end; (* print_head_foot *)
procedure eject_page;
begin
write_white_space_output(space_left_on_page);
print_head_foot(foot, saved_foot_height);
end;
procedure print_buffer;
var i, j : integer;
begin
if nr_buffer_lines > 0 then begin
if nr_buffer_lines > buffer_size then begin
write(buffer_file, buffer);
close(buffer_file);
reset(buffer_file);
read(buffer_file, buffer);
end;
for i := 1 to nr_buffer_lines do begin
j := (i-1) mod buffer_size + 1;
with buffer(.j.) do begin
write_line_output(line, len, line_spacing);
space_left_on_page := space_left_on_page-line_spacing;
end;
if (j = buffer_size) and (i < nr_buffer_lines) then
read(buffer_file, buffer);
end;
if nr_buffer_lines > buffer_size then begin
close(buffer_file); erase(buffer_file);
end;
on_top_of_page := false; nr_buffer_lines := 0;
end;
end; (* print_buffer *)
procedure new_page;
var xline : f_string;
len, p1, p2 : index0;
i, num : integer;
begin
if not first_page then eject_page; first_page := false;
(* convert page_nr to print format : *)
num := page_nr; chars_in_nr := 0;
repeat
chars_in_nr := chars_in_nr+1;
number(.chars_in_nr.) := chr(ord('0')+ num mod 10);
num := num div 10;
until num = 0;
page_nr := page_nr+1;
(* print head : *)
print_head_foot(head, head_height);
on_top_of_page := true;
space_left_on_page := page_height-head_height-foot_height;
saved_foot_height := foot_height;
end; (* new_page *)
(* end of local procedures for module 3 *)
(****************************************)
procedure init_3;
var i : place; j : 1..nr_head_foot_lines; k : justification;
begin
directly_out := true; first_page := true;
spacing_of_previous_line := char_height;
nr_buffer_lines := 0;
for i := head to foot do
for j := 1 to nr_head_foot_lines do
for k := left_side to right_side do
head_foot(.i, j, k.).len := 0;
page_nr := init_page_nr;
hf_left := init_hf_left;
hf_right := init_hf_right;
hf_line_spacing := init_hf_line_spacing;
head_height := init_head_height;
foot_height := init_foot_height;
page_height := init_page_height;
assign(buffer_file, buffer_file_name);
end;
procedure write_line_3(may_break : boolean; var line : f_string;
len : index0; line_spacing : integer);
procedure put_line_into_buffer;
begin
buffer(.1.).line := line; buffer(.1.).len := len;
buffer(.1.).line_spacing := line_spacing;
nr_buffer_lines := 1; buffer_height := char_height;
end;
procedure add_line_to_buffer;
var buf_index : 1..buffer_size;
begin
if nr_buffer_lines = 0 then
put_line_into_buffer
else begin
buf_index := nr_buffer_lines mod buffer_size + 1;
if buf_index = 1 then begin
if nr_buffer_lines = buffer_size then rewrite(buffer_file);
write(buffer_file, buffer);
end;
buffer(.buf_index.).line := line; buffer(.buf_index.).len := len;
buffer(.buf_index.).line_spacing := line_spacing;
buffer_height := buffer_height+spacing_of_previous_line;
nr_buffer_lines := nr_buffer_lines+1;
end;
end;
begin (* write_line_3 *)
if first_page then new_page;
if directly_out then begin
if not may_break then begin
put_line_into_buffer;
print_buffer;
end else begin
if space_left_on_page+spacing_of_previous_line-char_height < 0 then
writeln('Advarsel : Side ',page_nr-1, ' er overfyldt.');
directly_out := false;
put_line_into_buffer;
end;
end else begin (* not directly_out *)
if not may_break then begin
add_line_to_buffer;
if buffer_height > space_left_on_page then begin
new_page; print_buffer; directly_out := true;
end;
end else begin
if buffer_height > space_left_on_page then new_page;
if not (on_top_of_page and (nr_buffer_lines = 1) and
(buffer(.1.).len = 0) ) then
print_buffer;
put_line_into_buffer;
end;
end;
spacing_of_previous_line := line_spacing;
end; (* write_line_3 *)
procedure command_3(command : command_type;
param, param2, param3, param4 : integer);
begin
case command of
set_page_nr :
page_nr := param;
set_hf_left :
hf_left := param;
set_hf_right :
hf_right := param;
set_hf_line_spacing :
hf_line_spacing := param;
set_head_height :
head_height := param;
set_foot_height :
foot_height := param;
set_page_height :
page_height := param;
eject :
begin
print_buffer; directly_out := false; new_page;
end;
figure :
(* to be implemented *)
end;
end; (* command_3 *)
procedure text_command_3(placing : place; line_id : integer;
p : justification;
var text : f_string; length : index0);
begin
with head_foot(.placing, line_id, p.) do begin
line := text; len := length;
end
end;
procedure terminate_3;
begin
if not directly_out then begin
if buffer_height > space_left_on_page then new_page;
if not (on_top_of_page and (nr_buffer_lines = 1) and
(buffer(.1.).len = 0) ) then
print_buffer;
end;
eject_page;
end;
(* MODULE 3 ends *)
(* *)
(**************************************************************)
«eof»