MODULE PZSplitExt EXPORTS Main;

(* Splits a PGM image of N fragments into N separate images. *)
(* Improved version of PZSPlit: does not generate images with holes. *)
(* Last edited on 2001-10-28 15:15:55 by stolfi *)

IMPORT ParseParams, Process, Wr, Thread, Stdio, Fmt;

IMPORT PZImage;
  
FROM Stdio IMPORT stderr;
FROM PZTypes IMPORT INT, NAT;
 
<* FATAL Wr.Failure, Thread.Alerted *>

TYPE
  Options = RECORD
    inFile: TEXT;       (* Input image name, without the ".pgm" extension *)
    outPrefix: TEXT;    (* Output image name prefix, without the ".pgm" extension *)
    startNum: NAT;      (* First fragment number *)
    sep: NAT;           (* Intensity value that separates bg from fg. *)
  END;

  IntPoint = ARRAY [0..1] OF INT;

  Pixels = ARRAY OF IntPoint;
  
PROCEDURE Main() =
  VAR image : REF PZImage.T;
  BEGIN
    WITH
      o = GetOptions()
    DO
      image := PZImage.ReadPGM(o.inFile);
      SplitPuzzle(o.outPrefix, o.startNum, image^, o.sep);
      Wr.PutText(stderr, " ok !! \n")
     END;
  END Main;

PROCEDURE SplitPuzzle(
    outPrefix: TEXT; 
    startNum: NAT; 
    VAR M: PZImage.T; 
    sep: NAT;
  ) =
  (* 
    Gets a PGM image "M" of a puzzle, identifies the pieces, and
    writes each piece to a separate file "outPrefix-0001.pgm",
    "outPrefix-0002.pgm", etc.
    
    The "background" of the input image is defined to be a 8-connected
    set of pixels with value less than or equal to "sep" that contains
    the upper left corner of the image.
    
    A "piece" is a 4-connected component of the complement of the
    background. The "border" of a piece consists of all pixels that
    are 4-adjacent to one of the piece's pixels.
    
    In the output files, the inside and border pixels are copied from
    the original image, while the surrounding background pixels are
    set to 0. *)
    
  CONST 
    MinImagePixels = 100; (* Ignore pieces with this perimeter or less *)
  VAR 
    s, f: NAT;
    nextImageNum: NAT := startNum;
  BEGIN
    WITH 
      MY = NUMBER(M),
      MX = NUMBER(M[0]),
      pix = NEW(REF Pixels, MX*MY)^,
      mark = NEW(REF ARRAY OF ARRAY OF BOOLEAN, MY, MX)^
    DO 

      PROCEDURE EnqueuePixel(y, x: NAT) = 
        (*
          If pixel "M[y,x]" is unmarked, appends it to the queue, and marks it. *)
        BEGIN 
          IF NOT mark[y,x] THEN 
            pix[f] := IntPoint{x, y};
            mark[y,x] := TRUE;
            INC(f)
          END
        END EnqueuePixel; 
        
      PROCEDURE EnqueueFirstBackgroundPixel() =
        (*
          Locates a bacground pixel near corner "M[0,0]",
          and inserts it into the queue. *)
        BEGIN
          FOR k := 0 TO MIN(MY,MX)-1 DO
            FOR y := 0 TO k DO
              WITH x = k - y DO
                IF M[y,x] <= sep THEN 
                  EnqueuePixel(y,x); RETURN 
                END
              END
            END
          END;
          <* ASSERT FALSE *> (* Could not find a background pixel. *)
        END EnqueueFirstBackgroundPixel;
      
      PROCEDURE PropagateBackground() =
        (*
          Repeatedly extracts from the queue a pixel with coordinates "(x,y)" that 
          is assumed to be part of the background. Finds all unmarked
          pixels that are 8-connected to it and have intensity "sep" or less,
          inserts them into the queue, and marks them. *)
        BEGIN
          WHILE  s < f DO 
            WITH 
              xp = pix[s][0],
              yp = pix[s][1]
            DO 
              <* ASSERT mark[yp,xp] *>
              <* ASSERT M[yp,xp] <= sep *>
              FOR dx := -1 TO +1 DO 
                FOR dy := -1 TO +1 DO
                  IF dx # 0 OR dy # 0 THEN 
                    WITH x = xp+dx, y = yp+dy DO
                      IF (x >= 0) AND (x < MX) AND (y >= 0) AND (y < MY) THEN
                        IF M[y,x] <= sep THEN EnqueuePixel(y,x) END
                      END
                    END
                  END
                END
              END
            END;
            INC(s);
          END;
        END PropagateBackground;  

      PROCEDURE PropagateForeground() =
        (*
          Repeatedly extracts from the queue a pixel with coordinates "(x,y)" that 
          is assumed to be part of the foreground. Finds all unmarked pixels that are
          4-connected to it and have value greater than "sep", and inserts them into
          the queue, marking them. *)
        BEGIN
          WHILE  s < f DO 
            WITH 
              x = pix[s][0],
              y = pix[s][1]
            DO 
              <* ASSERT mark[y,x] *>
              IF y > 0 THEN EnqueuePixel(y-1,x) END;                                        
              IF x > 0 THEN EnqueuePixel(y,x-1) END;      
              IF y < MY-1 THEN EnqueuePixel(y+1,x) END;   
              IF x < MX-1 THEN EnqueuePixel(y,x+1) END;
            END;
            INC(s);
          END;
        END PropagateForeground;  
      
      BEGIN
        (* First pass: clear all pixel marks. *)
        FOR y:=0 TO MY-1 DO 
          FOR x:=0 TO MX-1 DO  
            mark[y,x] := FALSE
          END
        END;
        
        (* Second pass: find all background pixels and set them to 0. *)
        f := 0; s := 0;
        EnqueueFirstBackgroundPixel();
        PropagateBackground();
        
        (* Third pass: find all pieces and extract them as separate images. *)
        FOR y := 0 TO MY-1 DO 
          FOR x := 0 TO MX-1 DO  
            IF NOT mark[y,x] THEN
              f := 0; s := 0;
              EnqueuePixel(y,x);
              PropagateForeground();
              IF f > MinImagePixels THEN
                WITH 
                  newImage = ExtractFragmentImage(M, SUBARRAY(pix, 0, f))
                DO
                  WriteFragmentImage(outPrefix, nextImageNum, newImage^)
                END;
                INC(nextImageNum)
              END
            END 
          END
        END
      END
    END   
  END SplitPuzzle;
  
PROCEDURE WriteFragmentImage( 
    fname: TEXT;
    imageNum: NAT; 
    READONLY P: PZImage.T;
  ) =
  BEGIN 
  (*
    Writes an image with the puzzle piece stored in "P". *)
     WITH
       name = fname & "-" & Fmt.Pad(Fmt.Int(imageNum), 4, '0')
     DO 
       Wr.PutText(stderr, name);
       Wr.PutText(stderr, "\n");
       PZImage.WritePGM(name, P)
     END  
  END WriteFragmentImage; 

PROCEDURE ExtractFragmentImage(READONLY M: PZImage.T; READONLY pix: Pixels): REF PZImage.T =
  (*
    Creates an image containing the given pixels from "M", plus all
    their 4-connected neighbors. *)

  VAR minX, maxX, minY, maxY : NAT;

  PROCEDURE FindMinMax( ) = 
    BEGIN
      <* ASSERT NUMBER(pix) >= 1 *>
      minX := pix[0][0];
      maxX := pix[0][0];
      minY := pix[0][1];
      maxY := pix[0][1];

      FOR  i:= 1 TO LAST(pix) DO
        WITH x = pix[i][0], y = pix[i][1] DO
          IF minX > x  THEN minX := x END;
          IF minY > y  THEN minY := y END;
          IF maxX < x  THEN maxX := x END;
          IF maxY < y  THEN maxY := y END;
        END
      END
    END FindMinMax;

  BEGIN 
    FindMinMax();
    WITH
      MY = NUMBER(M),
      MX = NUMBER(M[0]),
      PY = (maxY - minY + 1) + 2,
      PX = (maxX - minX + 1) + 2,
      rP = NEW(REF PZImage.T, PY, PX),
      P = rP^
    DO 
      (* Clear whole image: *)
      FOR y := 0 TO PY-1 DO 
        FOR x := 0 TO PX-1 DO 
          P[y,x] := 0
        END
      END;
      
      (* Copy pixels and their 4-connected neighbors: *)
      FOR i := 0 TO LAST(pix) DO 
        WITH 
          xM = pix[i][0], 
          yM = pix[i][1],
          xP = xM - minX + 1,
          yP = yM - minY + 1
        DO 
          P[yP, xP] := M[yM,xM];
          IF yM > 0 THEN P[yP-1,xP] := M[yM-1,xM] END;
          IF xM > 0 THEN P[yP,xP-1] := M[yM,xM-1] END;
          IF yM < MY-1 THEN P[yP+1,xP] := M[yM+1,xM] END;
          IF xM < MX-1 THEN P[yP,xP+1] := M[yM,xM+1] END
        END
      END;
      RETURN rP
    END
  END ExtractFragmentImage;
 
PROCEDURE GetOptions(): Options =
  VAR o: Options;
  BEGIN
    WITH
      pp = NEW(ParseParams.T).init(stderr)
    DO

      TRY
        pp.getKeyword("-inFile");
        o.inFile := pp.getNext();
   
        IF pp.keywordPresent("-outPrefix") THEN
          o.outPrefix := pp.getNext()
        ELSE
          o.outPrefix := o.inFile
        END;
        
        IF pp.keywordPresent("-startNum") THEN
          o.startNum := pp.getNextInt(0, LAST(NAT))
        ELSE
          o.startNum := 0
        END;
        
        pp.getKeyword("-sep");
        o.sep := pp.getNextInt(0, 254);
   
        pp.finish();                                       
      EXCEPT                                                            
      | ParseParams.Error =>                                              
          Wr.PutText(stderr, "Usage: PZSplitExt \\\n");
          Wr.PutText(stderr, "  -inFile <name> \\\n");
          Wr.PutText(stderr, "  [ -outPrefix <name> ] [ -startNum <num> ] \\\n");
          Wr.PutText(stderr, "  -sep <num> \n");
        Process.Exit(1);
      END;
    END;
    RETURN o
    
  END GetOptions;
  
BEGIN 
  Main()
END PZSplitExt. 

(*
  Copyright © 2001 Universidade Estadual de Campinas (UNICAMP).
  Authors: Helena C. G. Leitão and Jorge Stolfi.
  
  This file can be freely distributed, used, and modified, provided
  that this copyright and authorship notice is preserved, and that any
  modified versions are clearly marked as such.
  
  This software has NO WARRANTY of correctness or applicability for
  any purpose. Neither the authors nor their employers chall be held
  responsible for any losses or damages that may result from its use.
*)