Tips for optimizing my screen 12 BMP loader

by Pharoah (no login)

 
This program* loads 24 color bitmaps into screen 12 using error diffusion dithering. Specifically, it uses the "filter lite" algorithm which is optimized for bit shifts (too bad QBasic doesn't support them). At any rate, I find that this runs painfully slow in dosbox**, and I'd like to make it faster if I can. Does anyone have any ideas? I've tried using a 512 entry LUT to perform the initial color quantization, but the results were awful.

DEFINT A-Z

TYPE bmpFileHeader
    magic AS STRING * 2
    size AS LONG
    zeros AS LONG
    offset AS LONG
END TYPE

TYPE bmpInfoHeader
    headerSize AS LONG
    w AS LONG
    h AS LONG
    planes AS INTEGER
    bpp AS INTEGER '1, 4, 8, or 24
    compression AS LONG
    imageSize AS LONG
    ppmx AS LONG
    ppmy AS LONG
    colors AS LONG
    importantColors AS LONG
END TYPE

TYPE rgbColor
    b AS STRING * 1
    g AS STRING * 1
    r AS STRING * 1
END TYPE

TYPE intColor
    r AS INTEGER
    g AS INTEGER
    b AS INTEGER
END TYPE

'=== CONSTANTS
file$ = "test2.bmp"

'=== MAIN
SCREEN 12
DIM fileHeader AS bmpFileHeader
DIM infoHeader AS bmpInfoHeader
DIM rawPixel AS rgbColor
DIM intPixel AS intColor
DIM errors AS intColor
DIM blank AS intColor
DIM bestErrors AS intColor
blank.r = 0
blank.g = 0
blank.b = 0

'Build lookup table
DIM lookup(0 TO 15) AS intColor
FOR i = 0 TO 15
    READ lookup(i).r, lookup(i).g, lookup(i).b
NEXT i

'Read the image data and display it
OPEN file$ FOR BINARY AS #1
GET #1, , fileHeader
GET #1, , infoHeader
IF infoHeader.bpp <> 24 THEN
        PRINT "Can only read true color bitmaps."
        PRINT "BPP = " + STR$(infoHeader.bpp)
        END
ELSEIF infoHeader.compression <> 0 THEN
        PRINT "Can't read compressed bitmaps."
END IF


DIM quantErrors(-1 TO 0, 0 TO infoHeader.w - 1) AS intColor
qeLine = 0

' Move to the actual image data
SEEK #1, fileHeader.offset + 1


endSkip = (infoHeader.w * 3) MOD 4 ' This meets an alignment requirement
DIM dummy AS STRING * 1
FOR y = infoHeader.h - 1 TO 0 STEP -1
        FOR x = 0 TO infoHeader.w - 1
                GET #1, , rawPixel

                ' Add the pixel value to the diffused error
                intPixel.r = ASC(rawPixel.r) + quantErrors(qeLine, x).r
                IF intPixel.r < 0 THEN intPixel.r = 0 ELSE IF intPixel.r > 255 THEN intPixel.r = 255
                intPixel.g = ASC(rawPixel.g) + quantErrors(qeLine, x).g
                IF intPixel.g < 0 THEN intPixel.g = 0 ELSE IF intPixel.g > 255 THEN intPixel.g = 255
                intPixel.b = ASC(rawPixel.b) + quantErrors(qeLine, x).b
                IF intPixel.b < 0 THEN intPixel.b = 0 ELSE IF intPixel.b > 255 THEN intPixel.b = 255
                quantErrors(qeLine, x) = blank

                ' Find the best match
                best = 0
                DIM e AS LONG
                e = 100000000
                FOR i = 0 TO 15
                    errors.r = intPixel.r - lookup(i).r
                    errors.g = intPixel.g - lookup(i).g
                    errors.b = intPixel.b - lookup(i).b
                    ee = ABS(errors.r) + ABS(errors.g) + ABS(errors.b)
                    IF ee < e THEN
                            e = ee
                            best = i
                            bestErrors = errors
                    END IF
                NEXT i

                ' Diffuse the error to neighboring pixels in this pattern:
                '     X .5
                '.25 .25
                bestErrors.r = bestErrors.r \ 4
                bestErrors.g = bestErrors.g \ 4
                bestErrors.b = bestErrors.b \ 4

                quantErrors(NOT qeLine, x).r = quantErrors(NOT qeLine, x).r + bestErrors.r
                quantErrors(NOT qeLine, x).g = quantErrors(NOT qeLine, x).g + bestErrors.g
                quantErrors(NOT qeLine, x).b = quantErrors(NOT qeLine, x).b + bestErrors.b
                IF x > 0 THEN
                        quantErrors(NOT qeLine, x - 1).r = quantErrors(NOT qeLine, x - 1).r + bestErrors.r
                        quantErrors(NOT qeLine, x - 1).g = quantErrors(NOT qeLine, x - 1).g + bestErrors.g
                        quantErrors(NOT qeLine, x - 1).b = quantErrors(NOT qeLine, x - 1).b + bestErrors.b
                END IF

                IF x < infoHeader.w - 1 THEN
                        quantErrors(qeLine, x + 1).r = quantErrors(qeLine, x + 1).r + bestErrors.r + bestErrors.r
                        quantErrors(qeLine, x + 1).g = quantErrors(qeLine, x + 1).g + bestErrors.g + bestErrors.g
                        quantErrors(qeLine, x + 1).b = quantErrors(qeLine, x + 1).b + bestErrors.b + bestErrors.b
                END IF
        
                PSET (x, y), best
        NEXT x
        qeLine = NOT qeLine
        
        FOR i = 1 TO endSkip
                GET #1, , dummy
        NEXT i
NEXT y

DATA 0,    0,    0
DATA 0,    0, 170
DATA 0, 170,    0
DATA 0, 170, 170
DATA 170,    0,    0
DATA 170,    0, 170
DATA 170, 85,    0
DATA 170, 170, 170
DATA 85, 85, 85
DATA 85, 85, 255
DATA 85, 255, 85
DATA 85, 255, 255
DATA 255, 85, 85
DATA 255, 85, 255
DATA 255, 255, 85
DATA 255, 255, 255



* In case someone finds this code useful later, I'm releasing it into the public domain.

** Yes, I know I could be using NTVDM or dosemu or qb64, but that's not the point.

Posted on Oct 26, 2011, 8:16 AM

Respond to this message   

Return to Index

Response TitleAuthor and Date
Can somebody fix that?Pharoah on Oct 26
 nbsp isClippy on Oct 26
 Re: Can somebody fix that? on Oct 26
  * CHR$(255) works too... on Oct 26
   It depends on code page translation. on Oct 26
    That's better than... on Oct 26
  I'd originally done a similar thing...Pharoah on Oct 26
*Nice job, Pharoah! Of course, writing it must have been less work than posting it (lol)! on Oct 26
 * Great job Pharoah! I hear ya Bob...:-) on Oct 26

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement