(* PAINT.PAS -- translate geoPaint graphics
** 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 Paint;

INTERFACE

USES Crt, Graph, graphic, global, errors, cvt, pcx;

CONST
 DEFAULT_COLOR = $BF;
  (* dark gray on lt grey *)
 ERROR_COLOR = $A6;
  (* lt red on blue *)


FUNCTION IsPaint: BOOLEAN;
(* is it a geoPaint document *)

PROCEDURE DoPaint(pcx_name: STRING; view, wait_key: BOOLEAN; b_level: BYTE);
(* do translation *)

IMPLEMENTATION

CONST
 PatSize = 2*80*8;
 NulSize = 8;
 ColSize = 2*80;
 FrmSize = PatSize + NulSize + ColSize;
 ErrSize = 2*Patsize;
 MaxSize = ErrSize + 1024;

TYPE
 PaintPartType = RECORD
  size: WORD;
  CASE INTEGER OF
   0: (raw: ARRAY [0..MaxSize]   OF BYTE);
   1: (pattern: ARRAY [0..1, 0..79, 0..7] OF BYTE;
       gap: ARRAY [0..NulSize-1] OF BYTE;
       color: ARRAY [0..1, 0..79] OF BYTE);
   2: (error: ARRAY [0..3, 0..79, 0..7] OF BYTE);
  END; (* PaintPartType *)

 BitMapType = RECORD
   width, height: WORD;
   data: ARRAY [0..31, 0..3, 0..79] OF BYTE;
   __res: WORD;
  END; (* BitMapType *)

VAR
 chain: BYTE;
  (* used chain *)
 pp: ^PaintPartType;
  (* paint part *)
 err_cp, err_pp: LongInt; err_why: STRING;
  (* errors from GetPaintPart() *)
 bm: ^BitMapType;
  (* bit map *)
 y0: LongInt;
  (* y coordiante of bit image *)

FUNCTION IsPaint: BOOLEAN;
 VAR class: STRING; version: BYTE;
BEGIN
 IsPaint := FALSE;
 cvt_class_version(class, version);
 IF class <> 'Paint Image' THEN EXIT;
 IF (version DIV 10) <> 1  THEN EXIT;
 IsPaint := TRUE;
END; (* IsPaint *)

PROCEDURE GetPaintPart;
(* get paint part from selected chain *)
 VAR counter, i: BYTE; result: WORD;
  pattern: ARRAY [0..7] OF BYTE;
BEGIN
 err_cp := -1;
 err_pp := -1;
 err_why := '';
 WITH pp^ DO BEGIN
  size := 0;
  FillChar(pattern, SizeOf(pattern), 0);
  FillChar(gap, SizeOf(gap), 0);
  FillChar(color, SizeOf(color), DEFAULT_COLOR);
 END; (* with *)
 cvt_seek(0);
 IF cvt_eof THEN BEGIN
  (* empty chain *)
  pp^.size := FrmSize;
  EXIT;
 END; (* if *)
 WHILE cvt_getch(CHAR(counter)) DO BEGIN
  CASE counter OF
   $00..$40: BEGIN
     (* individual bytes *)
     IF (counter = 0) AND NOT cvt_eof THEN
      IF err_why = '' THEN BEGIN
       err_cp := cvt_pos - 1;
       err_pp := pp^.size;
       err_why := 'ind[0] at ' + long2str(err_cp,0);
       err_why := err_why + ' in #' + long2str(chain,0);
      END; (* if *)
     cvt_read(pp^.raw[pp^.size], counter, result);
     INC(pp^.size, result);
     IF result <> counter THEN BEGIN
      IF err_why = '' THEN
       err_why := '#'+long2str(chain,0)+' too short';
      EXIT;
     END; (* if *)
    END;
   $41..$7F: BEGIN
     (* fill patterns *)
     counter := counter AND $3F;
     cvt_read(pattern, SizeOf(pattern), result);
     IF result <> SizeOf(pattern) THEN BEGIN
      IF err_why = '' THEN
       err_why := '#'+long2str(chain,0)+' too short';
      EXIT;
     END; (* if *)
     WHILE counter > 0 DO BEGIN
      Move(pattern, pp^.raw[pp^.size], SizeOf(pattern));
      Inc(pp^.size, SizeOf(pattern));
      Dec(counter);
     END; (* for *)
    END;
   $80..$FF: BEGIN
     (* repeat *)
     counter := counter AND $7F;
     IF (counter = 0) AND (err_why <> '') THEN BEGIN
      err_cp := cvt_pos - 1;
      err_pp := pp^.size;
      err_why := 'rep[0] at ' + long2str(err_cp,0);
      err_why := err_why + ' in #' +long2str(chain,0);
     END; (* if *)
     IF NOT cvt_getch(CHAR(pattern[0])) THEN BEGIN
      IF err_why = '' THEN
       err_why := '#'+long2str(chain,0)+' too short';
      EXIT;
     END; (* if *)
     FillChar(pp^.raw[pp^.size], counter, pattern[0]);
     Inc(pp^.size, counter);
    END;
  END; (* case *)
  IF pp^.size > ErrSize THEN BEGIN
   IF err_why = '' THEN
    err_why := '#'+long2str(chain,0)+' too long';
   EXIT;
  END; (* if *)
 END; (* while *)
 IF err_why = '' THEN
  IF pp^.size = PatSize THEN
   pp^.size := FrmSize (* black/white *)
  ELSE IF pp^.size <> FrmSize THEN
   err_why := '#'+long2str(chain,0)+' has wrong size'
  ELSE
   FOR i := 0 TO 7 DO
    IF pp^.gap[i] <> 0 THEN BEGIN
     err_why := 'gap not null in #'+long2str(chain,0);
     EXIT;
    END (* if *)
END; (* GetPaintPart *)

PROCEDURE paint2bitmap;
(* convert geoPaint part pp to bit map BM *)
 VAR line, column, row, color, a, b, plain: BYTE;
  pp_pos: LongInt;
BEGIN
 IF pp^.size = FrmSize THEN
  BEGIN
   bm^.width := 639;
   bm^.height := 15;
   FOR line := 0 TO 1 DO
    FOR column := 0 TO 79 DO BEGIN
     color := pp^.color[line,column];
     FOR plain := 0 TO 3 DO BEGIN
      CASE color AND $88 OF
       $00: BEGIN a := $00; b := $00; END;
       $08: BEGIN a := $FF; b := $FF; END;
       $80: BEGIN a := $FF; b := $00; END;
       $88: BEGIN a := $00; b := $FF; END;
      END; (* case *)
      FOR row := 0 TO 7 DO
       bm^.data[8*line+row,plain,column] :=
         (pp^.pattern[line,column,row] AND a) XOR b;
      color := (color AND $77) SHL 1;
      END; (* for *)
     END; (* for *)
  END
 ELSE (* pp^.size <> FrmSize *)
  BEGIN
   bm^.width := 639;
   bm^.height :=  31;
   IF err_pp < 0 THEN BEGIN
    err_pp := pp^.size;
    IF err_pp > 1280 THEN err_pp := 1280;
   END; (* if *)
   pp_pos := 0;
   FOR line := 0 TO 3 DO
    FOR column := 0 TO 79 DO
     FOR row := 0 TO 7 DO BEGIN
      IF pp_pos < err_pp THEN
       color := DEFAULT_COLOR
      ELSE IF pp_pos < pp^.size THEN
       color := ERROR_COLOR
      ELSE
       color := $00;
      INC(pp_pos);
      FOR plain := 0 TO 3 DO BEGIN
       CASE color AND $88 OF
        $00: bm^.data[8*line+row,plain,column] := $00;
        $08: bm^.data[8*line+row,plain,column] := NOT pp^.error[line,column,row];
        $80: bm^.data[8*line+row,plain,column] := pp^.error[line,column,row];
        $88: bm^.data[8*line+row,plain,column] := $FF;
       END; (* case *)
       color := (color AND $77) SHL 1;
      END; (* for *)
     END; (* for *)
  END; (* else *)
END; (* paint2bitmap *)

FUNCTION ReadChar: CHAR;
(* ReadKey w/o special keys *)
 VAR ch, dummy: CHAR;
BEGIN
 REPEAT
  ch := ReadKey;
  IF ch = #0 THEN dummy := ReadKey;
 UNTIL ch <> #0;
 ReadChar := ch;
END; (* ReadChar *)

PROCEDURE GetLevel(VAR level: BYTE);
(* input forced level *)
 VAR ch: CHAR;
BEGIN
 TextOut('Level: <0> back  <1> stop  <2> continue  <3> continue b/w');
 REPEAT
  ch := ReadChar;
 UNTIL ch in ['0'..'3'];
 level := ORD(ch) - ORD('0');
END; (* GetLevel *)

PROCEDURE CorrectByte(chain_pos: LongInt; b: BYTE);
(* change byte in chain and recycle images *)
BEGIN
 cvt_buffer^[chain_pos] := b;
 GetPaintPart;
 paint2bitmap;
 PutImage(0, y0, bm^, NormalPut);
 IF bm^.height = 15 THEN BEGIN
  SetFillStyle(SolidFill, 0);
  Bar(0, y0+16, VGA_MAXX, y0+31);
 END; (* if *)
END; (* CorrectByte *)

PROCEDURE CorrectNext(chain_pos: LongInt; VAR value: BYTE);
(* try to find right byte for correction *)
 VAR count: LongInt; step: BYTE;
BEGIN
 step := 0;
 REPEAT
  (* increment value *)
  INC(value);
  (* set up paint *)
  cvt_buffer^[chain_pos] := value;
  GetPaintPart;
  TextOut('CORRECT: $'+HexStr(value,2));
  (* `fast calculation' *)
  CASE value OF
   $00..$40: (* individual bytes *)
    IF pp^.size = FrmSize THEN BEGIN
     CorrectByte(chain_pos, value);
     EXIT;
    END; (* else *)
   $41..$7F: BEGIN (* fill patterns *)
     count := PatSize - LongInt(pp^.size);
     IF count < 0 THEN count := FrmSize - LongInt(pp^.size);
     IF count < 0 THEN
      value := $7F (* overflow *)
     ELSE IF count MOD 8 <> 0 THEN
      value := $7f (* odd number *)
     ELSE BEGIN
      count := value + count DIV 8;
      IF count > $7F THEN
       value := $7F
      ELSE BEGIN
       value := count;
       CorrectByte(chain_pos, value);
       EXIT;
      END; (* else *)
     END; (* else *)
    END;
   $80..$FF: BEGIN (* repeat *)
     count := PatSize - LongInt(pp^.size);
     IF count < 0 THEN count := FrmSize - LongInt(pp^.size);
     IF count < 0 THEN
      value := $FF (* overflow *)
     ELSE BEGIN
      count := value + count;
      IF count > $FF THEN
       value := $FF
      ELSE BEGIN
       value := count;
       CorrectByte(chain_pos, value);
       EXIT;
      END; (* else *)
     END; (* else *)
    END;
  END; (* case *)
  IF (value = $40) OR (value = $7F) OR (value = $FF) THEN
   INC(step);
 UNTIL step > 3;
END; (* CorrectNext *)

PROCEDURE CorrectPos(chain_pos: LongInt);
(* correct menue *)
 VAR b, b0: BYTE; ch: CHAR;
BEGIN
 b0 := cvt_buffer^[chain_pos];
 IF b0 <> 0 THEN b := b0 ELSE b := $41;
 CorrectNext(chain_pos, b);
 WHILE TRUE DO BEGIN
  TextOut('CORRECT: <c>orrect  <+>1  <->1  <*>+16  </>-16  '+
          '<d>one  <u>ndo  ['+HexStr(b,2)+']  size='+long2str(pp^.size,4));
  REPEAT
   ch := UpCase(ReadChar);
  UNTIL ch IN ['C', '+', '-', '*', '/', 'D', 'U'];
  CASE ch OF
   'C': (* next *)
     CorrectNext(chain_pos, b);
   'U': BEGIN (* undo *)
     CorrectByte(chain_pos, b0);
     EXIT;
    END;
   'D': EXIT; (* done *)
   '+': BEGIN (* +1 *)
     INC(b);
     CorrectByte(chain_pos, b);
    END;
   '*': BEGIN (* +16 *)
     INC(b, 16);
     CorrectByte(chain_pos, b);
    END;
   '-': BEGIN (* -1 *)
     DEC(b);
     CorrectByte(chain_pos, b);
    END;
   '/': BEGIN (* -16 *)
     DEC(b, 16);
     CorrectByte(chain_pos, b);
    END;
  END; (* case *)
 END; (* while *)
END; (* CorrectPos *)

PROCEDURE DoCorrection(VAR level: BYTE);
 VAR ch: CHAR;
BEGIN
 ch := 'E';
 REPEAT
  CASE ch OF
   '?':
    TextOut('<c>orrect  <g>ap  <l>evel  <e>rror  <d>one');
   'E':
    IF err_why <> '' THEN
     TextOut('CORRECT: '+err_why+'  [Press ''?'' for menue]')
    ELSE
     TextOut('CORRECT: no reason  [Press ''?'' for menue]');
   'L': BEGIN
     GetLevel(level);
     IF level <> 0 THEN EXIT;
     level := 4;
      TextOut('<c>orrect  <g>ap  <l>evel  <e>rror  <d>one');
     END;
   'G':
    IF pp^.size = FrmSize THEN BEGIN
     FillChar(pp^.gap, SizeOf(pp^.gap), 0);
     level := 0;
     EXIT;
    END; (* if *)
   'C':
    IF err_cp < 0 THEN
     TextOut('ERROR: no error file position found  [Press ''?'' for menu]')
    ELSE BEGIN
     CorrectPos(err_cp);
     TextOut('<c>orrect  <g>ap  <l>evel  <e>rror  <o>k');
    END; (* else *)
  END; (* case *)
  ch := UpCase(ReadChar);
 UNTIL ch = 'D';
END; (* DoCorrection *)

FUNCTION get_max_used_chain: BYTE;
(* get max. used chain *)
 VAR chain: BYTE;
BEGIN
 FOR chain := 126 DOWNTO 0 DO
  IF cvt_size(chain) >= 0 THEN BEGIN
   get_max_used_chain := chain;
   EXIT;
  END; (* if *)
 FATAL('empty painting');
END; (* get_max_used_chain *)

PROCEDURE open_paint(pcx_name: STRING; view: BOOLEAN);
(* open for output *)
BEGIN
 IF view THEN
  BEGIN
   OpenGraphic(CBMcp);
   TextOut(cvt_name);
  END
 ELSE
  Write(cvt_name,' ');
 IF pcx_name <> '' THEN
  pcx_open(pcx_name, CBMcp, VGA_MAXX+1);
END; (* open_paint *)

PROCEDURE close_paint(pcx_name: STRING; do_view, wait_key: BOOLEAN);
(* close output *)
BEGIN
 IF pcx_name <> '' THEN
  pcx_close;
 IF do_view
  THEN CloseGraphic(wait_key)
  ELSE WriteLn;
END; (* close_paint *)

PROCEDURE prepare_line;
 VAR dy: LongInt;
BEGIN
 INC(y0, 16);
 IF y0 > VGA_MAXY-50 THEN BEGIN
  dy := y0 DIV 2;
  ScrollUp(0, 0, VGA_MAXX, y0, dy);
  DEC(y0, dy);
 END; (* if *)
END; (* prepare_line *)

PROCEDURE DoPaint(pcx_name: STRING; view, wait_key: BOOLEAN; b_level: BYTE);
 VAR level: BYTE;
BEGIN
 IF b_level = 0 THEN
  b_level := 1;
 IF b_level >= 4 THEN
  b_level := 3 + ORD(view);
 open_paint(pcx_name, view);
 y0 := -16; New(pp); New(bm);
 FOR chain := 0 TO get_max_used_chain DO BEGIN
  cvt_chain(chain);
  IF view THEN prepare_line ELSE Write('.');
  REPEAT
   GetPaintPart;
   level := b_level * ORD(err_why <> '');
   IF view AND (level > 0) THEN BEGIN
    paint2bitmap;
    PutImage(0, y0, bm^, NormalPut);
    IF level = 4 THEN BEGIN
     DoCorrection(level);
     TextOut(cvt_name);
    END; (* if *)
   END; (* if *)
  UNTIL level <> 4;
  IF err_why = '' THEN err_why := '<UNKNOWN>';
  paint2bitmap;
  IF view THEN PutImage(0, y0, bm^, NormalPut);
  IF level = 2 THEN BEGIN
   IF view THEN TextOut('*** '+err_why);
   bm^.height := 15;
  END; (* if *)
  IF level = 3 THEN BEGIN
   IF view THEN TextOut('*** '+err_why);
   pp^.size := FrmSize;
   paint2bitmap;
  END; (* if *)
  IF pcx_name <> '' THEN pcx_image(bm^);
  IF level = 1 THEN BEGIN
   IF pcx_name <> '' THEN pcx_close;
   G_FATAL(err_why);
  END; (* if *)
 END; (* for *)
 close_paint(pcx_name, view, wait_key);
END; (* DoPaint *)

END. (* Paint *)