(* PHOTO.PAS -- translate photo scrap/album
** 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 Photo;

INTERFACE

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

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

FUNCTION IsPhotoScrap: BOOLEAN;
(* is it a Photo Scrap *)

FUNCTION IsPhotoAlbum: BOOLEAN;
(* is it a Photo Scrap *)

FUNCTION IsWrite: BOOLEAN;
(* is it a geoWrite image *)

PROCEDURE OpenScrap(view, wait_key: BOOLEAN; level: BYTE);
(* init translation *)

PROCEDURE DoScrap(chain: BYTE; pcx_name: STRING);
(* do translation for a chain *)

PROCEDURE CloseScrap;
(* close translation *)

IMPLEMENTATION

CONST
 MAX_SCRAP_X = 320;
 MAX_SCRAP_Y = 200;
 MAX_SCRAP_SIZE = (MAX_SCRAP_X DIV 8)*(MAX_SCRAP_Y + (MAX_SCRAP_Y DIV 8));

TYPE
 ScrapType = RECORD
  width_8: BYTE; height: WORD;
  data: ARRAY [0..MAX_SCRAP_SIZE+128] OF BYTE;
  size, width, color, dim_size: WORD;
 END;

 BitMapType = RECORD
  width, height: INTEGER;
  data: ARRAY [0..8*4*40] OF BYTE;
  __res: WORD;
 END; (* BitMapType *)

VAR
 the_chain: BYTE;
  (* used chain *)
 scrap: ^ScrapType;
  (* decompressed scrap *)
 err_cp, err_sp: LongInt; err_why: STRING;
  (* errors from GetScrap() *)
 bm: ^BitMapType;
  (* bit map *)
 do_view, do_wait_key: BOOLEAN;
  (* graphical output?, wait key? *)
 the_level: BYTE;
  (* level of error recovery *)

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

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

FUNCTION IsWrite: BOOLEAN;
 VAR class: STRING; version: BYTE;
BEGIN
 IsWrite := FALSE;
 cvt_class_version(class, version);
 IF class <> 'Write Image' THEN EXIT;
 IF (version < 10) OR (30 <= version)  THEN EXIT;
 IsWrite := TRUE;
END; (* IsWrite *)

PROCEDURE GetScrap;
 VAR result: WORD;
  count: BYTE; ch: CHAR;
  n_count: BYTE; n_begin, n_end: LongInt;

 FUNCTION next(VAR ch: CHAR): BOOLEAN;
 (* getchar() with `buffer' *)
 BEGIN
  next := cvt_getch(ch);
  IF n_count > 0 THEN
   IF cvt_pos = n_end THEN BEGIN
    DEC(n_count);
    cvt_seek(n_begin);
   END; (* if *)
 END; (* next *)

BEGIN (* GetScrap *)
 err_cp := -1;
 err_sp := -1;
 err_why := '';
 FillChar(scrap^, SizeOf(scrap^), 0);
 WITH scrap^ DO BEGIN
  cvt_seek(0);
  cvt_read(width_8, 1, result);
  IF result <> 1 THEN BEGIN
   err_why := '$'+HexStr(the_chain,2)+' too short';
   EXIT;
  END; (* if *)
  IF width_8 = 0 THEN BEGIN
   err_why := '$'+HexStr(the_chain,2)+' has no width';
   EXIT;
  END; (* if *)
  width := 8*width_8;
  IF width > MAX_SCRAP_X  THEN BEGIN
   err_why := '$'+HexStr(the_chain,2)+' too wide';
   EXIT;
  END; (* if *)
  cvt_read(height, 2, result);
  IF result <> 2 THEN BEGIN
   err_why := '$'+HexStr(the_chain,2)+' too short';
   EXIT;
  END; (* if *)
  IF height > MAX_SCRAP_Y THEN BEGIN
   err_why := '$'+HexStr(the_chain,2)+' too high';
   EXIT;
  END; (* if *)
  size := 0;
  width := 8*width_8;
  color := width_8*height;
  dim_size := (color + color DIV 8);
  n_count := 0;
  WHILE next(CHAR(count)) DO BEGIN
   CASE count OF
    $00..$7F:
     BEGIN (* repeat *)
      IF count = 0 THEN BEGIN
       err_cp := cvt_pos - 1;
       err_sp := size;
       err_why := 'rep[0] at '+long2str(err_cp,0)+' in $'+HexStr(the_chain,2);
      END; (* if *)
      IF NOT next(ch) THEN BEGIN
       IF err_why = '' THEN
        err_why := '$'+HexStr(the_chain,2)+' too short';
       EXIT;
      END; (* if *)
      FillChar(data[size], count, ch);
      Inc(size, count);
     END;
    $80..$DC:
     BEGIN (* individual bytes *)
      DEC(count, 128);
      IF count = 0 THEN
       IF err_why = '' THEN BEGIN
        err_cp := cvt_pos - 1;
        err_sp := size;
        err_why := 'ind[0] at '+long2str(err_cp,0)+' in $'+HexStr(the_chain,2);
       END; (* if *)
      WHILE count > 0 DO BEGIN
       IF NOT next(CHAR(data[size])) THEN BEGIN
        IF err_why = '' THEN
         err_why := '$'+HexStr(the_chain,2)+' too short';
        EXIT;
       END; (* if *)
       INC(size);
       DEC(count);
      END; (* while *)
     END;
    $DD..$FF:
     BEGIN (* compress *)
      IF n_count > 0 THEN BEGIN
       IF err_why = '' THEN
        err_why := 'com[] within compression in $'+HexStr(the_chain,2);
       EXIT;
      END; (* if *)
      DEC(count, 219);
      IF NOT cvt_getch(CHAR(n_count)) THEN BEGIN
       err_why := '$'+HexStr(the_chain,2)+' too short';
       EXIT;
      END; (* if *)
      IF n_count = 0 THEN
       IF err_why = '' THEN BEGIN
        err_cp := cvt_pos - 1;
        err_sp := size;
        err_why := 'com[0] at '+long2str(err_cp,0)+' in $'+HexStr(the_chain,2);
       END; (* if *)
      n_begin := cvt_pos;
      n_end := n_begin + n_count;
     END;
   END; (* case *)
   IF size > MAX_SCRAP_SIZE THEN BEGIN
    IF err_why = '' THEN
     err_why := '$'+HexStr(the_chain,2)+' too long';
    EXIT;
   END; (* if *)
  END; (* while *)
  IF err_why = '' THEN
   IF size <> dim_size THEN
    err_why := '$'+HexStr(the_chain,2)+' has wrong size';
 END; (* with *)
END; (* GetScrap *)

PROCEDURE scrap2bitmap(line: BYTE);
(* convert scrap to bm *)
 VAR column, row, color, a, b, plain: BYTE;
  s_pos, ss_pos, c_pos, bm_pos: WORD;
BEGIN
 bm^.width  := scrap^.width-1;
 bm^.height := 7;
 FillChar(bm^.data, SizeOf(bm^.data), 0);
 s_pos := 8*scrap^.width_8*line;
 IF scrap^.size = scrap^.dim_size THEN
  BEGIN
   c_pos := scrap^.color + (s_pos DIV 8);
   FOR column := 0 TO scrap^.width_8-1 DO BEGIN
    color := scrap^.data[c_pos];
    INC(c_pos);
    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 *)
     bm_pos := scrap^.width_8*plain + column;
     ss_pos := s_pos;
     FOR row := 0 TO 7 DO BEGIN
      bm^.data[bm_pos] := (scrap^.data[ss_pos] AND a) XOR b;
      INC(bm_pos, 4*scrap^.width_8);
      INC(ss_pos, scrap^.width_8);
     END; (* for *)
     color := (color AND $77) SHL 1;
    END; (* for *)
    INC(s_pos);
   END; (* for *)
   IF line = scrap^.height DIV 8 THEN
    bm^.height := scrap^.height AND $07;
  END
 ELSE (* scrap^.size = scrap^.dim_size *)
  FOR row := 0 TO 7 DO
   FOR column := 0 TO scrap^.width_8-1 DO BEGIN
    IF s_pos < err_sp THEN
     color := DEFAULT_COLOR
    ELSE IF s_pos < scrap^.size THEN
     color := ERROR_COLOR
    ELSE
     color := $00;
    bm_pos := 4*row*scrap^.width_8+column;
    FOR plain := 0 TO 3 DO BEGIN
     CASE color AND $88 OF
      $00: bm^.data[bm_pos] := $00;
      $08: bm^.data[bm_pos] := NOT scrap^.data[s_pos];
      $80: bm^.data[bm_pos] := scrap^.data[s_pos];
      $88: bm^.data[bm_pos] := $FF;
     END; (* case *)
     color := (color AND $77) SHL 1;
     INC(bm_pos, scrap^.width_8);
    END; (* for *)
    INC(s_pos);
   END; (* for *)
END; (* scrap2bitmap *)

PROCEDURE ViewScrap;
 VAR y_max, line: WORD;
BEGIN
 ClearDevice;
 IF err_sp < 0 THEN
  err_sp := scrap^.size;
 IF err_sp > scrap^.size THEN
  err_sp := scrap^.size;
 y_max := scrap^.size DIV scrap^.width_8;
 IF y_max > VGA_MAXY-10 THEN
  y_max := VGA_MAXY-10;
 FOR line := 0 TO y_max DIV 8 DO BEGIN
  scrap2bitmap(line);
  PutImage(0, 8*line, bm^, NormalPut);
 END; (* for *)
 TextOut(cvt_name+' $'+HexStr(the_chain,2));
END; (* ViewScrap *)

FUNCTION ReadChar: CHAR;
 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;
 GetScrap;
END; (* CorrectByte *)

PROCEDURE CorrectNext(chain_pos: LongInt; VAR value: BYTE);
(* try to find right byte for correction *)
 VAR value0: BYTE;
BEGIN
 value0 := value;
 REPEAT
  (* increment value *)
  INC(value);
  TextOut('CORRECT: $'+HexStr(value,2));
  (* new scrap  *)
  CorrectByte(chain_pos, value);
  IF scrap^.size = scrap^.dim_size THEN BEGIN
   ViewScrap;
   EXIT;
  END; (* if *)
 UNTIL value = value0;
END; (* CorrectNext *)

PROCEDURE CorrectPos(chain_pos: LongInt);
(* correct menue *)
 VAR b, b0: BYTE; ch: CHAR;
BEGIN
 b0 := cvt_buffer^[chain_pos];
 b := b0;
 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(scrap^.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);
     ViewScrap;
     EXIT;
    END;
   'D': EXIT; (* done *)
   '+': BEGIN (* +1 *)
     INC(b);
     CorrectByte(chain_pos, b);
     ViewScrap;
    END;
   '*': BEGIN (* +16 *)
     INC(b, 16);
     CorrectByte(chain_pos, b);
     ViewScrap;
    END;
   '-': BEGIN (* -1 *)
     DEC(b);
     CorrectByte(chain_pos, b);
     ViewScrap;
    END;
   '/': BEGIN (* -16 *)
     DEC(b, 16);
     CorrectByte(chain_pos, b);
     ViewScrap;
    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  <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  <l>evel  <e>rror  <d>one');
     END;
   'C':
    IF err_cp < 0 THEN
     TextOut('ERROR: no error file position found  [Press ''?'' for menu]')
    ELSE BEGIN
     CorrectPos(err_cp);
     TextOut('<c>orrect  <l>evel  <e>rror  <d>one');
    END; (* else *)
  END; (* case *)
  ch := UpCase(ReadChar);
 UNTIL ch = 'D';
END; (* DoCorrection *)

PROCEDURE OpenScrap(view, wait_key: BOOLEAN; level: BYTE);
BEGIN
 do_view := view;
 do_wait_key := wait_key;
 the_level := level;
 IF the_level = 0 THEN
  the_level := 1;
 IF the_level >= 4 THEN
  the_level := 3 + ORD(do_view);
 IF do_view THEN BEGIN
  OpenGraphic(CBMcp);
  TextOut(cvt_name);
 END; (* if *)
 New(scrap);
 New(bm);
END; (* OpenScrap *)

PROCEDURE CloseScrap;
BEGIN
 Dispose(bm);
 Dispose(scrap);
 IF do_view THEN
  CloseGraphic(FALSE);
END; (* CloseScrap *)

PROCEDURE DoScrap(chain: BYTE; pcx_name: STRING);
 VAR level: BYTE; line: WORD;
BEGIN
 IF do_view THEN
  TextOut(cvt_name+' $'+HexStr(chain,2));
 the_chain := chain;
 cvt_chain(chain);
 REPEAT
  GetScrap;
  level := the_level * ORD(err_why <> '');
  IF do_view THEN BEGIN
   ViewScrap;
   IF level > 0 THEN BEGIN
    IF level = 4 THEN DoCorrection(level);
    TextOut(cvt_name+' $'+HexStr(chain,2));
   END; (* if *)
  END; (* if *)
 UNTIL level <> 4;
 IF err_why = '' THEN err_why := '<UNKNOWN>';
 IF level = 1 THEN
  G_FATAL(err_why);
 IF (level = 2) AND do_view THEN
   TextOut('*** '+err_why);
 IF level = 3 THEN
  WITH scrap^ DO BEGIN
   size := width_8*(height + height DIV 8);
   FOR line := width_8 TO size-1 DO
    data[line] := DEFAULT_COLOR;
   IF do_view THEN BEGIN
    ViewScrap;
    TextOut('*** '+err_why);
   END; (* if *)
  END; (* with *)
 IF pcx_name <> '' THEN BEGIN
  pcx_open(pcx_name, CBMcp, 8*scrap^.width_8);
  FOR line := 0 TO (scrap^.size DIV scrap^.width_8) DIV 8 DO BEGIN
   scrap2bitmap(line);
   pcx_image(bm^);
  END; (* for *)
  pcx_close;
 END; (* if *)
 IF do_view AND do_wait_key THEN BEGIN
  IF level = 0 THEN TextOut(cvt_name+' $'+HexStr(chain,2)+' DONE');
  REPEAT UNTIL ReadKey <> #0;
 END; (* if *)
END; (* DoScrap *)

END. (* Photo *)