Bitmap file library

rizzix · **Posted:** Fri Nov 14, 2003 6:45 pm

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

rizzix · **Posted:** Fri Nov 14, 2003 6:48 pm

---
EDIT: my bad u can use any program to create a bmp file so long as its not compressed.

M$ paint works too!

rizzix · **Posted:** Fri Nov 14, 2003 7:43 pm

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

Tony · **Posted:** Fri Nov 14, 2003 7:55 pm

wow, crazy stuff... I'll check it out in detail when I get time, so far it looks awesome Very Happy

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members