HROOT graph drawing app

gistfile1.txt

nix-shell ~/repo/src/HROOT/use.nix --arg "fficxxSrc"  ~/repo/src/fficxx --run "ghc graphApp.hs"

./graphApp

graphApp.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent    ( forkIO, threadDelay )
import Control.Monad         ( forever )
import Data.ByteString.Char8 ( ByteString )
import qualified Data.ByteString.Char8 as B
import qualified Data.Vector.Storable as VS
import Foreign.C.Types       ( CDouble, CInt )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Storable      ( poke )
import HROOT
import STD.Deletable (delete)


constructGraph :: [(Double,Double)] -> IO TGraph
constructGraph coords = do
  let xs = VS.fromList $ map (realToFrac . fst) coords
      ys = VS.fromList $ map (realToFrac . snd) coords
      n = fromIntegral $ length coords
  VS.unsafeWith xs $ \px -> VS.unsafeWith ys $ \py -> newTGraph n px py

readSample :: FilePath -> IO [(Double,Double)]
readSample fp = do
  txt <- readFile fp
  pure $ read txt

diff :: Double -> [Double] -> [Double]
diff dx ys = map (\(y,y') -> (y'-y)/dx) $ zip ys (tail ys)

mainApp :: (TCanvas -> IO ()) -> IO ()
mainApp drawingOn = do
  alloca $ \pargc -> do
    alloca $ \pargv -> do
      B.useAsCString "" $ \cs -> do
        poke pargc (0::CInt)
        poke pargv cs
        gsys <- gSystem
        tapp <- newTApplication ("test"::ByteString) pargc pargv
        tcanvas <- newTCanvas ("Test"::ByteString) ("Test"::ByteString) 640 480
        toggleEditor tcanvas
        toggleEventStatus tcanvas
        toggleToolBar tcanvas
        toggleToolTips tcanvas
 
        drawingOn tcanvas

        forkIO $ forever $ do
          threadDelay (1000000 `div` 60) -- every 1/60 sec
          update tcanvas
          paint tcanvas (""::ByteString)

        forever $ do
          threadDelay (1000000 `div` 60) -- every 1/60 sec
          processEvents gsys

        delete tapp


main :: IO ()
main =
  mainApp $ \tcanvas -> do
    cd tcanvas 0
    pad1 <- newTPad ("p1"::ByteString) ("p1"::ByteString) 0.0 0.5 1.0 1.0
    draw pad1 (""::ByteString)
    pad2 <- newTPad ("p2"::ByteString) ("p2"::ByteString) 0.0 0.0 1.0 0.5
    draw pad2 (""::ByteString)


    cd pad1 0
    spts <- readSample "/home/wavewave/repo/workspace/debounce/switch.dat"    
    g1 <- constructGraph spts
    setMinimumTGraph g1 (-0.1)
    setMaximumTGraph g1 (1.1)
    draw g1 ("AL"::ByteString)

    cd pad2 0
    cpts <- readSample "/home/wavewave/repo/workspace/debounce/control.dat"
    g2 <- constructGraph cpts
    setMinimumTGraph g2 (-0.1)
    setMaximumTGraph g2 (1.1)
    draw g2 ("AL"::ByteString)