(* TEXTBUF.PAS -- buffer for output of texts
** Copyright (c) 1995,1996 Jochen Metzinger
**
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 2, or (at your option)
** any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

UNIT TextBuf;

INTERFACE

USES errors;

CONST
 DEFAULT_LINE = 78;
 MAX_TABS = 8;

PROCEDURE buf_open(filename: STRING);
(* open 'filename' for output *)

PROCEDURE buf_close;
(* close file *)

PROCEDURE buf_margin(left, indent, right, style: BYTE);
(* set margin, indent and text style (like Ruler) *)

PROCEDURE buf_set_tab(pos: WORD);
(* set a tab *)

PROCEDURE buf_line_space(skip: BYTE);
(* set line spacing *)

PROCEDURE buf_add(txt: STRING);
(* add 'txt' to current line *)

PROCEDURE buf_indent;
(* add indent to line *)

PROCEDURE buf_tab;
(* add tabulator to line *)

PROCEDURE buf_nl;
(* make a new line *)

PROCEDURE buf_break(txt: STRING);
(* break line and write special text 'txt' *)

IMPLEMENTATION

VAR
 output_file: TEXT;
  (* output file *)
 left_margin, indent_space, max_line: WORD;
  (* left margin and line size *)
 ragged, line_skip: BYTE;
  (* text form and line space *)
 nr_tabs: WORD;
 tab_pos: ARRAY [1..MAX_TABS] OF WORD;
  (* tabulators *)
 state: (S_TEXT, S_BROKEN);
  (* working state *)
 line: STRING;
  (* line buffer *)

PROCEDURE buf_open(filename: STRING);
BEGIN
 (*$I-*)
 Assign(output_file, filename);
 ReWrite(output_file);
 IF IOResult <> 0 THEN FATAL('unable to create file '+filename);
 (*$I+*)
 buf_margin(0,0,DEFAULT_LINE,0);
 line := ''; state := S_TEXT;
END; (* buf_open *)

PROCEDURE buf_close;
BEGIN
 buf_break('');
 Close(output_file);
END; (* buf_close *)

PROCEDURE buf_margin(left, indent, right, style: BYTE);
BEGIN
 IF left < right THEN BEGIN
  left_margin := left; max_line := right-left;
 END ELSE BEGIN
  left_margin := 0; max_line := DEFAULT_LINE;
 END; (* else *)
 IF indent >= max_line THEN indent := 0;
 indent_space := indent;
 IF style <= 3 THEN style := 0;
 ragged := style;
 line_skip := 1;
 nr_tabs := 0;
END; (* buf_margin *)

PROCEDURE buf_set_tab(pos: WORD);
 VAR i: INTEGER;
BEGIN
 IF nr_tabs = MAX_TABS THEN EXIT;
 IF pos <= left_margin THEN EXIT;
 Dec(pos, left_margin);
 IF pos >= max_line THEN EXIT;
 INC(nr_tabs);
 tab_pos[nr_tabs] := pos;
 FOR i := nr_tabs DOWNTO 2 DO
  IF tab_pos[i] < tab_pos[i-1] THEN BEGIN
   pos := tab_pos[i];
   tab_pos[i] := tab_pos[i-1];
   tab_pos[i-1] := pos;
  END; (* if *)
END; (* buf_set_tab *)

PROCEDURE buf_line_space(skip: BYTE);
BEGIN
 IF skip <= 0 THEN skip := 1;
 line_skip := skip;
END; (* buf_line_space *)

PROCEDURE break_line;
 VAR i: BYTE; rest: STRING;
BEGIN
 (* find space to break *)
 FOR i := max_line DOWNTO (max_line DIV 2) DO
  IF line[i] = ' ' THEN BEGIN
   rest := Copy(line, i+1, $FF);
   line := Copy(line, 1, i-1);
   buf_nl;
   state := S_BROKEN;
   line := rest;
   EXIT;
  END; (* if *)
 (* no space found *)
 buf_break('');
END; (* break_line *)

PROCEDURE buf_add(txt: STRING);
 VAR i: BYTE;
BEGIN
 line := line + txt;
 IF Length(line) > max_line THEN break_line;
END; (* buf_add *)

FUNCTION space(nr: BYTE): STRING;
 VAR s: STRING;
BEGIN
 FillChar(s, SizeOf(s), ' ');
 s[0] := CHAR(nr);
 space := s;
END; (* space *)

PROCEDURE CenterLine;
BEGIN
 IF Length(line) < max_line THEN
  line := space((max_line - Length(line)) DIV 2) + line;
END; (* CenterLine *)

PROCEDURE FlushRightLine;
 VAR i: INTEGER;
BEGIN
 IF Length(line) < max_line THEN
  line := space(max_line - Length(line)) + line;
END; (* FlushRightLine *)

PROCEDURE BlockLine;
 VAR i: BYTE; s, a, b: WORD;
  new_line: STRING;
BEGIN
 IF Length(line) > max_line THEN EXIT;
 (* reduce space *)
 i := 1;
 WHILE i < Length(line) DO
  IF Copy(line, i, 2) = '  '
   THEN Delete(line, i, 1)
   ELSE Inc(i);
 (* remove space at begin and end *)
 IF Copy(line,1,1) = ' ' THEN
  Delete(line,1,1);
 IF Copy(line,Length(line),1) = ' ' THEN
  Delete(line,Length(line),1);
 IF line = '' THEN EXIT;
 (* count space *)
 s := 0;
 FOR i := 1 TO Length(line) DO
  IF line[i] = ' ' THEN
   Inc(s);
 IF s = 0 THEN BEGIN
  CenterLine;
  EXIT;
 END; (* if *)
 (* calculate stretch faktor a/b *)
 a := s + (max_line - Length(line));
 b := s;
 (* insert space *)
 new_line := ''; s := 0;
 FOR i := 1 TO Length(line) DO
  IF line[i] <> ' ' THEN
   new_line := new_line + line[i]
  ELSE BEGIN
   s := s + a;
   new_line := new_line + space(s DIV b);
   s := s MOD b;
  END; (* else *)
 line := new_line;
END; (* BlockLine *)

PROCEDURE buf_nl;
 VAR i: INTEGER;
BEGIN
 IF (line <> '') OR (state = S_TEXT) THEN BEGIN
  CASE ragged OF
   1: CenterLine;
   2: FlushRightLine;
   3: BlockLine;
   ELSE (* FlushLeftLine *);
  END; (* case *)
  WriteLn(output_file, space(left_margin), line);
  line := '';
  FOR i := 2 TO line_skip DO
    WriteLn(output_file);
  state := S_TEXT;
 END; (* if *)
END; (* buf_nl *)

PROCEDURE buf_break(txt: STRING);
 VAR i: INTEGER;
BEGIN
 IF line <> '' THEN BEGIN
  CASE ragged OF
   1: CenterLine;
   2: FlushRightLine;
   3: BlockLine;
   ELSE (* FlushLeftLine *);
  END; (* case *)
  WriteLn(output_file, space(left_margin), line, '|');
  line := '';
  FOR i := 2 TO line_skip DO
    WriteLn(output_file);
  state := S_BROKEN;
 END; (* if *)
 IF txt <> '' THEN WriteLn(output_file, txt);
END; (* buf_break *)

PROCEDURE buf_tab;
 VAR i: INTEGER;
BEGIN
 IF nr_tabs = 0 THEN
  buf_add(' ')
 ELSE BEGIN
  IF Length(line) > tab_pos[nr_tabs] THEN
   buf_nl;
  FOR i := 1 TO nr_tabs DO
   IF tab_pos[i] > Length(line) THEN BEGIN
    WHILE Length(line) < tab_pos[i] DO line := line + ' ';
    EXIT;
   END; (* if *)
  FATAL('INTERN [buf_tab without tab]');
 END;
END; (* buf_tab *)

PROCEDURE buf_indent;
BEGIN
 line := line + space(indent_space);
END; (* buf_indent *)

BEGIN
 left_margin := 0; indent_space := 0; max_line := DEFAULT_LINE;
 ragged := 0; line_skip := 1;
 nr_tabs := 0;
 state := S_TEXT;
 line := '';
END. (* TextBuf *)