Journal Un serveur de webcam en 35 lignes de Haskell

Sommaire

• Capture vidéo
• Serveur web
• Gérer plusieurs clients
• Récapitulatif

Pour mettre en place une webcam, on connecte une caméra à un ordinateur sur lequel on fait tourner un serveur retransmettant les images. Celles-ci sont alors accessibles via des requêtes au serveur.

Cet article présente comment implémenter un serveur de webcam en Haskell. Le serveur proposé transmet l'image courante en réponse aux requêtes HTTP. En parallèle (via un thread léger), il met également à jour l'image courante à partir du flux vidéo.

code source du projet

Capture vidéo

Tout d'abord, on a besoin d'ouvrir et de capturer le flux vidéo de la webcam. Ceci est très facile à faire avec OpenCV, une bibliothèque classique de traitement d'images et de vision artificielle. OpenCV est implémentée en C++ mais possède des interfaces pour de nombreux autres langages, notamment pour Haskell avec haskell-opencv.

Dans le code suivant, la fonction openCam ouvre le premier périphérique vidéo (id 0) et configure sa fréquence de rafraichissement à 5 images par seconde. Puis la fonction captureCam lit une image OpenCV (de type Mat ('S ['D, 'D]) 'D 'D) depuis le périphérique vidéo (de type VideoCapture). Enfin, la fonction imgToPng convertit une image OpenCV en image PNG affichage par un navigateur web.

{-# language DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent (forkIO)
import Control.Monad (forever, unless, liftM)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (fromStrict)
import Data.IORef (atomicWriteIORef, IORef, newIORef, readIORef)
import qualified Web.Scotty as SC

import OpenCV
import OpenCV.VideoIO.Types

openCam :: IO (Maybe VideoCapture)
openCam = do
    cap <- newVideoCapture
    exceptErrorIO $ videoCaptureOpen cap $ VideoDeviceSource 0 Nothing
    isOpened <- videoCaptureIsOpened cap
    case isOpened of
        False -> return Nothing
        True -> videoCaptureSetD cap VideoCapPropFps 5 >> (return $ Just cap)

captureCam :: VideoCapture -> IO (Maybe (Mat ('S ['D, 'D]) 'D 'D))
captureCam cap = videoCaptureGrab cap >> videoCaptureRetrieve cap 

imgToPng :: Mat ('S ['D, 'D]) 'D 'D -> ByteString
imgToPng = exceptError . imencode (OutputPng defaultPngParams)

On peut tester ces fonctions localement, avec le code suivant. La fonction loopCam lit une image (en utilisant captureCam), affiche cette image dans une fenêtre et boucle récursivement tant qu'on n'a pas appuyé sur la touche Echap. La fonction principale main se résume à ouvrir un périphérique vidéo (avec openCam), à créer une fenêtre et à lancer la boucle loopCam.

main :: IO ()
main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> withWindow "webcamer" (loopCam cap)

loopCam :: VideoCapture -> Window -> IO ()
loopCam cap window = do
    imgMaybe <- captureCam cap
    case imgMaybe of
        Nothing -> return ()
        Just img -> do
            imshow window img
            key <- waitKey 20
            unless (key == 27) $ loopCam cap window

Si on exécute ce code, on devrait avoir une fenêtre affichant le flux vidéo de la webcam à 5 FPS.

Serveur web

En utilisant la bibliothèque scotty, créons maintenant un serveur web qui va fournir le flux vidéo. À la place des fonctions main et loopCam précédentes, la fonction main suivante ouvre le périphérique vidéo et lance runServer. Cette fonction runServer lance un serveur scotty qui fournit deux routes. Pour la route principale "/", le serveur fournit la page principale (le fichier index.html). Pour la route "/out.png", il lit une image depuis la webcam, la convertit en PNG puis l'envoie au client HTTP.

main :: IO ()
main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> runServer 3042 cap

runServer :: Int -> VideoCapture -> IO ()
runServer port cap = SC.scotty port $ do
    SC.get "/" $ SC.file "index.html"
    SC.get "/out.png" $ do
        SC.setHeader "Content-Type" "image/png"
        imgMaybe <- SC.liftAndCatchIO $ liftM imgToPng <$> captureCam cap
        case imgMaybe of
            Nothing -> return ()
            Just img -> SC.raw $ fromStrict img

Ce serveur web envoie une image à la demande du client. Pour afficher le flux vidéo, le client doit donc régulièrement demander une nouvelle image. Ceci est fait dans la page index.html : la fonction updateImg demande la route "/out.png" au server puis met à jour la page HTML quand l'image a été reçue. Cette fonction est appelée toutes les 200 ms (c'est-à-dire à 5 FPS), grâce à la fonction JavaScript setInterval.

<!DOCTYPE html>
<html>
    <head>
        <meta charset="utf-8"/>
    </head>
    <body>
        <h1>webcamer</h1>
        <img id="my_img"> </img>
        <script>
            function updateImg() {
                fetch("out.png")
                    .then(response => response.blob())
                    .then(function(myBlob){
                        URL.revokeObjectURL(my_img.src);
                        my_img.src = URL.createObjectURL(myBlob);
                    });
            }
            const my_interval = setInterval(updateImg, 200);
        </script>
    </body>
</html>

Gérer plusieurs clients

Le serveur web précédent lit une image, depuis le flux vidéo, quand un client demande la route "/out.png". Cependant, ceci ne fonctionne plus s'il y a plusieurs clients car le flux vidéo ne fournit plus assez d'images. Pour résoudre ce problème, il suffit de lire le flux et de gérer les requêtes HTTP de façon indépendante.

Le code suivant utilise une référence mutable IORef pour stocker l'image courante. Cette image est lue dans la fonction runServer quand un client envoie une requête HTTP, et elle est modifiée dans la fonction runCam quand une nouvelle image est disponible depuis le flux vidéo. Finallement, la fonction main se résume à initialiser la référence mutable et à lancer runServer et runCam en parallèle, via forkIO (threads légers).

main :: IO ()
main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> do
            Just png0 <- liftM imgToPng <$> captureCam cap
            pngRef <- newIORef png0
            _ <- forkIO $ runCam cap pngRef
            runServer 3042 pngRef

runServer :: Int -> IORef ByteString -> IO ()
runServer port pngRef = SC.scotty port $ do
    SC.get "/" $ SC.file "index.html"
    SC.get "/out.png" $ do
        SC.setHeader "Content-Type" "image/png"
        img <- SC.liftAndCatchIO (readIORef pngRef) 
        SC.raw $ fromStrict img

runCam :: VideoCapture -> IORef ByteString -> IO ()
runCam cap pngRef = forever $ do
    imgMaybe <- liftM imgToPng <$> captureCam cap
    maybe (return ()) (atomicWriteIORef pngRef) imgMaybe

Ainsi, si plusieurs clients HTTP demandent une image alors qu'une seule image est disponible dans le flux vidéo durant ce laps de temps, le serveur envoie la même image et le flux s'affiche correctement chez tous les clients.

Récapitulatif

Le code final est résumé ci-dessous. Il gère la capture vidéo de la webcam, le service web et les clients multiples. Le tout en 35 lignes de Haskell (sans les commentaires ni les signatures de fonctions, mais fonctionnel quand même).

{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent (forkIO)
import Control.Monad (forever, liftM)
import Data.ByteString.Lazy (fromStrict)
import Data.IORef (atomicWriteIORef, newIORef, readIORef)
import Web.Scotty (get, file, raw, scotty, liftAndCatchIO, setHeader)
import OpenCV
import OpenCV.VideoIO.Types

main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> do
            Just png0 <- liftM imgToPng <$> captureCam cap
            pngRef <- newIORef png0
            _ <- forkIO $ runCam cap pngRef
            runServer 3042 pngRef

runServer port pngRef = scotty port $ do
    get "/" $ file "index.html"
    get "/out.png" $ do
        setHeader "Content-Type" "image/png"
        img <- liftAndCatchIO (readIORef pngRef) 
        raw $ fromStrict img

runCam cap pngRef = forever $ do
    imgMaybe <- liftM imgToPng <$> captureCam cap
    maybe (return ()) (atomicWriteIORef pngRef) imgMaybe

openCam = do
    cap <- newVideoCapture
    exceptErrorIO $ videoCaptureOpen cap $ VideoDeviceSource 0 Nothing
    isOpened <- videoCaptureIsOpened cap
    case isOpened of
        False -> return Nothing
        True -> videoCaptureSetD cap VideoCapPropFps 5 >> (return $ Just cap)

captureCam cap = videoCaptureGrab cap >> videoCaptureRetrieve cap 

imgToPng = exceptError . imencode (OutputPng defaultPngParams)