DECLARE SUB smooth ()
DECLARE SUB copy2to1 ()
DECLARE SUB setpal ()
DECLARE SUB showpic1 ()
DEFINT I-N
'                         'Shows use of a simple 3x3 smoothing filter
                          'for tidying a binary image.
SCREEN 12
VIEW (160, 80)-(480, 400), , 12
WINDOW (0, 0)-(64, 64)

CONST grey0 = 65536 + 256 + 1

DIM SHARED pic1(63, 63) AS INTEGER, pic2(63, 63) AS INTEGER
CONST k1 = 1024
CONST c1 = k1 / 16

'setpal                   'sets greyscale - not used in this program

'RANDOMIZE TIMER
FOR i = 0 TO 63           'Set up picture with a 'ragged diamond'
   FOR j = 0 TO 63
      k = ABS(i - 32) + ABS(j - 32)
      IF k + 12 * RND < 24 THEN        'change numbers to change image
         pic1(i, j) = 1
      ELSE
         pic1(i, j) = 0
      END IF
   NEXT
NEXT

showpic1

LOCATE 1, 1
PRINT "press a key to stop at end of pass"

DO
    n = n + 1
    LOCATE 3, 1
    PRINT "pass "; n

    smooth
    copy2to1
    showpic1

LOOP UNTIL INKEY$ <> ""

SUB copy2to1
FOR i = 0 TO 63
   FOR j = 0 TO 63
      pic1(i, j) = pic2(i, j)
   NEXT
NEXT
END SUB

SUB setpal
FOR i = 1 TO 15
   PALETTE i, 4 * i * grey0
NEXT
END SUB

SUB showpic1
FOR i = 0 TO 63
   FOR j = 0 TO 63
      LINE (i, j)-STEP(1, 1), 15 * pic1(i, j), BF
   NEXT
NEXT
END SUB

SUB smooth
FOR i = 1 TO 62                   'for each point of the image
   FOR j = 1 TO 62                'except those around the edge
      m = 0
      FOR k = i - 1 TO i + 1
         FOR l = j - 1 TO j + 1
            m = m + pic1(k, l)    'add 9 values in 3x3 block
         NEXT
      NEXT
      IF m > 4 THEN               'If majority are white
         pic2(i, j) = 1           'set pixel of second array to white
      ELSE
         pic2(i, j) = 0           'otherwise black
      END IF
   NEXT
NEXT

END SUB