URL: https://linuxfr.org/users/nokomprendo-3/journaux/un-serveur-de-webcam-en-35-lignes-de-haskell Title: Un serveur de webcam en 35 lignes de Haskell Authors: nokomprendo Date: 2018-12-14T10:54:16+01:00 License: CC By-SA Tags: haskell, développement_web et opencv Score: 23 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](https://framagit.org/nokomprendo/tuto_fonctionnel/tree/master/posts/tuto_fonctionnel_25/webcamer) ![](https://nokomprendo.frama.io/tuto_fonctionnel/posts/tuto_fonctionnel_25/images/webcamer.gif) # 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](https://opencv.org/), 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](https://github.com/LumiGuide/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. ```haskell {-# 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`. ```haskell 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](https://hackage.haskell.org/package/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. ```haskell 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`. ```html

webcamer

``` # 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](https://hackage.haskell.org/package/base/docs/Data-IORef.html) 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). ```haskell 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). ```haskell {-# 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) ```