program barcode(input, output, address);

type
  citytype = array[1..20] of char;
  statetype = array[1..2] of char;

  ziprec = record
             city: citytype ;
             state: statetype ;
             zip: integer
           end ;

  zipfiltype = file of ziprec;

  linetype = array[1..100] of char ;

var

  address: zipfiltype;

procedure readline(var line: linetype; var linesiz: integer);
var
  i: integer;

begin
  i := 0 ;
  while (i < 80) and not eoln(input) do
   begin
    i := i+1;
    read(input, line[i])
   end ;
  while not eoln(input) do
   begin
    i := i+1;
    get(input)
   end ;
  linesiz := i ;
  readln(input)
end { readline } ;

procedure writebadline(line: linetype; linesiz, errpos: integer);
  write(output, '     ');
  for i := 1 to errpos-1 do
    write(output, ' ') ;
  write(output, '^') ;
  writeln(output)
end { writebadline } ;

function skipblanks(line: linetype; start, max: integer): integer ;
var
  r: integer;
begin
  r := start ;
  while (r<=max) and (line[r] = ' ') do
    r := r+1 ;
  skipblanks := r
end { skipblanks } ;

procedure readcity(line: linetype; linesiz: integer;	{ input }
		   var p: integer; var t: ziprec; var ok: boolean); { output }
var
  i, j: integer;
begin
  i := p;
  j := 1;
  while (i<=linesiz) and (j<=20)
		     and (line[j] in ['A'..'Z','a'..'z','-',' ']) do
   begin
    t.city[j] := line[i] ;
    i := i+1 ;
    j := j+1
   end ;
  if (i>linesiz) then
   begin
    ok := false;
    writeln(output, 'Comma must end city name') ;
    writebadline(line, linesiz, p)
   end
  else if (j>20) then
   begin
    ok := false;
    writeln(output, 'City name limited to 20 characters');
    writebadline(line, linesiz, i);
   end
  else if (line[i] <> ',') then
   begin
    ok := false;
    writeln(output, 'Bad character in city name');
    writebadline(line, linesiz, i);
   end
  else
   begin
    while (j<=20) do
     begin
      t.city[j] := ' ' ;
      j := j+1
     end ;
    p := i+1
   end
end { readcity } ;

procedure readstate(line: linetype; linesiz: integer;	     { input }
		    var p: integer; var t: ziprec; var ok: boolean); { output }

begin
  if (p>=linesiz) or (p+2 <= linesiz) and (line[p+2] <> ' ') then
   begin
    ok := false ;
    writeln(output, 'State must be two characters long');
    writebadline(line, linesiz, p);
   end
  else if not ((line[p] in ['A'..'Z']) and (line [p+1] in ['A'..'Z'])) then
   begin
    ok := false ;
    writeln(output, 'State contains non alphabetic characters');
    writebadline(line, linesiz, p);
   end
  else
   begin
    t.state[1] := line[p] ;
    t.state[2] := line[p+1] ;
    p := p+2
   end
end { readstate } ;

procedure readzip(line: linetype; linesiz: integer;		   { input }
		  var p: integer; var t: ziprec; var ok: boolean); { output }
var
  i, s: integer;
  bad: boolean;

begin
  bad := false ;
  if (p+9<linesiz) then
    bad := true
  else
   begin
    for i := p to p+4 do
      bad := bad or (not (line[i] in ['0'..'9'])) ;
    bad := bad or (line[p+5] <> '-') ;
    for i := p+6 to p+9 do
      bad := bad or (not (line[i] in ['0'..'9'])) ;
   end ;
  if bad then
   begin
    ok := false ;
    writeln(output, 'Nine digit ZIP code required!') ;
    writebadline(line, linesiz, p)
   end
  else
   begin
    s := 0 ;
    for i := p to p+4 do
      s := s*10 + ORD(line[i]) - ORD('0');
    for i := p+6 to p+9 do
      s := s*10 + ORD(line[i]) - ORD('0');
    t.zip := s ;
    p := p+10
   end
end { readzip } ;

procedure parseline(line: linetype; linesiz: integer;	{ input }
		    var t: ziprec; var ok: boolean);	{ output }
var
  i,j: integer;

begin
  ok := true ;
  i := skipblanks(line, 1, linesiz);
  if (i>linesiz) then
    writeln(output, 'Empty input line.')
  else
   begin
    writeln(output, 'Calling readcity');
    readcity(line, linesiz, i, t, ok);
    if ok then
     begin
      i := skipblanks(line, i+1, linesiz) ;
      if (i>linesiz) then
       begin
	writeln(output, 'No state in input.');
	writebadline(line, linesiz, linesiz+1);
       end
      else
       begin
        writeln(output, 'Calling readstate');
	readstate(line, linesiz, i, t, ok) ;
	if ok then
	 begin
	  i := skipblanks(line, i, linesiz);
	  if (i>linesiz) then
	   begin
	    ok := false ;
	    writeln(output, 'No ZIP code in input.');
	    writebadline(line, linesiz, linesiz+1);
	   end
	  else
	   begin
            writeln(output, 'Calling readzip');
	    readzip(line, linesiz, i, t, ok);
	    if (skipblanks(line, i, linesiz) <> linesiz+1) then
	     begin
	      ok := false ;
	      writeln(output, 'Odd characters after ZIP code');
	      writebadline(line, linesiz, i)
	     end
	   end
	 end
       end
     end
   end
end { parseline } ;

procedure GlobalFilter;

var
  line: linetype;
  addr: ziprec;
  linesiz: integer;
  ok: boolean;

begin
  rewrite(address);
  while not eof(input) do
   begin
    readline(line, linesiz) ;
    parseline(line, linesiz, addr, ok);
    if ok then
      write(address, addr)
   end
end { GlobalFilter } ;

begin
  GlobalFilter
end .