(* TEXTS.PAS -- translate GEOS text pages
** 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 Texts;

INTERFACE

USES global, errors, geos, coding, cvt, fontname, textbuf;

PROCEDURE open_text(fname: STRING; verbose: BOOLEAN);
(* open text system to output to FNAME and return kind of text *)

FUNCTION last_chain: ShortInt;
(* last chain which can include text *)

PROCEDURE text_page(chain: BYTE);
(* output text in chain *)

PROCEDURE close_text;
(* close text system *)

IMPLEMENTATION

TYPE
 TEXT_TYPE  = (NO_TEXT, WRITE_DOC, TEXT_SCRAP, TEXT_ALBUM, NOTES);
 TEXT_INFOS = RECORD name: STRING; min, max: BYTE; chain: ShortInt; END;

CONST
 info: ARRAY [TEXT_TYPE] OF TEXT_INFOS =
  ((name: 'File'; min: 00; max: $FF; chain: -1),
   (name: 'Write Image'; min: 10; max: 20; chain: 60),
   (name: 'Text Scrap'; min: 10; max: 20; chain: 0),
   (name: 'Text Album'; min: 10; max: 20; chain: 126),
   (name: 'Notes'; min: 10; max: 10; chain: 126));

TYPE
 GraphicType = RECORD
  width: BYTE;
  height: WORD;
  chain: BYTE;
 END; (* GraphicType *)

 NcsType = RECORD
  font_size: WORD;
  kind: BYTE;
 END; (* NcsType *)

 RulerType = RECORD
  left, right: WORD;
  tab: ARRAY [1..8] OF WORD;
  indent: WORD;
  form: BYTE;
  color: BYTE;
  __unused: WORD;
 END;

VAR
 style: TEXT_TYPE; version: BYTE;
  (* kind of document *)
 max_chain: ShortInt;
  (* chain range *)
 do_verbose: BOOLEAN;
  (* verbose output? *)

FUNCTION last_chain: ShortInt;
BEGIN
 last_chain := max_chain;
END; (* last_chain *)

PROCEDURE get_type(VAR style: TEXT_TYPE; VAR version: BYTE);
 VAR base: STRING;
BEGIN
 cvt_class_version(base, version);
 IF base = 'Write Image' THEN
  style := WRITE_DOC
 ELSE IF base = 'text album' THEN
   style := TEXT_ALBUM
 ELSE IF base = 'Text  Scrap' THEN
   style := TEXT_SCRAP
 ELSE IF base = 'Notes' THEN
  style := NOTES
 ELSE
  style := NO_TEXT;
END; (* get_type *)

PROCEDURE DoGraphicEscape;
 VAR pic: GraphicType; result: WORD;
  line: STRING;
BEGIN
 cvt_read(pic, SizeOf(pic), result);
 IF result <> SizeOf(pic) THEN FATAL('bad graphic escape');
 WITH pic DO BEGIN
  line := '### photo scrap $'+HexStr(chain,2);
  line := line+' ['+long2str(8*width,0)+'x'+long2str(height,0)+']';
  buf_break(line);
 END; (* with *)
END; (* DoGraphicEscape *)

PROCEDURE DoNewCardSet;
 VAR ncs: NcsType; result: WORD;
  line: STRING;
BEGIN
 cvt_read(ncs, SizeOf(ncs), result);
 IF result <> SizeOf(ncs) THEN FATAL('bad NEWCARDSET');
 WITH ncs DO BEGIN
  SetFontCoding(font_size SHR 6);
  IF do_verbose THEN BEGIN
   line := '### NEWCARDSET '+font_name;
   line := line + '['+long2str(font_size AND $3F,0)+']';
   IF kind AND $80 <> 0 THEN line := line + ' underline';
   IF kind AND $40 <> 0 THEN line := line + ' bold';
   IF kind AND $20 <> 0 THEN line := line + ' reverse';
   IF kind AND $10 <> 0 THEN line := line + ' italics';
   IF kind AND $08 <> 0 THEN line := line + ' outline';
   IF version = 2 THEN BEGIN
    IF kind AND $04 <> 0 THEN line := line + ' superscript';
    IF kind AND $40 <> 0 THEN line := line + ' subscript';
   END; (* if *)
   buf_break(line);
  END; (* if *)
 END; (* with *)
END; (* DoNewCardSet *)

FUNCTION adjust(l: LongInt): LongInt;
BEGIN
 adjust := (DEFAULT_LINE*l) DIV 480;
END; (* adjust *)

PROCEDURE DoRuler(VAR ruler: RulerType);
 VAR i: BYTE;
BEGIN
 WITH ruler DO BEGIN
  buf_margin(adjust(left), adjust(indent), adjust(right), form AND $03);
  FOR i := 1 TO 8 DO
   buf_set_tab(adjust(tab[i]));
  buf_line_space(1+ORD((form AND $18) <> 0));
 END; (* with *)
END; (* DoRuler *)

PROCEDURE DoRulerEscape;
 VAR ruler: RulerType; result: WORD;
  line: STRING; i: BYTE;
BEGIN
 cvt_read(ruler, SizeOf(ruler), result);
 IF result <> SizeOf(ruler) THEN FATAL('bad ruler escape');
 IF do_verbose THEN
  WITH ruler DO BEGIN
   line := '###RULER [ '+long2str(left,0)+' '+long2str(left+indent,0)+' | ';
   FOR i := 1 TO 8 DO BEGIN
    line := line + long2str(tab[i] AND $7FFF,0);
    IF tab[i] AND $8000 <> 0 THEN line := line + 'd';
    tab[i] := tab[i] AND $7FFF;
    line := line + ' ';
   END; (* for *)
   buf_break(line+'| '+long2str(right,0)+' ]');
   line := '###RULER';
   CASE form AND $03 OF
    $00: line := line + ' flushleft';
    $01: line := line + ' center';
    $02: line := line + ' flushright';
    $03: line := line + ' block';
   END; (* case *)
   line := line+'  line space: '+real2str(1.0+((form SHR 2) AND $03)/2,3,1);
   line := line+'  color: $'+HexStr(color,2);
   buf_break(line+'  reserved: $'+HexStr(__unused,4));
  END; (* with *)
 DoRuler(ruler);
END; (* DoRulerEscape *)

PROCEDURE DoWriteHeader;
 VAR header: RulerType; result: WORD;
  line: STRING; i: BYTE;
BEGIN
 FillChar(header, SizeOf(header), 0);
 cvt_read(header, 20, result);
 IF result <> 20 THEN FATAL('no write image header');
 IF do_verbose THEN
  WITH header DO BEGIN
   line := '### [ '+long2str(left,0)+' | ';
   FOR i := 1 TO 8 DO line := line + long2str(tab[i],0) + ' ';
   buf_break(line+'| '+long2str(right,0)+' ]');
  END; (* with *)
 DoRuler(header);
END; (* DoWriteHeader *)

PROCEDURE DoPage;
 VAR ch: CHAR;
BEGIN
 WHILE cvt_getch(ch) DO BEGIN
  CASE ch OF
   #$00, #$01:
     IF cvt_eof THEN
      IF do_verbose THEN buf_break('### new page') ELSE buf_break('')
     ELSE
      buf_add(TransChr(ch));
   #$09:
     buf_tab;
   #$0D:
     BEGIN
      buf_nl;
      buf_indent;
     END;
   #$10:
     DoGraphicEscape;
   #$11:
     IF version > 1 THEN
      DoRulerEscape
     ELSE
      buf_add(TransChr(ch));
   #$17:
     DoNewCardSet;
   ELSE
     buf_add(TransChr(ch));
  END; (* case *)
 END; (* while *)
END; (* DoPage *)

PROCEDURE DoWritePage(chain: BYTE);
BEGIN
 IF do_verbose THEN
  buf_break('### page '+long2str(chain+1,0));
 IF version < 2 THEN DoWriteHeader;
 DoPage;
END; (* DoWritePage *)

PROCEDURE DoScrapHeader(chain: BYTE);
 VAR h_size, result: WORD; i: LongInt;
BEGIN
 cvt_read(h_size, SizeOf(h_size), result);
 IF result <> SizeOf(h_size) THEN FATAL('no scrap header');
 INC(h_size, 2);
 IF cvt_size(chain) <> h_size THEN BEGIN
  IF do_verbose THEN
   buf_break('### '+long2str(cvt_size(chain),0)+' <> '+long2str(h_size,0));
  cvt_resize(h_size);
 END; (* if *)
 buf_margin(0,0,0,0);
 FOR i := 1 TO 8 DO
  buf_set_tab((DEFAULT_LINE*i) DIV 10);
END; (* DoScrapHeader *)

PROCEDURE WriteScrap(chain: BYTE);
BEGIN
 IF style = TEXT_ALBUM THEN
  buf_break('### scrap '+long2str(chain+1,0));
 DoScrapHeader(chain);
 DoPage;
END; (* BeginScrap *)

PROCEDURE WriteNote(chain: BYTE);
 VAR ch: CHAR; line: STRING;
BEGIN
 buf_margin(0,0,0,0);
 buf_break('### note '+long2str(chain+1,0));
 WHILE cvt_getch(ch) DO
  IF ch = #13 THEN
   buf_nl
  ELSE IF ch <> #0 THEN
   buf_add(TransStr(ch))
  ELSE BEGIN
   buf_break('');
   EXIT;
  END; (* else *)
 buf_break('');
END; (* WriteNote *)

PROCEDURE text_page(chain: BYTE);
BEGIN
 IF chain > max_chain THEN EXIT;
 IF cvt_size(chain) < 0 THEN EXIT;
 cvt_chain(chain);
 CASE style OF
  WRITE_DOC: DoWritePage(chain);
  TEXT_SCRAP,
  TEXT_ALBUM: WriteScrap(chain);
  NOTES: WriteNote(chain);
  ELSE FATAL('INTERN [text_page without text]');
 END; (* case *)
END; (* text_page *)

PROCEDURE open_text(fname: STRING; verbose: BOOLEAN);
BEGIN
 get_type(style, version);
 IF style = NO_TEXT THEN FATAL('no text file');
 WITH info[style] DO BEGIN
  IF (version < min) THEN FATAL('unsupported text version');
  IF (version > max) THEN FATAL('unsupported text version');
  buf_open(fname);
  IF verbose THEN
   buf_break('### '+name+' V'+real2str(version/10,3,1)+': '+cvt_name);
  version := version DIV 10;
  max_chain := chain;
  IF (style = WRITE_DOC) AND (version = 2) THEN Inc(max_chain, 2);
  do_verbose := verbose;
 END; (* with *)
END; (* open_text *)

PROCEDURE close_text;
BEGIN
 buf_break('');
 IF do_verbose THEN
  buf_break('### End of '+info[style].name);
 buf_close;
END; (* close_text *)

BEGIN
 style := NO_TEXT;
 max_chain := -1;
 do_verbose := TRUE;
END. (* texts *)