#!/usr/local/bin/spar
pragma is
  annotate( summary, "rle" );
  annotate( description, "Given a string containing uppercase characters (A-Z)," );
  annotate( description, "compress repeated 'runs' of the same character by" );
  annotate( description, "storing the length of that run, and provide a function to" );
  annotate( description, "reverse the compression. The output can be anything, as" );
  annotate( description, "long as you can recreate the input with it." );
  annotate( description, "" );
  annotate( description, "Example:" );
  annotate( description, "Input: WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" );
  annotate( description, "Output: 12W1B12W3B24W1B14W" );
  annotate( see_also, "http://rosettacode.org/wiki/Run-length_encoding" );
  annotate( author, "Ken O. Burtch" );
  license( unrestricted );
  restriction( no_external_commands );
end pragma;

procedure rle is

  function to_rle( s : string ) return string is
  begin
    if strings.length( s ) = 0 then
       return "";
    end if;
    declare
      result : string;
      code   : character;
      prefix : string;
      first  : natural := 1;
      index  : natural := 1;
    begin
      while index <= strings.length( s ) loop
        first := index;
        index := @+1;
        code := strings.element( s, positive(first) );
        while index <= strings.length( s ) loop
          exit when code /= strings.element( s, positive(index) );
          index := @+1;
          exit when index-first = 99;
        end loop;
        prefix := strings.trim( strings.image( index - first ), trim_end.left );
        result := @ & prefix & code;
      end loop;
      return result;
    end;
  end to_rle;

  function from_rle( s : string ) return string is
  begin
    if strings.length( s ) = 0 then
       return "";
    end if;
    declare
      result : string;
      index  : positive := 1;
      prefix : string;
      code : character;
    begin
      loop
        prefix := "" & strings.element( s, index );
        index := @+1;
        if strings.is_digit( strings.element( s, index ) ) then
          prefix := @ & strings.element( s, index );
          index := @+1;
        end if;
        code := strings.element( s, index );
        index := @+1;
        result := @ & ( numerics.value( prefix ) * code );
        exit when natural(index) > strings.length( s );
      end loop;
      return result;
    end;
  end from_rle;

begin
  ? to_rle( "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" );
  ? from_rle( "12W1B12W3B24W1B14W");
end rle;