QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Help Me! v
efficient way to compare 2 images?

Threaded Mode
efficient way to compare 2 images?
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#31
11-18-2022, 11:40 PM
Well my idea didn't take so long for one compare, just blink and there's your answer:
Code: (Select All)
Randomize Timer

Screen _NewImage(1280, 720, 32)

'let's make this an unique and pretty image!
For i = 1 To 100
    Line (Rnd * _Width, Rnd * _Height)-(Rnd * width, Rnd * _Height), &HFF000000 + Rnd * &HFFFFFF, BF
Next

image2 = _CopyImage(0) 'identical copies for testing
image3 = _CopyImage(0) 'identical copy...  BUT
_Dest image3
PSet (Rnd * _Width, Rnd * _Height), &HFF000000 + Rnd * &HFFFFFF 'We've just tweaked it so that there's no way in hell it's the same as the other two now!
_Dest 0 'image3 is EXACTLY one pixel different from the other two.  Can we detect that?
image4 = _CopyImage(0) 'an identical copy once again, because 0 will change once we print the results

result1 = CompareImages(0, image2)
result2 = CompareImages(0, image3)
result3 = CompareImages(image2, image3)

Print "Current Screen and Image 1 Compare:  "; result1
Print "Current Screen and Image 2 Compare:  "; result2
Print "Image1 and Image 2 Compare        :  "; result3

Print
Print "Press <ANY KEY> for a speed test!"
Sleep

t# = Timer
Limit = 100
For i = 1 To Limit
    result = CompareImages&(image2, image3)
    result = CompareImages&(image2, image4)
Next
Print
Print Using "####.####### seconds to do"; Timer - t#;
Print Limit * 2; "comparisons."


Function CompareImages& (handle1 As Long, handle2 As Long)
    Dim As _Unsigned Long p1
    For y = 0 To _Height(handle1) - 1
        For x = 0 To _Width(handle1) - 1
            _Source handle1
            p1 = Point(x, y)
            _Source handle2
            If Point(x, y) <> p1 Then Exit Function
        Next
    Next
    CompareImages& = -1
End Function

Not nearly as quick as memory methods though.
b = b + ...
Find
Reply
mnrvovrfc Away
Posting Freak
*****
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation: 47
#32
11-19-2022, 12:00 AM
Nice try, only cheating with alpha channel. There are 256 discrete values for red, green and blue with a very large permutation and even if one of the registers from one file is 4 values apart from the other.

Change your code to add and/or subtract values from one register from one point, and do it to a few thousand points. The comparison for equality then will fail.

This is an interesting use for "POINT()" because in Freebasic the alpha channel has to absolutely be stripped out to do simple comparisons by 32-bit color.
Find
Reply
madscijr Offline
Mini-Mod
***
Posts: 529
Threads: 67
Joined: Apr 2022
Reputation: 11
#33
11-19-2022, 12:05 AM (This post was last modified: 11-19-2022, 12:10 AM by madscijr.)
(11-18-2022, 09:21 PM)James D Jarvis Wrote: squish the two images down to a really small image. If they don't match when they are 2 by 2 pixels they sure aren't going to match when they are say 200 by 200 pixels. 
if it matches keep comparing pixels by pixel in slightly larger scaled image until back up to original size.

crude example:
...

Hey, this works! (See test below...)

(11-18-2022, 11:40 PM)bplus Wrote: Well my idea didn't take so long for one compare, just blink and there's your answer:
...

^^^
Will need to compare the performance against bplus' method.

(11-18-2022, 11:40 PM)bplus Wrote: Not nearly as quick as memory methods though.

What was that memory method again?

(11-18-2022, 09:08 PM)Spriggsy Wrote: Or, very simply, MEM both images and compare the data within for equality by putting the data into a string and checking image1$ = image2$

I'm not too familiar with _MEM, will have to look it up. 

It would be interesting to see how the performance compares against what we have so far! 

Dinner time! I'll have to check back later...
Thanks guys!

Code: (Select All)
' ?????????????????????????????????????????????????????????????????????????????
' HOW MIGHT WE EFFICIENTLY COMPARE TWO IMAGES?
' ?????????????????????????????????????????????????????????????????????????????

Const FALSE = 0
Const TRUE = Not FALSE

' DO TEST
CompareImagesSquishTest

' CLEAR IMAGES
Screen 0
System


' /////////////////////////////////////////////////////////////////////////////

Sub CompareImagesSquishTest ()
    Dim image1&
    Dim image2&
    Dim bEqual%

    image1& = _NewImage(100, 100, 32)
    image2& = _NewImage(100, 100, 32)

    Screen _NewImage(1024, 768, 32)

    ' -----------------------------------------------------------------------------
    ' TEST #1
    _Dest 0: Cls , cBlack

    ' CREATE IMAGES (NOT EQUAL)
    DrawSquare image1&, 10, 10, 80, cRed, cBlue
    DrawSquare image2&, 10, 10, 80, cRed, cYellow

    ' COMAPRE IMAGES
    bEqual% = CompareImagesSquish%(image1&, image2&)

    ' SHOW IMAGES
    _Dest 0
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0

    ' SHOW RESULTS
    If bEqual% = TRUE Then
        DrawEqual 200, 100
    Else
        DrawNot 200, 100
        DrawEqual 200, 100
    End If

    ' WAIT FOR USER
    Locate 1, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
   
    ' -----------------------------------------------------------------------------
    ' TEST #2
    _Dest 0: Cls , cBlack
   
    ' UPDATE image2 TO MATCH image1
    _Dest image2&
    Paint (55, 85), cBlue, cRed
   
    ' COMAPRE IMAGES
    bEqual% = CompareImagesSquish%(image1&, image2&)
   
    ' SHOW IMAGES
    _Dest 0
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0
   
    ' SHOW RESULTS
    If bEqual% = TRUE Then
        DrawEqual 200, 100
    Else
        DrawNot 200, 100
        DrawEqual 200, 100
    End If
   
    ' WAIT FOR USER
    Locate 1, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
   
    ' -----------------------------------------------------------------------------
    ' TEST #3
    _Dest 0: Cls , cBlack
   
    ' UPDATE image1 TO DIFF image2
    _Dest image1&
    DrawSquare image1&, 20, 20, 10, cLime, cBlue
   
    ' COMAPRE IMAGES
    bEqual% = CompareImagesSquish%(image1&, image2&)
   
    ' SHOW IMAGES
    _Dest 0
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0
   
    ' SHOW RESULTS
    If bEqual% = TRUE Then
        DrawEqual 200, 100
    Else
        DrawNot 200, 100
        DrawEqual 200, 100
    End If
   
    ' WAIT FOR USER
    Locate 1, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
   
    ' -----------------------------------------------------------------------------
    ' TEST #4
    _Dest 0: Cls , cBlack
   
    ' UPDATE image1 TO MATCH image2
    _Dest image1&
    DrawSquare image1&, 20, 20, 10, cBlue, cBlue
   
    ' COMAPRE IMAGES
    bEqual% = CompareImagesSquish%(image1&, image2&)
   
    ' SHOW IMAGES
    _Dest 0
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0
   
    ' SHOW RESULTS
    If bEqual% = TRUE Then
        DrawEqual 200, 100
    Else
        DrawNot 200, 100
        DrawEqual 200, 100
    End If
   
    ' WAIT FOR USER
    Locate 1, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
   
    ' -----------------------------------------------------------------------------
    ' TEST #5
    _Dest 0: Cls , cBlack
   
    ' UPDATE image2 TO DIFF image1 (ONE PIXEL)
    _Dest image2&
    Line (50, 50)-(50, 50), cWhite, , 65535
   
    ' COMAPRE IMAGES
    bEqual% = CompareImagesSquish%(image1&, image2&)
   
    ' SHOW IMAGES
    _Dest 0
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0
   
    ' SHOW RESULTS
    If bEqual% = TRUE Then
        DrawEqual 200, 100
    Else
        DrawNot 200, 100
        DrawEqual 200, 100
    End If
   
    ' WAIT FOR USER
    Locate 1, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
   
    ' -----------------------------------------------------------------------------
    ' TEST #6
    _Dest 0: Cls , cBlack
   
    ' UPDATE image2 TO MATCH image1
    _Dest image2&
    Line (50, 50)-(50, 50), cBlue, , 65535
   
    ' COMAPRE IMAGES
    bEqual% = CompareImagesSquish%(image1&, image2&)
   
    ' SHOW IMAGES
    _Dest 0
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0
   
    ' SHOW RESULTS
    If bEqual% = TRUE Then
        DrawEqual 200, 100
    Else
        DrawNot 200, 100
        DrawEqual 200, 100
    End If
   
    ' WAIT FOR USER
    Locate 1, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
   
    ' -----------------------------------------------------------------------------
    ' CLEANUP
    If image1& < -1 Then _FreeImage image1&
    If image2& < -1 Then _FreeImage image2&
End Sub ' CompareImagesSquishTest

' /////////////////////////////////////////////////////////////////////////////

' James D Jarvis
' https://staging.qb64phoenix.com/showthread.php?tid=1151&page=2

' squish the two images down to a really small image.
' If they don't match when they are 2 by 2 pixels they sure aren't
' going to match when they are say 200 by 200 pixels.
' if it matches keep comparing pixels by pixel in slightly larger
' scaled image until back up to original size.

Function CompareImagesSquish% (image1&, image2&)
    Dim bResult%
    Dim iDiffCount%
    Dim iThreshold%
    Dim iPassNum%
    Dim xMax%
    Dim yMax%
    Dim pic1&
    Dim pic2&
    Dim px%
    Dim py%
    Dim color1~&
    Dim color2~&
    Dim bFinished%
   
    bResult% = TRUE
    bFinished% = FALSE
    iDiffCount% = 0
    iThreshold% = 2
    iPassNum% = 0
    For xMax% = 2 To _Width(image1&) Step 10
        iPassNum% = iPassNum% + 1
        'Locate 1, 1: Print iPassNum% ' this really just gives you something to look at
        For yMax% = 2 To _Height(image1&) Step 10
            pic1& = _NewImage(xMax%, yMax%)
            pic2& = _NewImage(xMax%, yMax%)
            _PutImage (0, 0)-(xMax%, yMax%), image1&, pic1&, (0, 0)-(_Width(image1&), _Height(image1&))
            _PutImage (0, 0)-(xMax%, yMax%), image2&, pic2&, (0, 0)-(_Width(image2&), _Height(image2&))
            For py% = 1 To yMax%
                For px% = 1 To xMax%
                    _Source pic1&: color1 = Point(px%, py%)
                    _Source pic2&: color2 = Point(px%, py%)
                    If color1 <> color2 Then
                        iDiffCount% = iDiffCount% + 1
                        If iDiffCount% >= iThreshold% Then
                            bResult% = FALSE
                            bFinished% = TRUE
                            Exit For
                        End If
                    End If
                Next px%
                If bFinished% = TRUE Then Exit For
            Next py%
            If bFinished% = TRUE Then Exit For
        Next yMax%
    Next xMax%
   
    If pic1& < -1 Then _FreeImage pic1&
    If pic2& < -1 Then _FreeImage pic2&
   
    CompareImagesSquish% = bResult%
End Function ' CompareImagesSquish%

' /////////////////////////////////////////////////////////////////////////////

Sub DrawSquare (img&, x1%, y1%, size%, fgcolor~&, bgcolor~&)
    Dim x2%, y2%
    If img& < -1 Then
        _Dest img& ': Cls , cEmpty

        x2% = (x1% + size%) - 1
        y2% = (y1% + size%) - 1

        Line (x1%, y1%)-(x2%, y1%), fgcolor~&, , 65535
        Line (x2%, y1%)-(x2%, y2%), fgcolor~&, , 65535
        Line (x2%, y2%)-(x1%, y2%), fgcolor~&, , 65535
        Line (x1%, y2%)-(x1%, y1%), fgcolor~&, , 65535

        If bgcolor~& <> cEmpty Then
            'PAINT [STEP] (column%, row%), fillColor[, borderColor%]
            Paint (x1% + 1, y1% + 1), bgcolor~&, fgcolor~&
        End If
    End If
End Sub ' Draw Square

' /////////////////////////////////////////////////////////////////////////////

Sub DrawEqual (x%, y%)
    Dim x1%, y1%, x2%, y2%
    _Dest 0
   
    ' = (equal)
    x1% = (x% + 30) + 0: y1% = (y% + 30) + 0
    x2% = (x% + 70) - 1: y2% = (y% + 70) - 1
    Line (x1%, y1%)-(x2%, y1%), cWhite, , 65535
    Line (x1%, y2%)-(x2%, y2%), cWhite, , 65535
End Sub ' DrawEqual

' /////////////////////////////////////////////////////////////////////////////

Sub DrawNot (x%, y%)
    Dim x1%, y1%, x2%, y2%
    _Dest 0
   
    ' ! (not)
    x1% = (x% + 10) + 0: y1% = (y% + 10) + 0
    x2% = x1%: y2% = (y% + 75) - 1
    Line (x1%, y1%)-(x2%, y2%), cWhite, , 65535
    x1% = (x% + 10) + 0: y1% = (y% + 85) + 0
    x2% = x1%: y2% = (y% + 90) - 1
    Line (x1%, y1%)-(x2%, y2%), cWhite, , 65535
   
End Sub ' DrawNotEqual

' /////////////////////////////////////////////////////////////////////////////

Function cBlack~& ()
    cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cGray~& ()
    cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cWhite~& ()
    cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&
Function cRed~& ()
    cRed = _RGB32(255, 0, 0)
End Function
Function cOrange~& ()
    cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cYellow~& ()
    cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
Function cLime~& ()
    cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cCyan~& ()
    cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cBlue~& ()
    cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cPurple~& ()
    cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cMagenta~& ()
    cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cEmpty~& ()
    cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#34
11-19-2022, 12:22 AM (This post was last modified: 11-19-2022, 12:25 AM by bplus.)
Quote:What was that memory method again?


From Steves example from which I made my comparison sub.

Who is mn accusing of cheating?
Point works with Alpha, I am pretty sure!
Wiki:
b = b + ...
Find
Reply
madscijr Offline
Mini-Mod
***
Posts: 529
Threads: 67
Joined: Apr 2022
Reputation: 11
#35
11-19-2022, 01:05 AM (This post was last modified: 11-19-2022, 01:16 AM by madscijr.)
(11-19-2022, 12:22 AM)bplus Wrote:
Quote:What was that memory method again?

From Steves example from which I made my comparison sub.

Who is mn accusing of cheating?
Point works with Alpha, I am pretty sure!
Wiki:

Update: I did some testing with alpha channels, 
and it does NOT seem to detect a difference! 
See test below! 

PS Maybe _MEM method will work for alpha values?

Code: (Select All)
' ?????????????????????????????????????????????????????????????????????????????
' HOW MIGHT WE EFFICIENTLY COMPARE TWO IMAGES?
' ?????????????????????????????????????????????????????????????????????????????

Const FALSE = 0
Const TRUE = Not FALSE

' DO TEST
CompareImagesTest

' CLEAR IMAGES
Screen 0
System

' /////////////////////////////////////////////////////////////////////////////

Sub CompareImagesTest ()
    Dim image1&
    Dim image2&
    Screen _NewImage(1024, 768, 32)
    image1& = _NewImage(100, 100, 32)
    image2& = _NewImage(100, 100, 32)
   
    DrawSquare image1&, 10, 10, 80, cRed, cBlue
    DrawSquare image2&, 10, 10, 80, cRed, cYellow
    CompareNext image1&, image2&, "obviously different"
   
    _Dest image2&
    Paint (55, 85), cBlue, cRed
    CompareNext image1&, image2&, "does it match?"
   
    _Dest image1&
    DrawSquare image1&, 20, 20, 10, cLime, cBlue
    CompareNext image1&, image2&, "definitely different"
   
    _Dest image1&
    DrawSquare image1&, 20, 20, 10, cBlue, cBlue
    CompareNext image1&, image2&, "does it match?"
   
    _Dest image2&
    Line (50, 50)-(50, 50), cWhite, , 65535
    CompareNext image1&, image2&, "ONE PIXEL DIFFERENT!"
   
    _Dest image2&
    Line (50, 50)-(50, 50), cBlue, , 65535
    CompareNext image1&, image2&, "does it match?"
   
    ' -----------------------------------------------------------------------------
    ' COMPARE ALPHA CHANNELS

    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 255), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=255 vs red no alpha"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=254 vs red no alpha"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=253 vs red no alpha"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 255), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=255 vs red alpha=254"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 255), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=255 vs red alpha=253"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=254 vs red alpha=253"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 252), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=254 vs red alpha=252"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 252), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=253 vs red alpha=252"
   
    _Dest image1&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 251), , 65535
    CompareNext image1&, image2&, "one pixel different: red alpha=253 vs red alpha=251"
   
    ' -----------------------------------------------------------------------------
    ' COMPARE REGULAR COLORS AGAIN JUST TO BE SURE...
   
    _Dest image1&
    Line (50, 50)-(50, 50), cBlack, , 65535
    _Dest image2&
    Line (50, 50)-(50, 50), cWhite, , 65535
    CompareNext image1&, image2&, "ONE PIXEL DIFFERENT!"
   
    _Dest image2&
    Line (50, 50)-(50, 50), cBlack, , 65535
    CompareNext image1&, image2&, "does it match?"
   
    ' -----------------------------------------------------------------------------
    ' CLEANUP
    If image1& < -1 Then _FreeImage image1&
    If image2& < -1 Then _FreeImage image2&
End Sub ' CompareImagesTest

' /////////////////////////////////////////////////////////////////////////////

Sub CompareNext (image1&, image2&, comment$)
    Dim bResult1%
    Dim bResult2%

    ' COMAPRE IMAGES
    bResult1% = CompareImagesSquish%(image1&, image2&)
    bResult2% = CompareImagesBPlus%(image1&, image2&)

    ' SHOW IMAGES
    _Dest 0: Cls , cBlack
    _PutImage (100, 100), image1&, 0
    _PutImage (300, 100), image2&, 0

    ' SHOW RESULTS #1
    If bResult1% = TRUE Then
        DrawEqual 200, 100, cWhite
    Else
        DrawNot 200, 100, cWhite
        DrawEqual 200, 100, cWhite
    End If

    ' WAIT FOR USER
    Locate 3, 1: Print comment$
    Locate 5, 1: Print "RESULTS FOR CompareImagesSquish%"
    Locate 15, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep

    ' SHOW RESULTS #2
    If bResult2% = TRUE Then
        DrawEqual 200, 100, cRed
    Else
        DrawNot 200, 100, cRed
        DrawEqual 200, 100, cRed
    End If

    ' WAIT FOR USER
    Locate 5, 1: Print "RESULTS FOR CompareImagesBPlus%"
    Locate 15, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
End Sub ' CompareNext

' /////////////////////////////////////////////////////////////////////////////
' FROM: bplus
' https://staging.qb64phoenix.com/showthread.php?tid=1151&pid=10242#pid10242
' Well my idea didn't take so long for one compare, just blink and there's your answer:
' Not nearly as quick as memory methods though.
' b = b + ...

Function CompareImagesBPlus% (handle1 As Long, handle2 As Long)
    Dim bResult%: bResult% = TRUE
    Dim p1 As _Unsigned Long
    Dim y, x As Integer
    Dim bFinished%: bFinished% = FALSE
    For y = 0 To _Height(handle1) - 1
        For x = 0 To _Width(handle1) - 1
            _Source handle1
            p1 = Point(x, y)
            _Source handle2
            If Point(x, y) <> p1 Then
                bResult% = FALSE
                bFinished% = FALSE
                Exit For
            End If
        Next x
        If bFinished% = TRUE Then Exit For
    Next y
    CompareImagesBPlus% = bResult%
End Function ' CompareImagesBPlus%

' /////////////////////////////////////////////////////////////////////////////

' James D Jarvis
' https://staging.qb64phoenix.com/showthread.php?tid=1151&page=2

' squish the two images down to a really small image.
' If they don't match when they are 2 by 2 pixels they sure aren't
' going to match when they are say 200 by 200 pixels.
' if it matches keep comparing pixels by pixel in slightly larger
' scaled image until back up to original size.

Function CompareImagesSquish% (image1&, image2&)
    Dim bResult%
    Dim iDiffCount%
    Dim iThreshold%
    Dim iPassNum%
    Dim xMax%
    Dim yMax%
    Dim pic1&
    Dim pic2&
    Dim px%
    Dim py%
    Dim color1~&
    Dim color2~&
    Dim bFinished%
   
    bResult% = TRUE
    bFinished% = FALSE
    iDiffCount% = 0
    iThreshold% = 2
    iPassNum% = 0
    For xMax% = 2 To _Width(image1&) Step 10
        iPassNum% = iPassNum% + 1
        'Locate 1, 1: Print iPassNum% ' this really just gives you something to look at
        For yMax% = 2 To _Height(image1&) Step 10
            pic1& = _NewImage(xMax%, yMax%)
            pic2& = _NewImage(xMax%, yMax%)
            _PutImage (0, 0)-(xMax%, yMax%), image1&, pic1&, (0, 0)-(_Width(image1&), _Height(image1&))
            _PutImage (0, 0)-(xMax%, yMax%), image2&, pic2&, (0, 0)-(_Width(image2&), _Height(image2&))
            For py% = 1 To yMax%
                For px% = 1 To xMax%
                    _Source pic1&: color1 = Point(px%, py%)
                    _Source pic2&: color2 = Point(px%, py%)
                    If color1 <> color2 Then
                        iDiffCount% = iDiffCount% + 1
                        If iDiffCount% >= iThreshold% Then
                            bResult% = FALSE
                            bFinished% = TRUE
                            Exit For
                        End If
                    End If
                Next px%
                If bFinished% = TRUE Then Exit For
            Next py%
            If bFinished% = TRUE Then Exit For
        Next yMax%
    Next xMax%
   
    ' CLEANUP
    If pic1& < -1 Then _FreeImage pic1&
    If pic2& < -1 Then _FreeImage pic2&
   
    CompareImagesSquish% = bResult%
End Function ' CompareImagesSquish%

' /////////////////////////////////////////////////////////////////////////////

Sub DrawSquare (img&, x1%, y1%, size%, fgcolor~&, bgcolor~&)
    Dim x2%, y2%
    If img& < -1 Then
        _Dest img& ': Cls , cEmpty

        x2% = (x1% + size%) - 1
        y2% = (y1% + size%) - 1

        Line (x1%, y1%)-(x2%, y1%), fgcolor~&, , 65535
        Line (x2%, y1%)-(x2%, y2%), fgcolor~&, , 65535
        Line (x2%, y2%)-(x1%, y2%), fgcolor~&, , 65535
        Line (x1%, y2%)-(x1%, y1%), fgcolor~&, , 65535

        If bgcolor~& <> cEmpty Then
            'PAINT [STEP] (column%, row%), fillColor[, borderColor%]
            Paint (x1% + 1, y1% + 1), bgcolor~&, fgcolor~&
        End If
    End If
End Sub ' Draw Square

' /////////////////////////////////////////////////////////////////////////////

Sub DrawEqual (x%, y%, MyColor~&)
    Dim x1%, y1%, x2%, y2%
    _Dest 0
   
    ' = (equal)
    x1% = (x% + 30) + 0: y1% = (y% + 30) + 0
    x2% = (x% + 70) - 1: y2% = (y% + 70) - 1
    Line (x1%, y1%)-(x2%, y1%), MyColor~&, , 65535
    Line (x1%, y2%)-(x2%, y2%), MyColor~&, , 65535
End Sub ' DrawEqual

' /////////////////////////////////////////////////////////////////////////////

Sub DrawNot (x%, y%, MyColor~&)
    Dim x1%, y1%, x2%, y2%
    _Dest 0
   
    ' ! (not)
    x1% = (x% + 10) + 0: y1% = (y% + 10) + 0
    x2% = x1%: y2% = (y% + 75) - 1
    Line (x1%, y1%)-(x2%, y2%), MyColor~&, , 65535
    x1% = (x% + 10) + 0: y1% = (y% + 85) + 0
    x2% = x1%: y2% = (y% + 90) - 1
    Line (x1%, y1%)-(x2%, y2%), MyColor~&, , 65535
   
End Sub ' DrawNotEqual

' /////////////////////////////////////////////////////////////////////////////

Function cBlack~& ()
    cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cGray~& ()
    cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cWhite~& ()
    cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&
Function cRed~& ()
    cRed = _RGB32(255, 0, 0)
End Function
Function cOrange~& ()
    cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cYellow~& ()
    cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
Function cLime~& ()
    cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cCyan~& ()
    cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cBlue~& ()
    cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cPurple~& ()
    cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cMagenta~& ()
    cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cEmpty~& ()
    cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#36
11-19-2022, 01:22 AM
Don't know what you are doing but:
Code: (Select All)
Screen _NewImage(800, 600, 32)
Line (100, 100)-Step(100, 100), _RGB32(255, 0, 0, 236), BF
Line (300, 100)-Step(100, 100), _RGB32(255, 0, 0, 237), BF
If Point(150, 150) = Point(350, 150) Then Print "I'm a monkey's uncle." Else Print "Ha!"
Circle (150, 150), 5
Circle (350, 150), 5
Point can distinguish between 2 alpha settings!
b = b + ...
Find
Reply
SMcNeill Offline
Super Moderator
******
Posts: 1,507
Threads: 160
Joined: Apr 2022
Reputation: 116
#37
11-19-2022, 01:48 AM
(11-18-2022, 11:24 PM)SMcNeill Wrote: How fast are you needing your compares to be?  Somehow, it seems like everyone overlooked my working example here:  https://staging.qb64phoenix.com/showthre...1#pid10221

2000 full-screen compares of 720p HD images in 3 seconds.  That's 666 per second, or a comparison every 0.00something seconds.  

Since this isn't the type of routine which one needs to do repetitively, I'd think the little function I'd posted should be quick enough for most use cases.  Wink

If not, then you could probably save time with it considerably by writing a DECLARE LIBRARY routine and using memcmp directly, without having to copy the memory over into a set of temp strings to compare instead.  Wink

As I mentioned here, I went ahead and tried a memcmp demo:

Code: (Select All)
'int memcmp(const void *str1, const void *str2, size_t n)

Declare CustomType Library
    Function memcmp% (ByVal s1%&, Byval s2%&, Byval n As _Offset)
End Declare



Randomize Timer

Screen _NewImage(1280, 720, 32)

'let's make this an unique and pretty image!
For i = 1 To 100
    Line (Rnd * _Width, Rnd * _Height)-(Rnd * width, Rnd * _Height), &HFF000000 + Rnd * &HFFFFFF, BF
Next

image2 = _CopyImage(0) 'identical copies for testing
image3 = _CopyImage(0) 'identical copy...  BUT
_Dest image3
PSet (Rnd * _Width, Rnd * _Height), &HFF000000 + Rnd * &HFFFFFF 'We've just tweaked it so that there's no way in hell it's the same as the other two now!
_Dest 0 'image3 is EXACTLY one pixel different from the other two.  Can we detect that?
image4 = _CopyImage(0) 'an identical copy once again, because 0 will change once we print the resul


result1 = CompareImages(0, image2)
result2 = CompareImages(0, image3)
result3 = CompareImages(image2, image3)

Print "Current Screen and Image 1 Compare:  "; result1
Print "Current Screen and Image 2 Compare:  "; result2
Print "Image1 and Image 2 Compare        :  "; result3

Print
Print "Press <ANY KEY> for a speed test!"
Sleep

t# = Timer
Limit = 1000
For i = 1 To Limit
    result = CompareImages(image2, image3)
    result = CompareImages(image2, image4)
Next
Print
Print Using "####.####### seconds to do"; Timer - t#;
Print Limit * 2; "comparisons."


Function CompareImages (handle1 As Long, handle2 As Long)
    Static m(1) As _MEM
    'Dim s(1) As String
    m(0) = _MemImage(handle1): m(1) = _MemImage(handle2)
    If m(0).SIZE <> m(1).SIZE Then Exit Function 'not identical
    If m(0).ELEMENTSIZE <> m(1).ELEMENTSIZE Then Exit Function 'not identical
    's(0) = Space$(m(0).SIZE): s(1) = Space$(m(1).SIZE)
    '_MemGet m(0), m(0).OFFSET, s(0): _MemGet m(1), m(1).OFFSET, s(1)
    'If s(0) = s(1) Then CompareImages = -1
    If memcmp(m(0).OFFSET, m(1).OFFSET, m(0).SIZE) = 0 Then x = -1 Else x = 0
    CompareImages = x
End Function


[Image: image.png]
Website Find
Reply
mnrvovrfc Away
Posting Freak
*****
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation: 47
#38
11-19-2022, 04:27 AM
(11-19-2022, 12:22 AM)bplus Wrote: Who is mn accusing of cheating?
Point works with Alpha, I am pretty sure!
I'm sorry, it must have come out the wrong way. But if you keep calling me "mn" I'll go back to using my letter-and-arith-symbol to label you. J.K.

I wanted only Pete to call me only with two letters...
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#39
11-19-2022, 05:39 PM
@mnrvovrfc sorry about mn I saw no complaint from Pete's use so... 

Those letters to me look arbitrary, too many without some mnemonic to help remember, which I did ask for some time ago.

So are you now a believer that alpha differences can be distinguished by Point, at least in QB64?

BTW b+ is fine by me, is J.K. OK by you?
b = b + ...
Find
Reply
mnrvovrfc Away
Posting Freak
*****
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation: 47
#40
11-19-2022, 05:58 PM
(11-19-2022, 05:39 PM)bplus Wrote: @mnrvovrfc sorry about mn I saw no complaint from Pete's use so... 

Those letters to me look arbitrary, too many without some mnemonic to help remember, which I did ask for some time ago.

So are you now a believer that alpha differences can be distinguished by Point, at least in QB64?

BTW b+ is fine by me, is J.K. OK by you?
This is what happens when I distracted myself from QB64, and I have several marionettes and they all cannot have the same puppet...

I did a Freebasic program and was peaked off that using "POINT()" didn't work without slicing off the alpha part, although the red-blue-green registers were identical. No wait, it must have been I was trying to scan a picture to set some of them black while others were white to do that example in my "jaggies" thread. Those alpha channel levels are pesky.

I don't know if you have enabled reading other user's signatures... but what I have on my sig at this time, is the first portion of my handle. Heart
Find
Reply




Users browsing this thread: 17 Guest(s)