Computer Science Canada

Bitmap file library
Author:  rizzix [ Fri Nov 14, 2003 6:45 pm ]
Post subject:  Bitmap file library
here's a class thats quite usefull. it lets u read each pixel from a 24bit and a monochrome bitmap file directly

the monochrome mode is giving me problems.. if u guys figure out whats wrong do post.

code:

class RGBQUAD
    export var rgbBlue, var rgbGreen, var rgbRed, var rgbReserved
    var rgbBlue : nat1
    var rgbGreen : nat1
    var rgbRed : nat1
    var rgbReserved : nat1
end RGBQUAD

class MONOCHROMESET
    export var color1, var color2, getColor, setBit, isSet

    var color1, color2 : int
    color1 := black
    color2 := white
    var bit : boolean := false

    fcn getColor : int
        if bit = true then
            result color1
        else
            result color2
        end if
    end getColor

    fcn isSet : boolean
        result bit
    end isSet

    proc setBit
        bit := true
    end setBit
end MONOCHROMESET

class Rectangle
    export x, y, w, h, setDimensions, setLocation

    var ix, iy : int
    var width, height : int

    proc setLocation (x, y : int)
        ix := x
        iy := y
    end setLocation

    proc setDimensions (w, h : int)
        width := w
        height := h
    end setDimensions


    fcn x : int
        result ix
    end x
    fcn y : int
        result iy
    end y
    fcn w : int
        result width
    end w
    fcn h : int
        result height
    end h

end Rectangle


class Image
    import Rectangle
    export Destruct, draw, getBounds, getInfoAt

    var bounds : ^Rectangle
    new bounds
    var file : string
    new bounds

    fcn getBounds : ^Rectangle
        result bounds
    end getBounds

    deferred proc draw

    deferred fcn getInfoAt (x, y : int) : ^anyclass

    proc Destruct
        free bounds
    end Destruct
end Image

class BitmapFile
    inherit Image
    import RGBQUAD, MONOCHROMESET
    export Construct, BITMAPFILEHEADER, BITMAPINFOHEADER,
        MONOCHROME, COLOR_16, COLOR_256, COLOR_16M, getFileHeader, setFileHeader,
        getInfoHeader, setInfoHeader

    % --constants--
    const MONOCHROME := 1
    const COLOR_16 := 4
    const COLOR_256 := 8
    const COLOR_16M := 24

    type BITMAPFILEHEADER :         % defaults               % location in file
        record
            bfType : nat2           %:= 19778                       % 1
            bfSize : nat4           %:= ??                          % 3
            bfReserved1 : nat2      %:= 0                           % 7
            bfReserved2 : nat2      %:= 0                           % 9
            bfOffBits : nat4        %:= 1078                        % 11
        end record

    type BITMAPINFOHEADER :
        record
            biSize : nat4           %:= 40                          % 15
            biWidth : int4          %:= 100                         % 19
            biHeight : int4         %:= 100                         % 23
            biPlanes : nat2         %:= 1                           % 27
            biBitCount : nat2       %:= COLOR_256                   % 29
            biCompression : nat4    %:= 0                           % 31
            biSizeImage : nat4      %:= 0                           % 35
            biXPelsPerMeter : int4  %:= 0                           % 39
            biYPelsPerMeter : int4  %:= 0                           % 43
            biClrUsed : nat4        %:= 0                           % 47
            biClrImportant : nat4   %:= 0                           % 51
        end record

    % --variables--
    var bitmapBits : flexible array 0 .. 0 of ^anyclass
    bounds -> setLocation (0, maxy)
    var fileName : string
    var byteWidth, padding : nat4
    var bitmapFileHeader : BITMAPFILEHEADER
    var bitmapInfoHeader : BITMAPINFOHEADER

    var bit : array 1 .. 8 of nat1
    bit (1) := 2#00000001
    bit (2) := 2#00000010
    bit (3) := 2#00000100
    bit (4) := 2#00001000
    bit (5) := 2#00010000
    bit (6) := 2#00100000
    bit (7) := 2#01000000
    bit (8) := 2#10000000


    fcn getFileHeader : BITMAPFILEHEADER
        result bitmapFileHeader
    end getFileHeader

    fcn getInfoHeader : BITMAPINFOHEADER
        result bitmapInfoHeader
    end getInfoHeader

    proc setFileHeader (p : BITMAPFILEHEADER)
        bitmapFileHeader := p
    end setFileHeader

    proc setInfoHeader (p : BITMAPINFOHEADER)
        bitmapInfoHeader := p
    end setInfoHeader


    proc _readBitmapFileHeader (sn : int)
        read : sn, bitmapFileHeader.bfType
        read : sn, bitmapFileHeader.bfSize
        read : sn, bitmapFileHeader.bfReserved1
        read : sn, bitmapFileHeader.bfReserved2
        read : sn, bitmapFileHeader.bfOffBits
    end _readBitmapFileHeader


    proc _readBitmapInfoHeader (sn : int)
        read : sn, bitmapInfoHeader.biSize
        read : sn, bitmapInfoHeader.biWidth
        read : sn, bitmapInfoHeader.biHeight
        read : sn, bitmapInfoHeader.biPlanes
        read : sn, bitmapInfoHeader.biBitCount
        read : sn, bitmapInfoHeader.biCompression
        read : sn, bitmapInfoHeader.biSizeImage
        read : sn, bitmapInfoHeader.biXPelsPerMeter
        read : sn, bitmapInfoHeader.biYPelsPerMeter
        read : sn, bitmapInfoHeader.biClrUsed
        read : sn, bitmapInfoHeader.biClrImportant
    end _readBitmapInfoHeader


    fcn _getPos (sn : int) : int
        var pos : int
        tell : sn, pos
        result pos
    end _getPos


    proc _read24BitData (sn : int)
        var r, g, b : nat1
        var rgbQuad : ^RGBQUAD
        var byteCount : nat4 := 0

        seek : sn, bitmapFileHeader.bfOffBits
        for i : 0 .. (bounds -> h * bounds -> w) - 1
            read : sn, b
            read : sn, g
            read : sn, r
            byteCount += 3
            new rgbQuad
            rgbQuad -> rgbBlue := b
            rgbQuad -> rgbGreen := g
            rgbQuad -> rgbRed := r
            bitmapBits (i) := rgbQuad
            if byteCount mod byteWidth = 0 then
                seek : sn, _getPos (sn) + padding
                byteCount := 0
            end if
        end for
    end _read24BitData


    proc _readMonochromeData (sn : int)
        var cbit8 : nat1 := 0
        var tmp : ^MONOCHROMESET := nil
        var byteCount, c : nat := 0

        seek : sn, bitmapFileHeader.bfOffBits
        for k : 0 .. (bounds -> h * bounds -> w) - 1 by 8
            read : sn, cbit8
            for decreasing i : 8 .. 1
                if c > bounds -> w * bounds -> h - 1 then
                    exit
                end if
                new tmp
                if (cbit8 and bit (i)) = bit (i) then
                    tmp -> setBit
                end if
                bitmapBits (c) := tmp
                c += 1
            end for
            byteCount += 1
            if byteCount mod byteWidth = 0 then
                byteCount := 0
                seek : sn, _getPos (sn) + padding
            end if
        end for
    end _readMonochromeData


    proc Construct (name : string)
        fileName := name
        var sn : int
        open : sn, fileName, read, seek

        seek : sn, 0
        _readBitmapFileHeader (sn)
        _readBitmapInfoHeader (sn)
       
        byteWidth := ceil (bitmapInfoHeader.biWidth * (bitmapInfoHeader.biBitCount / 8))
        padding := 4 - (byteWidth mod 4)
        if padding = 4 then
            padding := 0
        end if

        bounds -> setDimensions (bitmapInfoHeader.biWidth, bitmapInfoHeader.biHeight)
        new bitmapBits, (bounds -> h * bounds -> w) - 1

        case bitmapInfoHeader.biBitCount of
            label COLOR_16M :
                _read24BitData (sn)
            label MONOCHROME :
                _readMonochromeData (sn)
            label :
                assert false         % if u've reached here, it's probably cuz ur using a colour
                %                      resolution that is not implemented yet
        end case
        close : sn
    end Construct


    body fcn getInfoAt (x, y : int) : ^anyclass
        var tmp : ^anyclass := nil
        tmp := bitmapBits (((bounds -> h - y) * bounds -> w) - (bounds -> w - x))
        result tmp
    end getInfoAt


    body proc draw
        var tmp : ^anyclass
        var colr : int := RGB.AddColour (0, 0, 0)
        case bitmapInfoHeader.biBitCount of
            label COLOR_16M :
                for y : 0 .. bounds -> h - 1 by 1
                    for x : 0 .. bounds -> w - 1 by 1
                        tmp := getInfoAt (x, y)
                        RGB.SetColour (colr, RGBQUAD (tmp).rgbRed / 255, RGBQUAD (tmp).rgbGreen / 255, RGBQUAD (tmp).rgbBlue / 255)
                        drawdot (bounds -> x + x, bounds -> y - y, colr)
                    end for
                end for
            label MONOCHROME :
                for y : 0 .. bounds -> h - 1 by 1
                    for x : 0 .. bounds -> w - 1 by 1
                        tmp := getInfoAt (x, y)
                        colr := MONOCHROMESET (tmp).getColor
                        drawdot (bounds -> x + x, bounds -> y - y, colr)
                    end for
                end for
            label :
                assert false             % if u've reached here, it's probably cuz ur using a colour
                %                          resolution that is not implemented yet
        end case
    end draw


    body proc Destruct
        for i : 0 .. (bounds -> h * bounds -> w) - 1
            if bitmapBits (i) not= nil then
                free bitmapBits (i)
            end if
        end for
        free bitmapBits
        Image.Destruct
    end Destruct
end BitmapFile




here's how u can use this class. do make sure u call the destructor before freeing the object Smile


var img : ^BitmapFile
new img
img -> Construct ("pic.bmp")
img -> draw
img -> Destruct
free img


u can use the getInfoAt(x,y) function to get colour data (it depends on the mode of the file) from each pixel
Author:  rizzix [ Fri Nov 14, 2003 6:48 pm ]
Post subject: 
---
EDIT: my bad u can use any program to create a bmp file so long as its not compressed.

M$ paint works too!
Author:  rizzix [ Fri Nov 14, 2003 7:43 pm ]
Post subject: 
fixed the colour problems so for 24bit bitmap files np Smile

i might as well inform u on my findings...
RGB.AddColour really is buggy dont use it for accurate rgb mixing

what u can do is create a new colour like this:
var colr : int := RGB.AddColour(0,0,0) with some dummy values

then we use the RGB.SetColour proc, setting the colour colr to the desired rgb components.


well thats just incase u don't already know Neutral
Author:  Tony [ Fri Nov 14, 2003 7:55 pm ]
Post subject: 
wow, crazy stuff... I'll check it out in detail when I get time, so far it looks awesome Very Happy

:


You can syndicate this boards posts using the file backend.php or view the topic map using sitemap.php.

Terms of Use | Privacy Policy