Skip to content
Browse files

Now using setBrush from gd package, to draw the track on the OSM imag…

…e, using an 5x5 image. This means that the images are rendered much more quickly. Also now properly exposes appropriate functions in modules
  • Loading branch information...
1 parent d06bcdc commit fd5efd3fed26ad03dbc7aaa1078fa4d57f08eff1 Rob Stewart committed Dec 25, 2011
View
76 Data/GPS/Gps2HtmlReport/DrawOsm.hs
@@ -1,9 +1,10 @@
-module Data.GPS.Gps2HtmlReport.DrawOsm where
+module Data.GPS.Gps2HtmlReport.DrawOsm (
+ generateOsmMap -- :: String -> [WptType] -> IO ()
+ ) where
import Prelude
import Data.GPS
-import Graphics.Transform.Magick.Types hiding (Image, minimum, maximum)
import Network.HTTP.Enumerator
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
@@ -15,17 +16,13 @@ import Data.Maybe
import Data.GPS.Gps2HtmlReport.JourneyStats
baseurl = "http://tile.openstreetmap.org"
-tilesprefix = "tile"
-tilesourcename = "osmrender"
--- zoom = 16::Int
data TileCoords = TileCoords { minX :: Int
, maxX :: Int
, minY :: Int
, maxY :: Int
}
-
tileNumbers :: Double -> Double -> Int -> [(Int,Int)]
tileNumbers latitude longitude zoom =
let xtile = ((longitude+180) / 360) * fromInteger (shift (1::Integer) zoom)
@@ -67,17 +64,8 @@ determineTiles (wpt:wpts) tCoords zoom =
let tileScope = determineTiles [wpt] tCoords zoom
in determineTiles wpts tileScope zoom
-deltaLat :: TileCoords -> Int
-deltaLat tCoords = maxX tCoords - minX tCoords
-
-deltaLong :: TileCoords -> Int
-deltaLong tCoords = maxY tCoords - minY tCoords
-
maxNumAutoTiles = 32
-zoom :: TileCoords -> Int
-zoom = zoomCalc
-
zoomCalc :: TileCoords -> Int
zoomCalc tCoords =
let numxtiles = maxX tCoords - minX tCoords + 1
@@ -100,17 +88,11 @@ selectedTiles tCoords =
maxy = maxY tCoords
in [(i,j) | i <- [minx..maxx], j <- [miny..maxy]]
--- | Formats the filename string
-filenameStr :: (Show a, Show a1) => a -> a1 -> String
-filenameStr xTile yTile = tilesprefix ++ tilesourcename ++ "-z"++show zoom++"-x"++show xTile++"-y"++show yTile++".png"
-- | Formats the URL string
urlStr xTile yTile zoom = baseurl ++"/"++show zoom++"/"++show xTile++"/"++show yTile++".png"
-rectangle :: Int -> Int -> Graphics.Transform.Magick.Types.Rectangle
-rectangle x' y' = Rectangle {width=256, height=256, x = x'*256, y = y'*256}
-
-- | Takes the URL of a given OSM tile and uses curl to download it
downloadFile :: String -> IO Image
downloadFile url = do
@@ -167,34 +149,31 @@ pixelPosForCoord [wpt] tCoord zoom =
y = round $ (lat' - north) * 256.0 / (south - north) + fromIntegral yoffset
in (x,y)
+
-- | Takes the 'WptType' and draws lines between every
-- point to point connection in the 'Trail'
-drawLines :: [WptType] -> TileCoords -> Image -> Int -> IO Image
-drawLines [] _ img _ = return img
-drawLines [_] _ img _ = return img
-drawLines (wpt:wpts) tCoord img zoom = do
+drawLines :: [WptType] -> TileCoords -> Image -> Image -> Int -> IO ()
+drawLines [] _ _ _ _ = return ()
+drawLines [_] _ _ _ _ = return ()
+drawLines (wpt:wpts) tCoord img lineImg zoom = do
let start = pixelPosForCoord [wpt] tCoord zoom
end = pixelPosForCoord [head wpts] tCoord zoom
minEle = fromMaybe 0 $ fmap snd $ findPoint wpts wpt ele (<)
maxEle = fromMaybe 0 $ fmap snd $ findPoint wpts wpt ele (>)
- drawLine' start end img (minEle,fromMaybe 0 $ ele wpt,maxEle) 0
- drawLines wpts tCoord img zoom
-
--- | This is a fix on the fact that the 'drawLine' function
--- provided by the GD bindings do not provid a `width' parameter
-drawLine' :: Point -> Point -> Image -> (Double,Double,Double) -> Int -> IO ()
-drawLine' start end img (minEle,ele',maxEle) i
- | i < 4 = do
- drawLine (fst start+(i-2),snd start-(i-2)) (fst end+(i-2),snd end-(i-2)) color' img
- drawLine (fst start+(i+2),snd start-(i-2)) (fst end+(i+2),snd end-(i-2)) color' img
- drawLine (fst start+(i+2),snd start-(i+2)) (fst end+(i+2),snd end-(i+2)) color' img
- drawLine (fst start+(i-2),snd start-(i+2)) (fst end+(i-2),snd end-(i+2)) color' img
- drawLine' start end img (minEle,ele',maxEle) (i+1)
- | otherwise = return ()
- where range = maxEle - minEle
- x' = ele' - minEle
- x'' = x' / range
- color' = lineColor $ round $ 255.0*x''
+ drawLine' start end img lineImg (minEle,fromMaybe 0 $ ele wpt,maxEle)
+ drawLines wpts tCoord img lineImg zoom
+
+-- | Sets the colour for a single line segment in the track,
+-- and
+drawLine' :: Point -> Point -> Image -> Image -> (Double,Double,Double) -> IO ()
+drawLine' start end img lineImg (minEle,ele',maxEle) = do
+ fillImage color lineImg
+ setBrush img lineImg
+ drawLine (fst start,snd start) (fst end,snd end) (unPCREOption brushed) img
+ where range = maxEle - minEle
+ x' = ele' - minEle
+ x'' = x' / range
+ color = lineColor $ round $ 255.0*x''
-- | Uses a sliding scale for the red value in the RGB Color
-- to show a sliding color from green to yellow in accordance
@@ -235,8 +214,9 @@ generateOsmMap webDir points = do
let tiles = determineTiles points initCoords 16
zoom = zoomCalc tiles
tiles' = determineTiles points initCoords zoom
- backgroundImg <- makeOSMLayer tiles' zoom
- imgWithLines <- drawLines points tiles' backgroundImg zoom
- resizedImg <- fitToWidth imgWithLines
- addCopyright resizedImg
- savePngFile (webDir++"/osm.png") resizedImg
+ img <- makeOSMLayer tiles' zoom
+ lineImg <- newImage (5,5)
+ drawLines points tiles' img lineImg zoom
+ fitToWidth img
+ addCopyright img
+ savePngFile (webDir++"/osm.png") img
View
8 Data/GPS/Gps2HtmlReport/HTMLGenerator.hs
@@ -1,13 +1,15 @@
-- | The `HTMLGenerator' module generates the HTML content for the index.html generated
-module Data.GPS.Gps2HtmlReport.HTMLGenerator where
+module Data.GPS.Gps2HtmlReport.HTMLGenerator (
+ generateHtmlPage -- :: [WptType] -> Html
+ ) where
import Text.Html
import Data.GPS hiding (src,link,href)
import Text.Printf
import Data.Maybe
-import Data.GPS.Gps2HtmlReport.JourneyStats
+import Data.GPS.Gps2HtmlReport.JourneyStats (journeyDistance,meanElevation,journeyTime,maxSpeed,meanJourneySpeed,findPoint,dateOfJourney)
-- | Takes all the WayPoints and generates the HTML file
generateHtmlPage :: [WptType] -> Html
@@ -18,7 +20,7 @@ generateHtmlPage points =
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"]
+ mainArea = thediv (concatHtml [header1,statsTable points,br,header2,chartTable,header3,osmImg])
theBody = body mainArea
in concatHtml [theHeader,theBody,pgFooter]
View
8 Data/GPS/Gps2HtmlReport/JourneyCharts.hs
@@ -1,7 +1,11 @@
-- | This module uses the JourneyStats module to generate
-- the statistics about the journey WayPoints, then
-- uses the Cairo bindings to generate the charts
-module Data.GPS.Gps2HtmlReport.JourneyCharts where
+module Data.GPS.Gps2HtmlReport.JourneyCharts (
+ renderToPng, -- :: (t, OutputType -> Renderable a) -> FilePath -> IO (PickFn a)
+ chart1, -- :: [WptType] -> (String, OutputType -> Renderable ())
+ chart2 -- :: [WptType] -> (String, OutputType -> Renderable ())
+ )where
import Data.GPS
import Data.Maybe
@@ -11,7 +15,7 @@ import Data.Colour
import Data.Colour.Names
import Data.Time.LocalTime
-import Data.GPS.Gps2HtmlReport.JourneyStats
+import Data.GPS.Gps2HtmlReport.JourneyStats (ptsElevation,avrSpeedOverTime,accumDistance,findPoint)
data OutputType = Window | PNG | PS | PDF | SVG
View
15 Data/GPS/Gps2HtmlReport/JourneyStats.hs
@@ -1,8 +1,19 @@
-- | This module provides the JourneyCharts and HTMLGenerator
-- modules with statistics for the charts, and the journey statistics
-module Data.GPS.Gps2HtmlReport.JourneyStats where
+module Data.GPS.Gps2HtmlReport.JourneyStats (
+ ptsElevation, -- :: [WptType] -> [(LocalTime,Double)]
+ avrSpeedOverTime, -- :: [(LocalTime,Speed)] -> Double -> Double -> [(LocalTime,Speed)] -> [(LocalTime,Speed)]
+ accumDistance, -- :: [WptType] -> Double -> [(LocalTime,Distance)]
+ findPoint, -- findPoint :: [WptType] -> WptType -> (WptType -> Maybe Double) -> (Double -> Double -> Bool) -> Maybe (LocalTime,Double)
+ journeyDistance, -- :: (Lat a, Lon a) => [a] -> Distance
+ meanElevation, -- :: Ele a => [a] -> Double
+ journeyTime, -- :: Time a => [a] -> NominalDiffTime
+ maxSpeed, -- :: [WptType] -> Speed
+ meanJourneySpeed, -- :: (Lat a, Lon a, Time a) => [a] -> Distance
+ dateOfJourney -- :: Time a => [a] -> Maybe Day
+ ) where
-import Data.GPS -- hiding (speed)
+import Data.GPS
import Data.Maybe
import Data.Time.LocalTime
import Data.Time.Clock
View
6 Data/GPS/Gps2HtmlReport/Main.hs
@@ -9,9 +9,9 @@ import System.Directory
import Text.Html hiding (name)
import System.Console.CmdArgs
-import Data.GPS.Gps2HtmlReport.HTMLGenerator
-import Data.GPS.Gps2HtmlReport.JourneyCharts
-import Data.GPS.Gps2HtmlReport.DrawOsm
+import Data.GPS.Gps2HtmlReport.HTMLGenerator (generateHtmlPage)
+import Data.GPS.Gps2HtmlReport.JourneyCharts (renderToPng,chart1,chart2)
+import Data.GPS.Gps2HtmlReport.DrawOsm (generateOsmMap)
data MyOptions = MyOptions
{ imageOnly :: Bool
View
BIN LiberationMono-Bold.ttf
Binary file not shown.

0 comments on commit fd5efd3

Please sign in to comment.
Something went wrong with that request. Please try again.