{ bpack.txt -- Algorithm #10: Pack 8-bit Windows bitmap by Tom Swan }

const
  READING = 0;
  ENCODING = 1;
  ABSMODE = 2;
  SINGLE = 3;
  ENDOFLINE = 4;
  NOSTATE = 999;

procedure PackRLE8(
  np: Integer; sl: ScanLine);
var
  slx: Integer;
  state: Integer;
  pixel: Integer;
  count: Integer;
  done: Boolean;
  oldcount: Integer;
  oldslx: Integer;
begin
  slx := 0; { Scan line index }
  state := READING;
  done := False;
  while not done do begin
    case state of 

    READING:
  (* Input:
     np = # pixels in scan line
     sl = scan line
     sl[slx] = next pixel *)
    begin
      if slx >= np then
        state := ENDOFLINE
      else if slx = np - 1 then 
      begin
        count := 1; { 1 pixel left }
        state := SINGLE
      end else 
      if sl[slx] = sl[slx + 1] then
        state := ENCODING
      else
        state := ABSMODE
    end;

    ENCODING:
  (* Input: 
     slx <= np - 2 (Run of 2+ pixels)
     sl[slx] = first pixel of run
     sl[slx] = sl[slx + 1] *)
    begin
      count := 2;
      pixel := sl[slx];
      slx := slx + 2;
      while ((slx < np) and 
        (pixel = sl[slx]) and 
        (count < 255)) do
      begin
        count := count + 1;
        slx := slx + 1
      end;
      PutByte(count);  { RLE unit }
      PutByte(pixel);
      state := READING
    end;

    ABSMODE:
  (* Input:
     slx <= np - 2 (Run of 2+ pixels)
     sl[slx] = first pixel of run
     sl[slx] <> sl[slx + 1] *)
    begin
      oldslx := slx;  { Save index }
      count := 2;
      slx := slx + 2;
      { Compute # bytes in run }
      while ((slx < np) and 
        (sl[slx] <> sl[slx - 1]) and 
        (count < 255)) do
      begin
        count := count + 1;
        slx := slx + 1
      end;
      { Back up on same-color run }
      if ((slx < np) and 
          (sl[slx] = sl[slx - 1]))
        then if (count > 1) 
          then count := count - 1;
      slx := oldslx;
      if (count < 3 ) then
        state := SINGLE {short run}
      else begin  {normal run}
        PutByte(0);
        PutByte(count);
        oldcount := count;
        while (count > 0) do
        begin
          PutByte(sl[slx]);
          slx := slx + 1;
          count := count - 1
        end;
        if Odd(oldcount) then
          PutByte(0);  {word padding}
        state := READING
      end { else }
    end;

    SINGLE:
  (* Input:
     count = # pixels to output
     slx < np
     sl[slx] = first pixel of run
     sl[slx] <> sl[slx + 1] *)
    begin
      while count > 0 do
      begin
        PutByte(01);
        PutByte(sl[slx]);
        slx := slx + 1;
        count := count - 1
      end;
      state := READING
    end;

    ENDOFLINE:
    begin
      PutByte(0);
      PutByte(0);
      done := TRUE;
      state := NOSTATE
    end;
    else
    begin
      Writeln('Unknown state');
      Halt
    end
   end { case state of }
  end { while }
end; { PackRLE8 }

begin
  Read(np);
  Read(ns);
  while (ns > 0) do
  begin
    GetNextScanLine(sl);
    PackRLE8(np, sl);
    ns := ns - 1
  end;
  PutByte(0);  { Mark bitmap end }
  PutByte(1)
end.


(*
// --------------------------------------------------------------
// Copyright (c) 1993 by Tom Swan. All rights reserved
// Revision 1.00    Date: 04/27/1993   Time: 09:00 am
*)
