'**************************
' Code beyond this point can go into a nice SaveBMPLibrary.BM
'**************************


SUB SaveFullBMP (filename$)
    SaveBMP filename$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
END SUB

SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
    'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
    IF x1% < 0 OR y1% < 0 THEN ERROR 5: EXIT FUNCTION
    IF x2% > _WIDTH(image&) OR y2% > _HEIGHT(image&) THEN ERROR 5: EXIT FUNCTION
    IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
    IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1

    IF _PIXELSIZE(image&) = 0 THEN
        IF SaveTextAs256Color THEN
            tempimage& = TextScreenToImage256&(image&)
        ELSE
            tempimage& = TextScreenToImage32&(image&)
        END IF
        F = _FONT(image&)
        FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
        SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
        _FREEIMAGE tempimage&
        EXIT FUNCTION
    END IF

    TYPE BMPFormat
        ID AS STRING * 2
        Size AS LONG
        Blank AS LONG
        Offset AS LONG
        Hsize AS LONG
        PWidth AS LONG
        PDepth AS LONG
        Planes AS INTEGER
        BPP AS INTEGER
        Compression AS LONG
        ImageBytes AS LONG
        Xres AS LONG
        Yres AS LONG
        NumColors AS LONG
        SigColors AS LONG
    END TYPE


    DIM BMP AS BMPFormat
    DIM x AS LONG, y AS LONG
    DIM temp AS STRING, t AS STRING * 1

    DIM n AS _MEM, o AS _OFFSET, m AS _MEM
    m = _MEMIMAGE(image&)

    IF x1% > x2% THEN SWAP x1%, x2%
    IF y1% > y2% THEN SWAP y1%, y2%
    IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
    IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen

    s& = _SOURCE
    _SOURCE image&

    BMP.PWidth = (x2% - x1%) + 1
    BMP.PDepth = (y2% - y1%) + 1
    BMP.ID = "BM"
    BMP.Blank = 0
    BMP.Hsize = 40
    BMP.Planes = 1
    BMP.Compression = 0
    BMP.Xres = 0
    BMP.Yres = 0

    BMP.SigColors = 0

    SELECT CASE _PIXELSIZE(image&)
        CASE 1
            temp = SPACE$(x2% - x1% + 1)
            OffsetBITS& = 54 + 1024 'add palette in 256 color modes
            BMP.BPP = 8
            IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
            ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
            BMP.ImageBytes = ImageSize&
            BMP.NumColors = 256
            BMP.Size = ImageSize& + OffsetBITS&
            BMP.Offset = OffsetBITS&
        CASE 4
            temp = SPACE$(3)
            OffsetBITS& = 54 'no palette in 24/32 bit
            BMP.BPP = 24
            IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
            ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
            BMP.ImageBytes = ImageSize&
            BMP.NumColors = 0
            BMP.Size = ImageSize& * 3 + OffsetBITS&
            BMP.Offset = OffsetBITS&
    END SELECT

    F = FREEFILE
    n = _MEMNEW(BMP.Size)
    _MEMPUT n, n.OFFSET, BMP
    o = n.OFFSET + 54
    zp& = LEN(ZeroPAD$)
    $CHECKING:OFF

    IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
        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$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
            _MEMPUT n, o, b$
            o = o + 4
        NEXT
        y = y2% + 1
        w& = _WIDTH(image&)
        x = x2% - x1% + 1
        DO
            y = y - 1
            _MEMGET m, m.OFFSET + (w& * y + x1%), temp
            _MEMPUT n, o, temp
            o = o + x
            _MEMPUT n, o, ZeroPAD$
            o = o + zp&
        LOOP UNTIL y = y1%
    ELSE
        y = y2% + 1
        w& = _WIDTH(image&)
        DO
            y = y - 1: x = x1% - 1
            DO
                x = x + 1
                _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
                _MEMPUT n, o, temp
                o = o + 3
            LOOP UNTIL x = x2%
            _MEMPUT n, o, ZeroPAD$
            o = o + zp&
        LOOP UNTIL y = y1%
    END IF
    $CHECKING:ON
    _MEMFREE m
    OPEN filename$ FOR BINARY AS #F
    t1$ = SPACE$(BMP.Size)
    _MEMGET n, n.OFFSET, t1$
    PUT #F, , t1$
    _MEMFREE n
    CLOSE #F
    _SOURCE s&
END SUB

FUNCTION TextScreenToImage256& (image&)
    d& = _DEST: s& = _SOURCE
    DIM Plt(15) AS LONG
    _SOURCE image&: _DEST image&
    FOR i = 0 TO 15: Plt(i) = _PALETTECOLOR(i, image&): NEXT
    f& = _FONT(image&)
    _FONT f&
    fw& = _FONTWIDTH
    fh& = _FONTHEIGHT
    w& = _WIDTH * _FONTWIDTH
    h& = _HEIGHT * _FONTHEIGHT '+ _HEIGHT
    l& = (_WIDTH * _HEIGHT) * 2 'The screen is width * height in pixels.  (80X25) = 2000 X 2 bytes each = 4000 total bytes to hold a page of screen 0 text and color
    tempscreen& = _NEWIMAGE(w&, h& + _HEIGHT, 256)
    Screen0to256& = _NEWIMAGE(w&, h&, 256)

    DIM m AS _MEM, b AS _UNSIGNED _BYTE, t AS STRING * 1
    DIM o AS _OFFSET
    m = _MEMIMAGE(image&)
    o = m.OFFSET

    _DEST (tempscreen&)
    FOR i = 0 TO 15: _PALETTECOLOR i, Plt(i): NEXT
    _FONT f&

    FOR i = 0 TO l& - 2 STEP 2
        _MEMGET m, m.OFFSET + i, t
        _MEMGET m, m.OFFSET + i + 1, b
        IF b > 127 THEN b = b - 128
        COLOR b MOD 16, b \ 16
        PRINT t;
    NEXT
    _PUTIMAGE , tempscreen&, Screen0to256&, (0, 0)-(w&, h&)
    _FREEIMAGE tempscreen&
    _DEST d&: _SOURCE s&
    _MEMFREE m
    TextScreenToImage256 = Screen0to256&
END FUNCTION

FUNCTION TextScreenToImage32& (image&)
    d& = _DEST: s& = _SOURCE
    DIM Plt(15) AS LONG
    _SOURCE image&
    FOR i = 0 TO 15: Plt(i) = _PALETTECOLOR(i, image&): NEXT
    f& = _FONT(image&)
    _FONT f&
    fw& = _FONTWIDTH
    fh& = _FONTHEIGHT
    w& = _WIDTH * _FONTWIDTH
    h& = _HEIGHT * _FONTHEIGHT '+ _HEIGHT
    l& = (_WIDTH * _HEIGHT) * 2 'The screen is width * height in pixels.  (80X25) = 2000 X 2 bytes each = 4000 total bytes to hold a page of screen 0 text and color
    tempscreen& = _NEWIMAGE(w&, h& + _HEIGHT, 32)
    Screen0to32& = _NEWIMAGE(w&, h&, 32)
    _DEST tempscreen&

    DIM m AS _MEM, b AS _UNSIGNED _BYTE, t AS STRING * 1
    DIM o AS _OFFSET
    m = _MEMIMAGE(image&)
    o = m.OFFSET

    _FONT f&

    FOR i = 0 TO l& - 2 STEP 2
        _MEMGET m, m.OFFSET + i, t
        _MEMGET m, m.OFFSET + i + 1, b
        IF b > 127 THEN b = b - 128
        fgc = b MOD 16: bgc = b \ 16
        COLOR _RGB32(_RED(fgc, image&), _GREEN(fgc, image&), _BLUE(fgc, image&)), _RGB32(_RED(bgc, image&), _GREEN(bgc, image&), _BLUE(bgc, image&))
        PRINT t;
    NEXT
    _PUTIMAGE , tempscreen&, Screen0to32&, (0, 0)-(w&, h&)
    _FREEIMAGE tempscreen&
    _DEST d&: _SOURCE s&
    _MEMFREE m
    TextScreenToImage32 = Screen0to32&
END FUNCTION