home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / listings / v_02_12 / 2n12059a < prev    next >
Text File  |  1991-11-04  |  3KB  |  143 lines
  1. Listing 2
  2.  
  3. {*
  4.  * map.pas - color a map
  5.  *}
  6.  
  7. {$I readid.pas }
  8.  
  9. const
  10.     REGION_MAX = 255;
  11.  
  12. type
  13.     region = 0..REGION_MAX;
  14.     region_set = set of region;
  15.     color = (RED, BLUE, GREEN, YELLOW);
  16.     color_image_array = array [color] of string[6];
  17.  
  18. const
  19.     COLOR_MIN = RED;
  20.     COLOR_MAX = YELLOW;
  21.     color_image : color_image_array =
  22.         ('RED', 'BLUE', 'GREEN', 'YELLOW');
  23.     NAME_MAX = 3;
  24.  
  25. var
  26.     name : array [region] of string[NAME_MAX];
  27.     adjacent : array [region] of region_set;
  28.     last_region : integer;
  29.     colored : array [color] of region_set;
  30.  
  31. procedure init_map;
  32.     var
  33.         r : region;
  34.         c : color;
  35.     begin
  36.     for r := 0 to REGION_MAX do
  37.         begin
  38.         name[r] := '';
  39.         adjacent[r] := [ ];
  40.         end;
  41.     last_region := -1;
  42.     for c := COLOR_MIN to COLOR_MAX do
  43.         colored[c] := [ ];
  44.     end;
  45.  
  46. procedure dump_map;
  47.     var
  48.         ri, rj : region;
  49.     begin
  50.     for ri := 0 to last_region do
  51.         begin
  52.         write(name[ri]:NAME_MAX);
  53.         for rj := 0 to last_region do
  54.             if rj in adjacent[ri] then
  55.                 write(' ', name[rj]:NAME_MAX);
  56.             writeln;
  57.         end;
  58.     end;
  59.  
  60. function region_number(var s : string) : integer;
  61.     var
  62.         r : region;
  63.     begin
  64.     for r := 0 to last_region do
  65.         if s = name[r] then
  66.             begin
  67.             region_number := r;
  68.             exit;    
  69.             end;
  70.     inc(last_region);
  71.     if last_region > REGION_MAX then
  72.         begin
  73.         writeln('too many countries');
  74.         halt;
  75.         end;
  76.     name[last_region] := s;
  77.     region_number := last_region;
  78.     end;
  79.  
  80. procedure read_map;
  81.     var
  82.         ri, rj : region;
  83.         s : string;
  84.     begin
  85.     while not seekeof do
  86.         begin
  87.         read_id(input, s);
  88.         ri := region_number(s);
  89.         while not seekeoln do
  90.             begin
  91.             read_id(input, s);
  92.             rj := region_number(s);
  93.             adjacent[ri] := adjacent[ri] + [rj];
  94.             adjacent[rj] := adjacent[rj] + [ri];
  95.             end;
  96.         readln;
  97.         end;
  98.     end;
  99.  
  100. procedure write_map;
  101.     var
  102.         r : region;
  103.         c : color;
  104.     begin
  105.     for r := 0 to last_region do
  106.         begin
  107.         write(name[r]:NAME_MAX, ' ');
  108.         for c := COLOR_MIN to COLOR_MAX do
  109.             if r in colored[c] then
  110.                 write(color_image[c]);
  111.         writeln;
  112.         end;
  113.     end;
  114.  
  115. function try_coloring(r : region) : boolean;
  116.     var
  117.         c : color;
  118.     begin
  119.     for c := COLOR_MIN to COLOR_MAX do
  120.         if adjacent[r] * colored[c] = [ ] then
  121.             begin
  122.             colored[c] := colored[c] + [r];
  123.             if (r >= last_region)
  124.             or try_coloring(r + 1) then
  125.                 begin
  126.                 try_coloring := TRUE;
  127.                 exit;
  128.                 end;
  129.             writeln('backtracking...');
  130.             colored[c] := colored[c] - [r];
  131.             end;
  132.     try_coloring := FALSE;
  133.     end;
  134.  
  135. begin
  136. init_map;
  137. read_map;
  138. if try_coloring(0) then
  139.     write_map
  140. else
  141.     writeln('no solution');
  142. end.
  143.