Posts: 3,962
Threads: 175
Joined: Apr 2022
Reputation:
219
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 + ...
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
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.
Posts: 731
Threads: 103
Joined: Apr 2022
Reputation:
14
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://qb64phoenix.com/forum/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~&
Posts: 3,962
Threads: 175
Joined: Apr 2022
Reputation:
219
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 + ...
Posts: 731
Threads: 103
Joined: Apr 2022
Reputation:
14
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://qb64phoenix.com/forum/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://qb64phoenix.com/forum/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~&
Posts: 3,962
Threads: 175
Joined: Apr 2022
Reputation:
219
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 + ...
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
(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://qb64phoenix.com/forum/showthread...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.
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.
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
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
(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...
Posts: 3,962
Threads: 175
Joined: Apr 2022
Reputation:
219
@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 + ...
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
(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.
|