'===========================================================================
' Subject: BLUR PORTION OF SCREEN            Date: 04-20-98 (18:58)       
' Author:  Lennaert van den Linden           Code: QB, QBasic, PDS        
' Origin:  luckyone@xs4all.nl              Packet: GRAPHICS.ABC
'===========================================================================
' blur
' blurs part of the screen in mode 13, with the use of a
' temporary file(BLUR.TMP). It does not change to current palette but
' but seeks nearest color in the palette.
' It can be used with any palette.
' uses a maskmatrix of 5x5, which can be altered. Have fun.
'
' larger areas may take a bit longer to blur.
'
' you are free to use this code, as long as you don't put your own name
' above it pretend it's yours.
'
' Lennaert van der Linden. April 20th 1998
' any question/suggestion can be mailed to : luckyone@xs4all.nl

DEFINT A-Z
DECLARE SUB Blur (x1%, y1%, x2%, y2%, matrix%())
SCREEN 13: CLS

' ******** make some art ****************
LINE (0, 8)-(319, 199), 1, BF   ' draw a blue background
' let's draw some random lines
FOR t = 1 TO 100
    LINE (RND * 320, 8 + RND * 192)-(RND * 320, 8 + RND * 192), t
NEXT t

' draw some random filled circles
FOR i = 1 TO 50
        x = RND * 320: y = 8 + RND * 192
        CIRCLE (x, y), RND * 25, i
        PAINT (x, y), i
NEXT i

LOCATE 12, 17: PRINT "THIS WILL"
LOCATE 13, 20: PRINT "BLUR"
' *********** end of art **************

' set a blurring mask. see end of program for masks
RESTORE Blur:

' create the matrix and read the values
DIM matrix(-2 TO 2, -2 TO 2) AS INTEGER
total = 0
FOR x = -2 TO 2
    FOR y = -2 TO 2
        READ matrix(x, y)           ' read value
    NEXT y
NEXT x

' set values for box that is to be blurred.
x1 = 120: y1 = 70: x2 = 200: y2 = 130

' draw a box around the area so the user knows where to look
LINE (x1 - 1, y1 - 1)-(x2 + 1, y2 + 1), 15, B

Blur x1, y1, x2, y2, matrix()

END


' the 5x5 matrixes
' the total is calculated automatically.
' the more the values are spread over the matrix, the more blurring
' will occur.

' NW wind effect
wind:
DATA  0, 0, 2, 4, 8
DATA  0, 1, 8,16, 4
DATA  2, 8,32, 8, 2
DATA  4,16, 8, 1, 0
DATA  8, 4, 2, 0, 0

' slide
slide:
DATA  1, 2, 4, 0, 0
DATA  2, 4, 8, 1, 0
DATA  4, 8,16, 2, 0
DATA  2, 4, 8, 1, 0
DATA  1, 2, 4, 0, 0

' very blur
very:
DATA  0, 1, 1, 1, 0
DATA  1, 3, 4, 3, 1
DATA  1, 4,16, 4, 1
DATA  1, 3, 4, 3, 1
DATA  0, 1, 1, 1, 0

' normal blur
Blur:
DATA  0, 0, 1, 0, 0
DATA  0, 1, 4, 1, 0
DATA  1, 4, 8, 4, 1
DATA  0, 1, 4, 1, 0
DATA  0, 0, 1, 0, 0

SUB Blur (x1, y1, x2, y2, matrix())
' blurs part of screen. assumes you are in screen 13.
' matrix is an integer array with dimensions : (-2 to 2, -2 to 2)

' make sure distance is at least 2 (horizontal as well as vertical)
IF (x2 - x1) < 2 THEN PRINT " x2 must be bigger than x1 and distance must be at least 2.": END
IF (y2 - y1) < 2 THEN PRINT " y2 must be bigger than y1 and distance must be at least 2.": END

total = 0
FOR x = -2 TO 2
    FOR y = -2 TO 2
        total = total + matrix(x, y)
    NEXT y
NEXT x

' make sure the total is not 0, or we'll get a divide-by-zero error.
IF total = 0 THEN PRINT " Total can not be 0.": END

' now lets read the palette into an array, so we can look
' up the values quickly
DIM palet(255, 2) AS INTEGER
OUT &H3C7, 0
FOR a = 0 TO 255
    palet(a, 0) = INP(&H3C9)    ' red value
    palet(a, 1) = INP(&H3C9)    ' green value
    palet(a, 2) = INP(&H3C9)    ' blue value
NEXT a

' we can't write directly to the screen, if we did we would read already
' altered dots. We could write to memory, but might end up with memory
' shortage problems. So we'll write to a temporary file on disk.
ff = FREEFILE
OPEN "BLUR.TMP" FOR OUTPUT AS ff: CLOSE ff  ' make sure file is empty
OPEN "BLUR.TMP" FOR BINARY AS ff

' this string will hold a buffer, so we don't have to write a single byte
' every time. Writing a multitude of bytes is a lot faster.
bufsize = 0
maxsize = 2000 ' we'll flush the buffer to disk, if it reaches this size
buffer$ = ""

totaldots& = 1& * (x2 - x1 + 1) * (y2 - y1 + 1)
dotsset& = 0
pDone = 0
LOCATE 1, 1: PRINT USING " done : ###%"; pDone

FOR y = y1 TO y2
    FOR x = x1 TO x2
        red = 0: green = 0: blue = 0
        FOR xx = -2 TO 2
            FOR yy = -2 TO 2
                px = x + xx
                IF px < x1 THEN px = x - xx ' mirror the dot if it falls
                IF px > x2 THEN px = x - xx ' off the border
                py = y + yy
                IF py < y1 THEN py = y - yy
                IF py > y2 THEN py = y - yy
              
                ' add RGB values
                index = POINT(px, py) ' read color index
                red = red + palet(index, 0) * matrix(xx, yy)
                green = green + palet(index, 1) * matrix(xx, yy)
                blue = blue + palet(index, 2) * matrix(xx, yy)
          
            NEXT yy
        NEXT xx
        ' divide by total and we've got the RGB values of the blurred dot.
        red = red \ total
        green = green \ total
        blue = blue \ total
      
        ' find the closest color (closest RGB values)
        td = 12288 ' set total difference, bigger than will occur
        cc = -1  ' closest color
        FOR a = 0 TO 255
            ' calculate difference
            rd = palet(a, 0) - red
            gd = palet(a, 1) - green
            bd = palet(a, 2) - blue
            t = rd * rd + gd * gd + bd * bd ' distance = r^2+g^2+b^2
                                            ' we don't have to do a SQR(),
            IF t < td THEN                  ' it's very slow
                ' this color is closer than the last close color found
                cc = a
                td = t
                IF td = 0 THEN a = 255 ' found exact match, quit search
            END IF
        NEXT a
       
        ' cc should be greater than -1 by now.
      
        ' add byte to buffer
        buffer$ = buffer$ + CHR$(cc)
        bufsize = bufsize + 1

        ' flush the buffer is size equals maximum buffer size
        IF bufsize = maxsize THEN
            PUT #ff, , buffer$
            buffer$ = ""
            bufsize = 0
        END IF

        dotsset& = dotsset& + 1
        IF (dotsset& * 100) \ totaldots& > pDone THEN
            pDone = ((dotsset& * 100) \ totaldots&)
            LOCATE 1, 1: PRINT USING " done : ###%"; pDone
        END IF
    NEXT x
NEXT y

' there could still be bytes in the buffer, that have not been flushed yet.
IF bufsize > 0 THEN
    PUT #ff, , buffer$
    buffer$ = ""
    bufsize = 0
END IF

' we now have a temporary file (BLUR.TMP) that contains the blurred box
' all we have to do now is read back from this file to the screen. QBasic
' does not support a poke$ statement, so we have to PSET each single byte
' which will be a bit slow.
SEEK #ff, 1 ' go to start of file

' read a dot and write it
index$ = " "
FOR y = y1 TO y2
    FOR x = x1 TO x2
        GET #ff, , index$
        PSET (x, y), ASC(index$)
    NEXT x
NEXT y

' we are done on the screen. we can close the temporary file and delete it.
CLOSE #ff
KILL "BLUR.TMP"

END SUB