mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-23 06:05:12 +00:00
112 lines
4.2 KiB
Plaintext
112 lines
4.2 KiB
Plaintext
|
|
'
|
|
' Asserts that a created image, 'originalActualImage', is identical to the provide expected image, 'expectedFileName'
|
|
'
|
|
' The created image is converted to 32-bit and saved to the results folder.
|
|
' We then load the expected image as a 32-bit image, compare file sizes,
|
|
' width/height, and each pixel.
|
|
'
|
|
SUB AssertImage(originalActualImage As Long, expectedFileName As String)
|
|
Dim actualImage As Long
|
|
Dim ResultsDir As String, TestPrefix As String
|
|
|
|
ResultsDir = Command$(1)
|
|
TestPrefix = Command$(2)
|
|
|
|
' Make sure the test result will be seen
|
|
_Dest _Console
|
|
|
|
' Convert to 32-bit for comparisons
|
|
actualImage = _NewImage(_Width(originalActualImage), _Height(originalActualImage), 32)
|
|
_PUTIMAGE , originalActualImage, actualImage
|
|
|
|
'First save the result
|
|
SaveImage actualImage, ResultsDir + "/" + TestPrefix + "_result.bmp"
|
|
|
|
'Compare both images, print whether they are identical
|
|
Dim expectedImage As Long
|
|
expectedImage = _LOADIMAGE(expectedFileName, 32)
|
|
|
|
If _Width(actualImage) <> _Width(expectedImage) Then
|
|
Print "Failure! Image width differs, actual:"; _Width(actualImage);", Expected:"; _Width(expectedImage)
|
|
GoTo freeImages
|
|
End If
|
|
|
|
If _Height(actualImage) <> _Height(expectedImage) Then
|
|
Print "Failure! Image height differs, actual:"; _Height(actualImage);", Expected:"; _Height(expectedImage)
|
|
GoTo freeImages
|
|
End If
|
|
|
|
Dim actual As _Mem, expected As _Mem
|
|
|
|
actual = _MEMIMAGE(actualImage)
|
|
expected = _MEMIMAGE(expectedImage)
|
|
|
|
IF actual.SIZE <> expected.SIZE THEN
|
|
Print "Failure! Image sizes differ, Actual:"; actual.SIZE; ", Expected:"; expected.SIZE
|
|
GoTo freeImages
|
|
END IF
|
|
|
|
w& = _Width(expectedImage)
|
|
h& = _Height(expectedImage)
|
|
|
|
For x& = 0 to w& - 1
|
|
For y& = 0 to h& - 1
|
|
pixelOffset = (y& * w& + x&) * 4
|
|
|
|
actualPixel& = _MemGet(actual, actual.OFFSET + pixelOffset, LONG)
|
|
expectedPixel& = _MemGet(expected, expected.OFFSET + pixelOffset, LONG)
|
|
|
|
If actualPixel& <> expectedPixel& Then
|
|
Print "Failure! Image pixels at ("; x&; ","; y&; ") differ, actual: 0x"; HEX$(actualPixel&);", expected: 0x"; HEX$(expectedPixel&)
|
|
GoTo freeImages
|
|
End If
|
|
Next
|
|
Next
|
|
|
|
PRINT "Success, images are identical!"
|
|
|
|
freeImages:
|
|
_MEMFREE actual
|
|
_MEMFREE expected
|
|
_FreeImage actualImage
|
|
END SUB
|
|
|
|
' From the QB64-PE Wiki: https://qb64phoenix.com/qb64wiki/index.php/SAVEIMAGE
|
|
Sub SaveImage (image As Long, filename As String)
|
|
bytesperpixel& = _PixelSize(image&)
|
|
If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
|
|
If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
|
|
x& = _Width(image&)
|
|
y& = _Height(image&)
|
|
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
|
|
If bytesperpixel& = 1 Then
|
|
For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
|
|
cv& = _PaletteColor(c&, image&) ' color attribute to read.
|
|
b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
|
|
Next
|
|
End If
|
|
Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
|
|
lastsource& = _Source
|
|
_Source image&
|
|
If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
|
|
For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
|
|
r$ = ""
|
|
For px& = 0 To x& - 1
|
|
c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
|
|
If bytesperpixel& = 1 Then r$ = r$ + Chr$(c&) Else r$ = r$ + Left$(MKL$(c&), 3)
|
|
Next px&
|
|
d$ = d$ + r$ + padder$
|
|
Next py&
|
|
_Source lastsource&
|
|
Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
|
|
b$ = b$ + d$ ' total file data bytes to create file
|
|
Mid$(b$, 3, 4) = MKL$(Len(b$)) ' size of data file(BMP header)
|
|
If LCase$(Right$(filename$, 4)) <> ".bmp" Then ext$ = ".bmp"
|
|
f& = FreeFile
|
|
Open filename$ + ext$ For Output As #f&: Close #f& ' erases an existing file
|
|
Open filename$ + ext$ For Binary As #f&
|
|
Put #f&, , b$
|
|
Close #f&
|
|
End Sub
|