Permalink
Browse files

inital commit

  • Loading branch information...
0 parents commit 7a0cb300da62e5df0cb50a2252b93250b3c2e536 Rob Stewart committed Aug 8, 2011
Showing with 1,618 additions and 0 deletions.
  1. +5 −0 .gitignore
  2. +81 −0 Gps2HtmlReport/HTMLGenerator.hs
  3. +125 −0 Gps2HtmlReport/JourneyCharts.hs
  4. +102 −0 Gps2HtmlReport/JourneyStats.hs
  5. +45 −0 Gps2HtmlReport/Main.hs
  6. +40 −0 Gps2HtmlReport/OsmChart.hs
  7. +30 −0 LICENSE
  8. +66 −0 README.md
  9. +2 −0 Setup.hs
  10. +22 −0 gps2htmlReport.cabal
  11. +1,100 −0 gpx2png/gpx2png.pl
@@ -0,0 +1,5 @@
+dist
+*.o
+*.hi
+*.gpx
+*~
@@ -0,0 +1,81 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | The `HTMLGenerator' module generates the HTML content for the index.html generated
+module Gps2HtmlReport.HTMLGenerator where
+
+import Text.Html
+import Data.GPS hiding (src,link,href)
+import Text.Printf
+import Data.Time.Clock
+
+import Gps2HtmlReport.JourneyStats
+
+-- | Takes all the WayPoints and generates the HTML file
+generateHtmlPage :: [WptType] -> Html
+generateHtmlPage points =
+ let header1 = h1 $ stringToHtml "Journey Statistics"
+ header2 = h1 $ stringToHtml "Charts of the Journey"
+ header3 = h1 $ stringToHtml "OpenStreetMap Chart"
+ title = thetitle $ stringToHtml "GPX Track Report"
+ theStyle = style (stringToHtml cssContent) ! [thetype "text/css"]
+ theHeader = header $ concatHtml [title,theStyle]
+ mainArea = thediv (concatHtml [header1,statsTable points,br,header2,chartTable,header3,osmImg]) -- ! [identifier "main"]
+ theBody = body mainArea
+ in concatHtml [theHeader,theBody,pgFooter]
+
+-- | The OpenStreetMap image area
+osmImg :: Html
+osmImg = center $ image ! [src "osm.png"]
+
+-- | Takes all the WayPoints and calculates the journey statistics
+statsTable :: [WptType] -> Html
+statsTable points =
+ let tblHeader1 = th $ stringToHtml "Journey Details"
+ tblHeader2 = th $ stringToHtml "Elevation"
+ tblHeader3 = th $ stringToHtml "Speed"
+ distTravelled = printf "%.2f" $ journeyDistance points
+ maxElevation = printf "%.1f" $ snd (findPoint points (head points) ele (>))
+ minElevation = printf "%.1f" $ snd (findPoint points (head points) ele (<))
+ meanEle = printf "%.1f" $ meanElevation points
+ journeyMins = show $ round (journeyTime points) `div` 60
+ journeySecs = show $ round (journeyTime points) `rem` 60
+ mxSpd = printf "%.1f" $ maxSpeed points
+ meanSpd = printf "%.1f" $ meanJourneySpeed points
+ journeyDate = show $ dateOfJourney points
+ li1c1 = li $ stringToHtml ("Journey Date: "++ journeyDate)
+ li2c1 = li $ stringToHtml ("Distance Travelled: "++ distTravelled++"m")
+ li3c1 = li $ stringToHtml ("Journey Time: "++journeyMins++"m "++journeySecs++"s")
+ li1c2 = li $ stringToHtml ("Maximum Elevation: "++maxElevation++"m")
+ li2c2 = li $ stringToHtml ("Minimum Elevation: "++minElevation++"m")
+ li3c2 = li $ stringToHtml ("Mean Elevation: "++ meanEle++"m")
+ li1c3 = li $ stringToHtml ("Maximum speed: "++ mxSpd++"m/s")
+ li2c3 = li $ stringToHtml ("Mean speed: "++meanSpd++"m/s")
+ col1 = td (concatHtml [li1c1,li2c1,li3c1]) ! [valign "top"]
+ col2 = td (concatHtml [li1c2,li2c2,li3c2]) ! [valign "top"]
+ col3 = td (concatHtml [li1c3,li2c3]) ! [valign "top"]
+ row1 = tr $ concatHtml [tblHeader1,tblHeader2,tblHeader3]
+ row2 = tr $ concatHtml [col1,col2,col3]
+ tbl = table (concatHtml [row1,row2]) -- ! [cellspacing 10]
+ in center tbl
+
+-- | The CSS style text to format the rendering of the HTML page. It would be good to replace with Haskell HTML combinator library functions
+cssContent = "h1 {font-size: 22px;color: #335577;font-weight: bold; margin-top: 20px;margin-left: 70px;font-family: New Century Schoolbook, serif;} div { width: 900px; margin-top: 50px; margin:0 auto;} table {border-spacing: 20px 0px;} footer {text-align:right; background-color:#EEEEEE; width:900px; margin:0 auto; margin-top: 30px}"
+
+-- | The area holding the Cairo charts
+chartTable =
+ let img1 = image ! [src "chart1.png"]
+ img2 = image ! [src "chart2.png"]
+ cell1 = td img1
+ cell2 = td img2
+ row1 = tr $ concatHtml [cell1,cell2]
+ tbl = table row1
+ in center tbl
+
+-- | The footer
+pgFooter =
+ let projectLink = anchor (stringToHtml "gps2htmlReport") ! [href "https://github.com/robstewart57/Gps2HtmlReport"]
+ infoStr = stringToHtml "Report generated by "
+ in footer (concatHtml [infoStr,projectLink]) ! [identifier "main"]
+
+-- | This appears to be missing from the `html' package
+footer = tag "FOOTER"
@@ -0,0 +1,125 @@
+-- | This module uses the JourneyStats module to generate
+-- the statistics about the journey WayPoints, then
+-- uses the Cairo bindings to generate the charts
+module Gps2HtmlReport.JourneyCharts where
+
+import Data.GPS
+import Data.Maybe
+import qualified Graphics.Rendering.Cairo as C
+import Graphics.Rendering.Cairo
+import Graphics.Rendering.Chart
+import Graphics.Rendering.Chart.Simple
+import Graphics.Rendering.Chart.Gtk
+import Graphics.Rendering.Chart.Grid
+import System.Environment(getArgs)
+import System.Random
+import Data.Time.LocalTime
+import Data.Accessor
+import Data.Accessor.Tuple
+import Data.Colour
+import Data.Colour.Names
+import Data.Colour.SRGB
+import Text.XML.XSD.DateTime
+
+import Gps2HtmlReport.JourneyStats
+
+data OutputType = Window | PNG | PS | PDF | SVG
+
+chooseLineWidth Window = 1.0
+chooseLineWidth PNG = 1.0
+chooseLineWidth PDF = 0.25
+chooseLineWidth PS = 0.25
+chooseLineWidth SVG = 0.25
+
+-- | Generates the Cairo chart showing speed and elevation over time
+speedAndElevationOverTimeChart :: [WptType] -> OutputType -> Renderable ()
+speedAndElevationOverTimeChart points otype = toRenderable layout
+ where
+ layout = layout1_title ^="Speed, Average Speed & Elevation"
+ $ layout1_title_style ^= defaultFontStyle { font_size_ = 12.0 }
+ $ layout1_background ^= solidFillStyle (opaque white)
+ $ layout1_right_axis ^= defaultLayoutAxis { laxis_title_ = "Elevation (metres)", laxis_override_ = axisGridHide }
+ $ layout1_left_axis ^: laxis_title ^= "Speed (metres)"
+ $ layout1_plots ^= [ Right (toPlot elevationArea),
+ Left (toPlot speedLine),
+ Left (toPlot avrSpeedLine)
+ ]
+ $ setLayout1Foreground fg
+ $ defaultLayout1
+
+ lineStyle c = line_width ^= 1 * chooseLineWidth otype
+ $ line_color ^= c
+ $ defaultPlotLines ^. plot_lines_style
+
+ theSpeeds = [(theTime,spd) | (theTime,spd) <- speedAtPoints points]
+
+ speedLine = plot_lines_style ^= lineStyle (opaque blue)
+ $ plot_lines_values ^= [[ (theTime,speed) | (theTime,speed) <- theSpeeds]]
+ $ plot_lines_title ^= "Speed"
+ $ defaultPlotLines
+
+ avrSpeedLine = plot_lines_style ^= lineStyle (red `withOpacity` 0.5)
+ $ plot_lines_values ^= [[ (theTime,speed) | (theTime,speed) <- avrSpeedOverTime theSpeeds 0.0 0.0 []]]
+ $ plot_lines_title ^= "Avr Speed"
+ $ defaultPlotLines
+
+ elevationArea = plot_fillbetween_style ^= solidFillStyle (green `withOpacity` 0.1)
+ $ plot_fillbetween_values ^= [ (theTime,(0,elevation)) | (theTime,elevation) <- ptsElevation points]
+ $ plot_fillbetween_title ^= "Elevation"
+ $ defaultPlotFillBetween
+
+ fg = opaque black
+
+
+-- | Generates the Cairo chart showing accumulative distance and elevation over time, with spots showing maximum and minimum elevation points
+accumDistanceAndElevationChart :: [WptType] -> OutputType -> Renderable ()
+accumDistanceAndElevationChart points otype = toRenderable layout
+ where
+ layout = layout1_title ^="Accumulative Distance & Elevation"
+ $ layout1_title_style ^= defaultFontStyle { font_size_ = 12.0 }
+ $ layout1_background ^= solidFillStyle (opaque white)
+ $ layout1_right_axis ^= defaultLayoutAxis { laxis_title_ = "Distance (metres)", laxis_override_ = axisGridHide }
+ $ layout1_left_axis ^: laxis_title ^= "Elevation (metres)"
+ $ layout1_plots ^= [ Right (toPlot accumDistanceArea),
+ Left (toPlot elevationLine),
+ Left (toPlot spots)
+ ]
+ $ setLayout1Foreground fg
+ $ defaultLayout1
+
+ lineStyle c = line_width ^= 1 * chooseLineWidth otype
+ $ line_color ^= c
+ $ defaultPlotLines ^. plot_lines_style
+
+ elevationLine = plot_lines_style ^= lineStyle (opaque black)
+ $ plot_lines_values ^= [[ (theTime,elevation) | (theTime,elevation) <- ptsElevation points]]
+ $ plot_lines_title ^= "Elevation"
+ $ defaultPlotLines
+
+ accumDistanceArea = plot_fillbetween_style ^= solidFillStyle (red `withOpacity` 0.2)
+ $ plot_fillbetween_values ^= [ (theTime,(0,accumDist)) | (theTime,accumDist) <- accumDistance points 0.0]
+ $ plot_fillbetween_title ^= "Distance"
+ $ defaultPlotFillBetween
+
+ spotMaxPoint = let (a,b) = findPoint points (head points) ele (>)
+ in (a,b,5::Double)
+
+ spotMinPoint = let (a,b) = findPoint points (head points) ele (<)
+ in (a,b,5::Double)
+
+ spots = area_spots_title ^= "Altitude"
+ $ area_spots_max_radius ^= 5
+ $ area_spots_values ^= [spotMinPoint,spotMaxPoint]
+ $ defaultAreaSpots
+
+ fg = opaque black
+
+renderToPng :: (t, OutputType -> Renderable a) -> FilePath -> IO (PickFn a)
+renderToPng (n,ir) = renderableToPNGFile (ir Window) 384 288
+
+chart1 :: [WptType] -> ([Char], OutputType -> Renderable ())
+chart1 points = ("speedAndElevationOverTimeChart", speedAndElevationOverTimeChart points)
+
+chart2 :: [WptType] -> ([Char], OutputType -> Renderable ())
+chart2 points = ("accumDistanceAndElevationChart", accumDistanceAndElevationChart points)
+
@@ -0,0 +1,102 @@
+-- | This module provides the JourneyCharts and HTMLGenerator
+-- modules with statistics for the charts, and the journey statistics
+module Gps2HtmlReport.JourneyStats where
+
+import Data.GPS hiding (speed)
+import Data.Maybe
+import System.Random
+import Data.Time.LocalTime
+import Data.Time.Clock
+import Data.Time.Calendar
+import Data.Colour
+import Data.Colour.Names
+import Data.Colour.SRGB
+import Text.XML.XSD.DateTime
+
+-- | Takes all WayPoints, and creates a list of tuples containing (TimeStamp,Elevation)
+ptsElevation :: [WptType] -> [(LocalTime,Double)]
+ptsElevation = map (\point -> (utcToLocalTime dfltTZ (Text.XML.XSD.DateTime.toUTCTime (fromJust $ time point)) , fromJust $ ele point))
+
+-- | Takes all WayPoints, and creates a list of tuples containing (TimeStamp,AvrSpeedAtThisPoint)
+avrSpeedOverTime :: [(LocalTime,Speed)] -> Double -> Double -> [(LocalTime,Speed)] -> [(LocalTime,Speed)]
+avrSpeedOverTime [spd] totalSpeed numPoints iteratedAvr = iteratedAvr ++ [(fst spd, (snd spd + totalSpeed) / (numPoints+1))]
+avrSpeedOverTime (spd:spds) totalSpeed numPoints iteratedAvr = avrSpeedOverTime [spd] totalSpeed numPoints iteratedAvr ++ avrSpeedOverTime spds (snd spd + totalSpeed) (numPoints+1) iteratedAvr
+
+-- | Takes all WayPoints, and creates a list of tuples containing (TimeStamp,SpeedAtThisPoint)
+speedAtPoints :: [WptType] -> [(LocalTime,Speed)]
+speedAtPoints points = speedAtPoints' (head points) (tail points)
+
+speedAtPoints' :: WptType -> [WptType] -> [(LocalTime, Speed)]
+speedAtPoints' prev [x]
+ | isJust (time x) = [(lclTime $ fromJust (time x), fromJust $ speed prev x)]
+ | otherwise = []
+speedAtPoints' prev (x:xs)
+ | isJust (time x) = (lclTime $ fromJust (time x), fromJust $ speed prev x) : speedAtPoints' x xs
+ | otherwise = [] ++ speedAtPoints' x xs
+
+-- | Takes all WayPoints, and creates a list of tuples containing (TimeStamp,JourneyDistanceAtPoint)
+accumDistance :: [WptType] -> Double -> [(LocalTime,Distance)]
+accumDistance [x] acc = [(lclTime $ fromJust (time x),0.0)]
+accumDistance (x:xs) acc =
+ let dist = distance x (head xs)
+ in (lclTime $ fromJust (time x), dist + acc ) : accumDistance (tail xs) (dist + acc)
+
+-- | Takes all WayPoints, an element in wptType, and an Eq function, returning a single WayPoint
+findPoint :: [WptType] -> WptType -> (WptType -> Maybe Double) -> (Double -> Double -> Bool) -> (LocalTime,Double)
+findPoint (point:points) currSelected wayPointElement equalityF
+ | equalityF (fromJust $ wayPointElement point) (fromJust $ wayPointElement currSelected) = findPoint points point wayPointElement equalityF
+ | otherwise = if null points
+ then (lclTime (fromJust $ time currSelected), fromJust $ ele currSelected)
+ else findPoint points currSelected wayPointElement equalityF
+
+-- | Calculates the total journey distance
+journeyDistance :: (Lat a, Lon a) => [a] -> Distance
+journeyDistance [point] = 0.0
+journeyDistance (point:points) = distance point (head points) + journeyDistance points
+
+-- | Calculates the average speed of the journey
+meanJourneySpeed :: (Lat a, Lon a) => [a] -> Distance
+meanJourneySpeed points = journeyDistance points / fromIntegral (length points)
+
+-- | Calculates the maximum speed
+maxSpeed :: [WptType] -> Speed
+maxSpeed points =
+ let speedTuple = speedAtPoints points
+ speedList = map snd speedTuple
+ maxSpeed = foldr max 0.0 speedList
+ in maxSpeed
+
+-- | Calculates the average elevation throughout the journey
+meanElevation :: Ele a => [a] -> Double
+meanElevation points =
+ let elevationVals = map (fromJust . ele) points
+ totalElevation = foldr (+) 0.0 elevationVals
+ theMean = totalElevation / fromIntegral (length points)
+ in theMean
+
+-- | Calculates the total journey time
+journeyTime :: Time a => [a] -> NominalDiffTime
+journeyTime points =
+ let startTime = toUTCTime (fromJust (time $ head points))
+ endTime = toUTCTime (fromJust (time $ last points))
+ in diffUTCTime endTime startTime
+
+-- | Extracts the date of the journey (from the first WayPoint)
+dateOfJourney :: Time a => [a] -> Day
+dateOfJourney points = utctDay $ toUTCTime $ fromJust (time $ head points)
+
+lclTime :: DateTime -> LocalTime
+lclTime dteTime = utcToLocalTime dfltTZ (Text.XML.XSD.DateTime.toUTCTime dteTime)
+
+dfltTZ :: TimeZone
+dfltTZ = TimeZone {timeZoneMinutes=0,timeZoneSummerOnly=False,timeZoneName="GMT"}
+
+-- | Overides the `speed' function in the `gps' package
+speed :: (Lat loc, Lon loc, Time loc) => loc -> loc -> Maybe Speed
+speed a b =
+ case (getUTCTime b, getUTCTime a) of
+ (Just x, Just y) -> Just $ distance a b / realToFrac (diffUTCTime x y)
+ _ -> Nothing
+
+getUTCTime :: (Lat a, Lon a, Time a) => a -> Maybe UTCTime
+getUTCTime = fmap toUTCTime . time
@@ -0,0 +1,45 @@
+module Main where
+
+import Data.GPS
+import qualified Graphics.Rendering.Cairo as C
+import Graphics.Rendering.Chart
+import Graphics.Rendering.Chart.Simple
+import Graphics.Rendering.Chart.Gtk
+import Graphics.Rendering.Chart.Grid
+import System.FilePath
+import System.Directory
+import System.Process
+import System.Environment
+import Text.Html
+
+import Gps2HtmlReport.OsmChart
+import Gps2HtmlReport.HTMLGenerator
+import Gps2HtmlReport.JourneyCharts
+
+-- | Reads the current directory for all .gpx files, then maps to `generateReport' for each one
+main :: IO [()]
+main = do
+ curDir <- getCurrentDirectory
+ allFiles <- getDirectoryContents curDir
+ let allFilesSplit = map splitExtension allFiles
+ let gpxFiles = filter (\(a,b) -> b==".gpx") allFilesSplit
+ putStr ("Processing "++show (length gpxFiles)++" file(s)...\n")
+ mapM (\(a,b) -> generateReport (curDir++"/"++a) (a++b)) gpxFiles
+
+-- | Creates empty directory for each web report
+createEmptyDir :: FilePath -> IO ()
+createEmptyDir dir = do
+ exists <- doesDirectoryExist dir
+ (if exists then removeDirectoryRecursive dir >> createDirectory dir else createDirectory dir)
+
+-- | Generates the HTML report for each .gpx file
+generateReport :: FilePath -> FilePath -> IO ()
+generateReport webDir gpxFile = do
+ points <- readGPX gpxFile
+ createEmptyDir webDir
+ renderToPng (chart1 points) (webDir++"/chart1.png")
+ renderToPng (chart2 points) (webDir++"/chart2.png")
+ writeFile (webDir++"/index.html") $ renderHtml $ generateHtmlPage points
+ createOsmMap webDir gpxFile
+ putStr $ "Processing '"++gpxFile++"' complete. Report saved in: "++webDir++"/index.html\n"
+ return ()
Oops, something went wrong.

0 comments on commit 7a0cb30

Please sign in to comment.