1 cap: proc (godatap);
  2 
  3 /* CAP - capture and group calculations for go program
  4    THVV & REM 1973 */
  5 
  6 
  7 %include godata;
  8 
  9 dcl (i, ii, j, jj) fixed bin;                               /* Indices on board. */
 10 dcl (up_gp, lo_gp, lf_gp, rt_gp) fixed bin;                 /* Group numbers. */
 11 dcl  temp fixed bin;
 12 
 13 dcl  EDGE fixed bin int static options (constant) init (0); /* Group number of edge of board. */
 14 
 15 /* ===================================================== */
 16 
 17 /* INIT */
 18           godata.ngrp = 0;                                  /* Will recalculate no. of groups */
 19           godata.dead (WHITE, 0), godata.dead (WHITE, 1), godata.dead (WHITE, 2) = 0; /* Clear return args. */
 20           godata.dead (BLACK, 0), godata.dead (BLACK, 1), godata.dead (BLACK, 2) = 0;
 21           do i = 1 to 361;
 22                godata.np (i) = 0;                           /* Re-calculate all group stuff each time. */
 23                godata.dame (WHITE, i), godata.dame (FREE, i), godata.dame (BLACK, i) = 0;
 24                godata.dami1 (i), godata.dami2 (i), godata.damj1 (i), godata.damj2 (i) = 0;
 25                godata.gp_color (i) = 0;
 26           end;
 27           do i = 1 to 19;
 28                do j = 1 to 19;
 29                     godata.grpno (i, j) = 0;
 30                end;
 31           end;
 32 
 33 
 34 
 35 /* GROUPER */
 36           do i = 1 to 19;                                   /* Scan entire board. Take points which touch and */
 37                do j = 1 to 19;                              /* .. associate them in the group tables. */
 38                     up_gp, lf_gp = 0;
 39 
 40 
 41                     if i > 1 then                           /* See if current point same group as point above */
 42                          if board (i-1, j) = board (i, j) then do;
 43                               up_gp, grpno (i, j) = grpno (i-1, j); /* Yes, it is */
 44                               np (up_gp) = np (up_gp) + 1;  /* So count it. */
 45 
 46                               if j > 1 then                 /* If there is also a point to the left, */
 47                                    if board (i, j-1) = board (i, j) then /* and it's the same color */
 48                                         if up_gp ^= grpno (i, j - 1) then do; /* We might have assigned 2 groups */
 49                                              lf_gp = grpno (i, j-1); /* .. where one is all we need. */
 50                                              temp = np (lf_gp); /* So we will splice the groups */
 51                                              do ii = i to 1 by -1 while (temp > 0);
 52                                                   do jj = 1 to 19 while (temp > 0);
 53                                                        if grpno (ii, jj) = lf_gp then do; /* Eliminate lf_gp */
 54                                                             grpno (ii, jj) = up_gp;
 55                                                             temp = temp - 1;
 56                                                        end;
 57                                                   end;
 58                                              end;
 59                                              if gp_loc (up_gp, 1) < gp_loc (lf_gp, 1) then;
 60                                              else if gp_loc (up_gp, 1) = gp_loc (lf_gp, 1) then
 61                                                   if gp_loc (up_gp, 2) < gp_loc (lf_gp, 2) then;
 62                                                   else go to swap;
 63                                              else do;
 64 swap:                                             gp_loc (up_gp, 1) = gp_loc (lf_gp, 1); /* Note upper left corner. */
 65                                                   gp_loc (up_gp, 2) = gp_loc (lf_gp, 2);
 66                                              end;
 67                                              np (up_gp) = np (up_gp) + np (lf_gp);
 68                                              np (lf_gp) = 0; /* lf_gp now empty */
 69                                              gp_color (lf_gp) = -2;
 70                                         end;
 71 
 72                               go to next_pt;
 73                          end;
 74 
 75 
 76                     if j > 1 then                           /* Nothing above, just check to left */
 77                          if board (i, j-1) = board (i, j) then do;
 78                               grpno (i, j) = grpno (i, j-1); /* add point to group */
 79                               np (grpno (i, j)) = np (grpno (i, j)) + 1;
 80                               go to next_pt;
 81                          end;
 82 
 83 
 84                     ngrp = ngrp + 1;                        /* Point does not match to left or up - new group */
 85                     gp_loc (ngrp, 1) = i;                   /* Note location */
 86                     gp_loc (ngrp, 2) = j;
 87                     gp_color (ngrp) = board (i, j);         /* .. color */
 88                     grpno (i, j) = ngrp;                    /* Tag point on board with group no */
 89                     np (ngrp) = 1;                          /* count stones */
 90 
 91 
 92 next_pt:
 93                end;
 94           end;
 95 
 96 
 97 
 98 /* DAMER */
 99           do i = 1 to 19;                                   /* Now compute # dame and contacts */
100                do j = 1 to 19;
101 
102                     up_gp, lo_gp, lf_gp, rt_gp = 0;
103 
104                     if i = 1 then contact (i, j, 1) = EDGE; /* Each point touches 4 groups */
105                     else do;
106                          up_gp = grpno (i-1, j);            /* Above */
107                          contact (i, j, 1) = up_gp;
108                          if grpno (i, j) ^= up_gp then      /* If this point is not in same group as point above */
109                               call add_dame (up_gp);        /* .. count it as a "dame" */
110                     end;
111 
112                     if i = 19 then contact (i, j, 3) = EDGE;
113                     else do;
114                          lo_gp = grpno (i+1, j);            /* Look down, look down */
115                          contact (i, j, 3) = lo_gp;
116                          if grpno (i, j) ^= lo_gp then do;
117                               if lo_gp ^= up_gp then        /* Don't count one point as more than one dame for same grp */
118                                    call add_dame (lo_gp);
119                          end;
120                     end;
121 
122                     if j = 1 then contact (i, j, 2) = EDGE;
123                     else do;
124                          lf_gp = grpno (i, j-1);
125                          contact (i, j, 2) = lf_gp;
126                          if grpno (i, j) ^= lf_gp then do;
127                               if lf_gp ^= up_gp then
128                                    if lf_gp ^= lo_gp then
129                                         call add_dame (lf_gp);
130                          end;
131                     end;
132 
133                     if j = 19 then contact (i, j, 4) = EDGE;
134                     else do;
135                          rt_gp = grpno (i, j+1);
136                          contact (i, j, 4) = rt_gp;
137                          if grpno (i, j) ^= rt_gp then do;
138                               if rt_gp ^= up_gp then
139                                    if rt_gp ^= lo_gp then
140                                         if rt_gp ^= lf_gp then
141                                              call add_dame (rt_gp);
142                          end;
143                     end;
144 
145                end;
146           end;
147 
148 
149 /* DEADER */
150           do i = 1 to ngrp;                                 /* Scan all groups for deadness */
151                if gp_color (i) ^= -2 then
152                     if gp_color (i) ^= 0 then
153                          if dame (0, i) <= 2 then do;
154                               godata.dead (gp_color (i), dame (0, i)) = godata.dead (gp_color (i), dame (0, i)) + np (i);
155                          end;
156           end;
157                                                             /* internal procedure called when point (i, j) is a "dame" of group "g" */
158 
159 add_dame: proc (g);
160 
161 dcl  g fixed bin;
162 
163                dame (board (i, j), g) = dame (board (i, j), g) + 1;
164                if board (i, j) = 0 then
165                     if dami1 (g) = 0 then do;
166                          dami1 (g) = i;
167                          damj1 (g) = j;
168                     end;
169                     else do;
170                          dami2 (g) = i;
171                          damj2 (g) = j;
172                     end;
173 
174           end add_dame;
175 
176      end cap;