A very primitive motion detection system using `fswebcam` utility for capturing images from webcam on Linux Dependencies: fswebcam, ImageMagic, GHC.

bmpdiff.hs

import Data.Binary.Get as BG
import Data.Binary.Put as BP

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Lazy as BL

import Data.Word
import Data.Int
import Data.Char
import Data.Bits (xor, shiftL)
import Data.Maybe

import System.IO
import Control.Monad (when)
import Control.Applicative ((<$>))
import System.Environment (getArgs)

int :: (Integral a, Num b) => a -> b
int = fromIntegral  -- to keep code less cluttered

data BitmapFileHeader = BmpFileHeader {
    bfhFileSize :: Word32,
    bfhImageOffset :: Word32
} deriving (Show, Eq)

data BitmapInfoHeader = BmpInfoHeader {
    bihSize :: Word32,
    bihWidth, bihHeight :: Int32,
    bihBitsPerPixel :: Word16,
    bihCompression :: Word32,
    bihImageSize :: Word32,
    bihHorResolution, bihVertResolution :: Word32
} deriving (Show, Eq)

data BitmapData = BmpData {
    bdBitsPerPixel :: Word16,
    bdData :: B.ByteString
} deriving (Show)

{-
 - Reading simple BMP files
 -}

binGetBFH :: Get BitmapFileHeader
binGetBFH = do
    magic <- getByteString 2
    when (magic /= BI.packChars "BM") $ error "BMP magic is invalid"
    bfhFileSize <- getWord32le
    skip 4
    bfhImageOffset <- getWord32le
    return $ BmpFileHeader bfhFileSize bfhImageOffset

binPutBFH :: BitmapFileHeader -> BP.Put
binPutBFH bfh = do
    putByteString $ BI.packChars "BM"
    putWord32le $ bfhFileSize bfh
    putWord32le 0
    putWord32le $ bfhImageOffset bfh

binGetBIH :: Get BitmapInfoHeader
binGetBIH = do
    bihWidth <- int <$> getWord32le
    bihHeight <- int <$> getWord32le
    nColorPlanes <- getWord16le
    when (nColorPlanes /= 1) $ error "Number of color planes must be 1"
    bitsPerPixel <- getWord16le
    compression <- getWord32le
    imageSize <- getWord32le
    horizResolution <- getWord32le
    vertResolution <- getWord32le
    skip 8
    return $ BmpInfoHeader 40 bihWidth bihHeight bitsPerPixel compression imageSize horizResolution vertResolution

binPutBIH bih = do
    mapM_ putWord32le [ bihSize bih, int $ bihWidth bih, int $ bihHeight bih ]
    mapM_ putWord16le [ 1, bihBitsPerPixel bih ]
    mapM_ putWord32le [ 0, bihImageSize bih, bihHorResolution bih, bihVertResolution bih ]
    putWord64le 0

bmpReadBMFileHeader :: Handle -> IO BitmapFileHeader
bmpReadBMFileHeader h = do
    hSeek h AbsoluteSeek 0
    bfhBytes <- BL.hGet h 14
    return $ BG.runGet binGetBFH bfhBytes

bmpReadBMInfoHeader :: Handle -> IO BitmapInfoHeader
bmpReadBMInfoHeader h = do
    bihSize <- (int . BG.runGet getWord32le) `fmap` BL.hGet h 4
    --when (bihSize /= 40) $ do
    --    error $ "Unknown format: not a BitmapInfoHeader, size of DIB is " ++ show bihSize
    
    bihBytes <- BL.hGet h $ int (bihSize - 4)
    let bih = runGet binGetBIH bihBytes
    return bih { bihSize = bihSize } 

bmpReadData :: BitmapFileHeader -> BitmapInfoHeader -> Handle -> IO B.ByteString
bmpReadData bfh bih h = do
    hSeek h AbsoluteSeek $ int (bfhImageOffset bfh)
    B.hGet h (int (bihImageSize bih))

bmpWriteBMFileHeader :: BitmapFileHeader -> Handle -> IO ()
bmpWriteBMFileHeader bfh h = do
    hSeek h AbsoluteSeek 0
    BL.hPut h $ BP.runPut (binPutBFH bfh)

bmpWriteBMInfoHeader :: BitmapInfoHeader -> Handle -> IO ()
bmpWriteBMInfoHeader bih h = 
    BL.hPut h $ BP.runPut (binPutBIH bih)

writeBmpFile :: FilePath -> BitmapFileHeader -> BitmapInfoHeader -> B.ByteString -> IO ()
writeBmpFile fname bfh bih bitmap = withFile fname WriteMode $ \h -> do
    bmpWriteBMFileHeader bfh h
    bmpWriteBMInfoHeader bih h
    hSeek h AbsoluteSeek (int $ bfhImageOffset bfh)
    B.hPut h bitmap

{-
 - Image processing
 -}

type RGBPixel = (Word8, Word8, Word8)

bytesToRGBs :: ByteString -> [RGBPixel]
bytesToRGBs bytes
    | B.length bytes < 3  = []
    | otherwise     = (r, g, b) : bytesToRGBs rest
        where (pix, rest) = B.splitAt 3 bytes
              [r, g, b] = B.unpack pix

rgbToBytes :: [RGBPixel] -> ByteString
rgbToBytes ps = B.pack $ rgbToBytes' ps
  where 
    rgbToBytes' []       = []
    rgbToBytes' ((r,g,b):pixels) = r : g : b : rgbToBytes' pixels

processData :: ByteString -> ByteString -> ByteString
processData data1 data2 = rgbToBytes $ zipWith pixelfunc pxs1 pxs2
  where
    pxs1 = bytesToRGBs data1
    pxs2 = bytesToRGBs data2

neutral_pixel = (0x80, 0x80, 0x80)

vectDiff :: RGBPixel -> RGBPixel -> (Int, Int, Int)
vectDiff (r1, g1, b1) (r2, g2, b2) = (int r1 - int r2, int g1 - int g2, int b1 - int b2)

sqrmod :: (Int, Int, Int) -> Int
sqrmod (r, g, b) = r * r + g * g + b * b

pixelfunc :: RGBPixel -> RGBPixel -> RGBPixel
pixelfunc (r1,g1,b1) (r2,g2,b2) = 
    if sqrmod (vectDiff neutral_pixel pix) > 0
    then pix
    else neutral_pixel
  where pix = (normDiff r1 r2, normDiff g1 g2, normDiff b1 b2)

{-| scale difference into [0..255] |-}
normDiff :: Word8 -> Word8 -> Word8
normDiff b1 b2 = b1 `div` 2 + 0x80 - b2 `div` 2

difffunc b1 b2 = 
    if xored < threshold then Nothing else Just xored
  where xored = b1 `xor` b2
        threshold = 0x40 --(max b1 b2 `shiftL` 2)

main = do
    args <- getArgs
    when (length args < 2) $ error "Usage: <program> <file>.bmp"
    
    let fname1 = args !! 0
    let fname2 = args !! 1
    withFile fname1 ReadMode $ \h1 ->
      withFile fname2 ReadMode $ \h2 -> do
        bfh1 <- bmpReadBMFileHeader h1
        bfh2 <- bmpReadBMFileHeader h2
        when (bfh1 /= bfh2) $ error "Different file formats"

        bih1 <- bmpReadBMInfoHeader h1
        bih2 <- bmpReadBMInfoHeader h2
        when (bih1 /= bih2) $ error "Different image formats"

        data1 <- bmpReadData bfh1 bih1 h1
        data2 <- bmpReadData bfh2 bih2 h2

        let xored = processData data1 data2
        writeBmpFile "diff.bmp" bfh1 bih1 xored

        let diffcount = length $ catMaybes $ zipWith difffunc (BI.unpackBytes data1) (BI.unpackBytes data2)
        putStrLn $ "Percent of pixels has changed: " 
        print $ diffcount * 100 `div` B.length data1

motion.sh

#!/bin/bash

INTERVAL=10
FROM_LAST_ALERT=60
STORAGE=$HOME/other/cam

cd $STORAGE

while true; do
    fswebcam new.jpeg 2>/dev/null
    convert new.jpeg new.bmp

    CHANGED=`./bmpdiff old.bmp new.bmp | sed -n 2p`
    TIMESTAMP=`date +%T`

    if [ $CHANGED -ge 20 ] ; then
        INTERVAL=1
        echo "[$TIMESTAMP]: interval $INTERVAL, changed ${CHANGED}%"
        cp new.jpeg cam${TIMESTAMP}.jpeg
        FROM_LAST_ALERT=0
    elif [ $CHANGED -ge 9 ] ; then
        INTERVAL=2
        echo "[$TIMESTAMP]: interval $INTERVAL, changed ${CHANGED}%"
        cp new.jpeg cam${TIMESTAMP}.jpeg
        FROM_LAST_ALERT=0
    else
        if [ $FROM_LAST_ALERT -ge 10 ] ; then
            INTERVAL=1
        else
            INTERVAL=2                                                                                                                                                                               
            echo "[$TIMESTAMP]: interval $INTERVAL, last alert ${FROM_LAST_ALERT}"
            cp new.jpeg cam${TIMESTAMP}.jpeg
            FROM_LAST_ALERT=$(($FROM_LAST_ALERT + 1))
        fi
    fi

    rm new.jpeg
    mv new.bmp old.bmp

    sleep $INTERVAL
done