home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / LIST / HB15-PT1.ARK / FCHAR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-10-21  |  2KB  |  47 lines
  1. { Copyright (C) 1986 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. procedure FillChar ( lm, rm : integer ) ;
  4.      { find and fill voids ala Game of Life algorithm }
  5. var
  6.      x, xn, xx      : integer ;
  7.      y, yn, yx      : integer ;
  8.      nOff           : integer ;
  9.  
  10. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  11.  
  12. function VoidTest ( x, y : integer ) : boolean ;
  13.      { test for isolated character off }
  14. begin
  15.    if not TestPad (x,y) then
  16.       nOff := nOff + 1 ;
  17.    VoidTest := nOff < 3
  18. end ;
  19.  
  20. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  21.  
  22. begin
  23.                                 { fill single and double voids }
  24.    xn := xScale * lm + 1 ;
  25.    xx := xScale * rm ;
  26.    for x := xn to xx do begin
  27.       yn := yStripen + 1 ;
  28.       yx := yStripex - 1 ;
  29.       for y := yn to yx do begin
  30.          if not TestPad (x,y) then begin
  31.             nOff := 0 ;
  32.             if VoidTest (x-1,y+1) then
  33.                if VoidTest (x  ,y+1) then
  34.                   if VoidTest (x+1,y+1) then
  35.                      if VoidTest (x-1,y  ) then
  36.                         if VoidTest (x+1,y  ) then
  37.                            if VoidTest (x-1,y-1) then
  38.                               if VoidTest (x  ,y-1) then
  39.                                  if VoidTest (x+1,y-1) then
  40.                                     SetPad (x,y)
  41.          end
  42.       end
  43.    end
  44. end ;
  45.  
  46. { Copyright (C) 1986 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  47.