program cc;
{ to check out the connect-code scheme for image segmentation }

const XMAX = 16;
      YMAX = 16;
      ZMAX =  4;
      RMAX = 16;
      SMAX = 512;

      CC_INIT = 0;
      CC_1 = 1;
      CC_2 = 2;
      CC_3 = 4;
      CC_4 = 8;
      CC_5 = 16;
      CC_6 = 32;
      CC_FLAG = 64;

      ENC = 1;
      OUT = 2;

type index = byte;
     grey_value = integer;
     grey_image = array[1..XMAX,1..YMAX,1..ZMAX] of grey_value;
     c_code = byte;
     code_image = array[1..XMAX,1..YMAX,1..ZMAX] of c_code;

var xdim,ydim,zdim:     index;
    in_image,out_image: grey_image;
    cc_image:           code_image;
    name1:              string[14];
    datei1:             text;
    x,y,z:              index;
    n,n_reg:            integer;
    region:             array[1..RMAX,1..3] of index;
    stp:                integer;
    stack:              array[1..SMAX,1..3] of index;

label ENDE;

{ *** Functions return byte and integer as string in hexadecimal format *** }

function hexbyte(b:byte):char;
begin
inline ($CD/$492);
hexbyte:=Chr(0);
end; { function hexbyte }

function hexint(i:integer):char;
begin
inline ($CD/$48D);
hexint:=Chr(0);
end; { function hexint }

procedure init_stack;
begin
stp:=0;
end; { init_stack }

procedure push(x,y,z:index);
begin
if stp<SMAX then
    begin stp:=stp+1; stack[stp,1]:=x; stack[stp,2]:=y; stack[stp,3]:=z; end
else begin writeln('Stack overflow'); Halt; end;
end; { push }

procedure pop(var x,y,z:index);
begin
if stp>0 then
    begin x:=stack[stp,1]; y:=stack[stp,2]; z:=stack[stp,3]; stp:=stp-1; end
else begin writeln('Stack underflow'); Halt; end;
end; { pop }

function stack_empty: boolean;
begin
if stp=0 then stack_empty:=true else stack_empty:=false;
end; { stack_empty }

procedure set_bit(var c:c_code; b:c_code);
begin
c:=c or b;
end; { set_bit }

procedure reset_bit(var c:c_code; b:c_code);
begin
c:=c and not b;
end; { reset_bit }

function bit_is_set(var c:c_code; b:c_code): boolean;
begin
if (c and b) = b then bit_is_set:=true else bit_is_set:=false;
end; { bit_is_set }

procedure reset_flags;
var x,y,z: index;
begin
for z:=1 to zdim do          { Reset flags in code image }
    for y:=1 to ydim do
        for x:=1 to xdim do
            reset_bit(cc_image[x,y,z],CC_FLAG);
end; { reset_flags }

procedure encode(x,y,z:index);
var c: c_code;
    g: grey_value;
begin
c:=cc_image[x,y,z]; g:=in_image[x,y,z];
if x<xdim then if in_image[x+1,y  ,z  ]=g then set_bit(c,CC_1);
if x>1    then if in_image[x-1,y  ,z  ]=g then set_bit(c,CC_6);
if y<ydim then if in_image[x  ,y+1,z  ]=g then set_bit(c,CC_2);
if y>1    then if in_image[x  ,y-1,z  ]=g then set_bit(c,CC_5);
if z<zdim then if in_image[x  ,y  ,z+1]=g then set_bit(c,CC_3);
if z>1    then if in_image[x  ,y  ,z-1]=g then set_bit(c,CC_4);
cc_image[x,y,z] := c;
{                      writeln('    Encoded as ',hexbyte(cc_image[x,y,z]));}
end; { encode }

procedure push_neighbors(x,y,z:index);
var c: c_code;
    procedure check_and_push(x,y,z:index);
    begin
    if not bit_is_set(cc_image[x,y,z],CC_FLAG) then
        begin
        push(x,y,z); set_bit(cc_image[x,y,z],CC_FLAG);
{        writeln(' Pushed neighbor', x:4,y:4,z:4);}
        end;
    end;
begin
c:=cc_image[x,y,z];
if bit_is_set(c,CC_3) then check_and_push(x  ,y  ,z+1);
if bit_is_set(c,CC_4) then check_and_push(x  ,y  ,z-1);
if bit_is_set(c,CC_2) then check_and_push(x  ,y+1,z  );
if bit_is_set(c,CC_5) then check_and_push(x  ,y-1,z  );
if bit_is_set(c,CC_1) then check_and_push(x+1,y  ,z  );
if bit_is_set(c,CC_6) then check_and_push(x-1,y  ,z  );
end; { push_neighbors }

procedure traverse(x,y,z:index; switch:integer);
var xx,yy,zz:index;
begin
reset_flags;
init_stack;
push(x,y,z); set_bit(cc_image[x,y,z],CC_FLAG);
repeat
    pop(xx,yy,zz);
{                  writeln('Popped voxel ',xx:4,yy:4,zz:4,'    STP ',stp:3);}
    case switch of
    ENC: begin encode(xx,yy,zz); out_image[xx,yy,zz]:=n_reg; end;
    OUT: out_image[xx,yy,zz]:=n;
         end;
    push_neighbors(xx,yy,zz);
{                        writeln(' New STP ',stp:3); }
until stack_empty;
end; { traverse }

procedure init_out_image;
var x,y,z: index;
begin
for z:=1 to zdim do
    for y:=1 to ydim do
        for x:=1 to xdim do
            out_image[x,y,z]:=0;
end; { init_out_image }

procedure show_out_image;
var x,y,z: index;
begin
writeln; writeln('Output image:');
for z:=1 to zdim do
    begin
    writeln;
    for y:=1 to ydim do
        begin
        for x:=1 to xdim do
            write(out_image[x,y,z]:3);
        writeln;
        end;
    end;
end; { show_out_image }

begin { cc }

{ Init image array }
for z:=1 to ZMAX do
    for y:=1 to YMAX do
        for x:=1 to XMAX do
            in_image[x,y,z] := 0;

{ Open input file }

writeln; write('Image file name: '); readln(name1);
assign(datei1,name1);
{$I-} reset(datei1) {$I+};
if Ioresult<>0 then
    begin writeln('File ',name1,' not found.'); goto ENDE; end;

{ Read input image from file }
read(datei1,xdim,ydim,zdim);
for z:=1 to zdim do
    begin
    for y:=1 to ydim do
        begin
        for x:=1 to xdim do
            read(datei1,in_image[x,y,z]);
        readln(datei1);
        end;
    readln(datei1);
    end;
close(datei1);

{ Init c_code image }
for z:=1 to zdim do
    for y:=1 to ydim do
        for x:=1 to xdim do
            cc_image[x,y,z] := CC_INIT;

{ Init regions }
n_reg:=0;
init_out_image;

{ Build c_codes for in_image and collect regions }
for z:=1 to zdim do
    for y:=1 to ydim do
        for x:=1 to xdim do
            begin
            if cc_image[x,y,z]=CC_INIT then
                begin
                n_reg:=n_reg+1;
                region[n_reg,1]:=x; region[n_reg,2]:=y; region[n_reg,3]:=z;
                writeln(n_reg,'. region starting at',x:4,y:4,z:4);
                traverse(x,y,z,ENC);
                end;
            end;

{ Show c_codes }
{ reset_flags;
writeln; writeln('C-Codes:');
for z:=1 to zdim do
    begin
    writeln;
    for y:=1 to ydim do
        begin
        for x:=1 to xdim do
            write(hexbyte(cc_image[x,y,z]),' ');
        writeln;
        end;
    end;
}
show_out_image;

{ Generate output image for one region }
repeat
    writeln; write('Output image for region (1..',n_reg,' - 0=exit) ');
    readln(n);
    if (n>0) and (n<=n_reg) then
        begin
        init_out_image;
        traverse(region[n,1],region[n,2],region[n,3],OUT);
        show_out_image;
        end;
until n=0;

ENDE:
end.
