arcgrid-viewer (empty) → 0.1.0.0

raw patch · 10 files changed

+382/−0 lines, 10 filesdep +arcgriddep +basedep +bytestringsetup-changed

Dependencies added: arcgrid, base, bytestring, gloss, transformers

Files

• LICENSE +30/−0
• README.md +75/−0
• Setup.hs +2/−0
• arcgrid-viewer.cabal +30/−0
• src/ColorScheme.hs +41/−0
• src/Main.hs +71/−0
• src/Raster.hs +24/−0
• src/Types.hs +26/−0
• src/Vector.hs +27/−0
• src/View.hs +56/−0

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,75 @@+# Simple viewer of ArcGrid geospatial data written in Haskell++## Synopsis+A simple viewer for ESRI/ArcInfo (ArcGrid) files. A user can pan, zoom and+rotate the rendered dataset with keyboard and mouse (see _Controls_).+++![alt text](https://github.com/nbrk/arcgrid-viewer/blob/master/doc/scr_alps3.png "Screenshot")+++The program uses shades of red (by default) normalized by minimum and maximum+value in the VAT of the curent dataset. Black colour represents lower value than+the red one.++## Installation+The program depends on `gloss` and `arcgrid` libraries. The easiest way is to+install utulity `stack` and build the software from the source code.++Currently, as this:++``` sh+$ git clone https://github.com/nbrk/arcgrid.git+$ git clone https://github.com/nbrk/arcgrid-viewer.git+$ cd arcgrid-viewer+$ stack install+# Usually stack will install the program binary in ~/.local/bin .+# You can add it to PATH of you want.+$ ~/.local/bin/arcgrid-viewer ../arcgrid/sample/alps_huge.asc+```++## Usage+The program supports rendering the dataset in few color schemes (red, black and+white, a spectre) in both vector and raster modes. ++```+Usage: arcgrid-viewer [OPTION...] <file>+  -c MODE  --color=MODE  color scheme: red|bw|fancy+  -r MODE  --mode=MODE   rendering mode: vector|raster+```++The defaults are to render **in raster** with **red gradient**.+Please keep in mind that big datasets take time and resources to parse and render!++There is some sample `.asc` elevation data from the Alps. It resides in `arcgrid`+library and is [located](https://github.com/nbrk/arcgrid/tree/master/sample) in `arcgrid/sample`.++## Controls+The program uses `gloss` library for rendering and display. Therefore, the+controls are:++```+* Quit+  - esc-key++* Move Viewport+  - arrow keys+  - left-click drag++* Zoom Viewport+  - page up/down-keys+  - control-left-click drag+  - right-click drag+  - mouse wheel++* Rotate Viewport+  - home/end-keys+  - alt-left-click drag++* Reset Viewport+  r-key+```++## TODO+- Optimization. The viewer is too damn slow!+- Maybe restrict display only to a selected rectangle.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,30 @@+name:                arcgrid-viewer+version:             0.1.0.0+synopsis:            Simple viewer for ESRI/ArcInfo (ArcGrid) geospatial data+description:         A simple viewer for ESRI/ArcInfo (ArcGrid) files. Users+                     can pan, zoom and rotate the rendered dataset.+homepage:            https://github.com/nbrk/arcgrid-viewer+license:             BSD3+license-file:        LICENSE+author:              Nikolay Burkov+maintainer:          nbrk@linklevel.net+category:            Geo+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++executable arcgrid-viewer+  hs-source-dirs:      src+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base >= 4.9 && < 5.0+                     , transformers+                     , bytestring+                     , arcgrid+                     , gloss+  other-modules:       Types, View, ColorScheme, Raster, Vector+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/nbrk/arcgrid-viewer

@@ -0,0 +1,41 @@+module ColorScheme where++import Graphics.Gloss+import Control.Monad.Trans.Reader++import Types++colorFromValue :: Int -> ReaderT ViewerCtx IO Color+colorFromValue v = do+  (vmin, vmax) <- asks vctxMinMaxVal+  c <- asks vctxColorScheme+  -- X between A and B; we want Y to fall between C and D+  -- Y = (X-A)/(B-A) * (D-C) + C+  let d = fromIntegral $ abs $ vmax - vmin+  let dv = fromIntegral $ abs $ v - vmin+  let int = dv / d * (1.0 - 0) + 0+  case c of+    RedScheme -> return $ makeColor int 0 0 1+    BWScheme -> return $ greyN int+    FancyScheme -> fancyColor int+++fancyColor :: Float -> ReaderT ViewerCtx IO Color+fancyColor int = do+  let tz = thermalZone int+  let c = case tz of+        1 -> makeColor 0 0 int 1+        2 -> makeColor 0 int 1 1+        3 -> makeColor 0 1 (1 - int) 1+        4 -> makeColor int 1 0 1+        _ -> makeColor 1 (1 - int) 0 1+  -- let c = case tz of+  --       1 -> makeColor 0 int 1 1+  --       2 -> makeColor 0 1 (1 - int) 1+  --       3 -> makeColor int 1 0 1+  --       _ -> makeColor 1 (1 - int) 0 1++  return c+  where+    thermalZone i = truncate $ i / 0.2 + 1 -- 1 / 0.2, so 5 thermal zones+--    thermalZone i = truncate $ i / 0.25 + 1

@@ -0,0 +1,71 @@+module Main where++import Graphics.Gloss (white)+import System.Console.GetOpt+import System.Environment+import Data.Maybe ( fromMaybe )+import Control.Monad.Trans.Reader++import Types+import View++defaultOptions = Options+               { optColorScheme = RedScheme+               , optRenderMode = RasterMode+               , optBGColor = white+               , optSqSize = 1+               , optInput = ""+               }++parseColorScheme :: String -> ColorScheme+parseColorScheme "red" = RedScheme+parseColorScheme "bw" = BWScheme+parseColorScheme "fancy" = FancyScheme+parseColorScheme _ = error "Incorrect color scheme"++parseRenderMode :: String -> RenderMode+parseRenderMode "raster" = RasterMode+parseRenderMode "vector" = VectorMode+parseRenderMode _ = error "Incorrect rendering mode"+++options :: [OptDescr (Options -> Options)]+options =+  [ Option ['c'] ["color"]+    (ReqArg (\a opts -> opts {optColorScheme = parseColorScheme a}) "MODE") "color scheme: red|bw|fancy"+  ,+    Option ['r'] ["mode"]+    (ReqArg (\a opts -> opts {optRenderMode = parseRenderMode a}) "MODE") "rendering mode: vector|raster"+  ]+++programOpts :: [String] -> IO (Options, [String])+programOpts argv = do+  pn <- getProgName+  case getOpt Permute options argv of+    (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)+    (_,_,errs) -> do+      putStrLn $ "Error: " ++ concat errs+      errorUsage options+++errorUsage :: [OptDescr a] -> IO b+errorUsage opts = do+  pn <- getProgName+  putStrLn $ usageInfo (usageHeader pn) options+  ioError $ userError ""+  where+    usageHeader pn = "Usage: " ++ pn ++ " [OPTION...] <file>"+++main :: IO ()+main = do+  argv <- getArgs++  (opts, argv') <- programOpts argv+  case argv' of+    fname:_ -> runReaderT viewArcGridFile $ opts {optInput = fname}+    otherwise -> do+      putStrLn "Error: filename required"+      putStrLn ""+      errorUsage options

@@ -0,0 +1,24 @@+module Raster where++import Graphics.Gloss+import Control.Monad.Trans.Reader+import qualified Data.ByteString as B+import Data.Word++import Types+import ColorScheme+++packRGBA :: (Float, Float, Float, Float) -> [Word8]+packRGBA (r, g, b, a) = map (fromIntegral . round) [r * 255, g * 255, b * 255, a * 255]+++makeRasterPicture :: ReaderT ViewerCtx IO Picture+makeRasterPicture = do+   vs <- asks vctxValTblData+   (w, h) <- asks vctxValTblSize+   colors <- mapM (\(_, v) -> colorFromValue v) vs+   let rgbas = concatMap (packRGBA . rgbaOfColor) colors+   let bs = B.pack rgbas++   return $ bitmapOfByteString w h (BitmapFormat TopToBottom PxRGBA) bs False

@@ -0,0 +1,26 @@+module Types where++import Graphics.Gloss (Color)++data ColorScheme = RedScheme | BWScheme | FancyScheme+data RenderMode = RasterMode | VectorMode++data Options = Options+               { optColorScheme  :: ColorScheme+               , optRenderMode :: RenderMode+               , optBGColor :: Color+               , optSqSize :: Float+               , optInput :: FilePath+               }+++data ViewerCtx = ViewerCtx+                 { vctxRenderMode :: RenderMode+                 , vctxColorScheme :: ColorScheme+                 , vctxBGColor :: Color+                 , vctxSqSize :: Float+                 , vctxValTblSize :: (Int, Int)+                 , vctxValTblData :: [((Int, Int), Int)]+                 , vctxMinMaxVal :: (Int, Int)+                 , vctxNodataVal :: Maybe Int+                 }

@@ -0,0 +1,27 @@+module Vector where++import Graphics.Gloss+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader+import Data.Monoid++import Types+import ColorScheme++makeVectorPicture :: ReaderT ViewerCtx IO Picture+makeVectorPicture = do+  vs <- asks vctxValTblData+  ps <- mapM pictureFromRowColValue vs+  return $ pictures ps+++pictureFromRowColValue :: ((Int, Int), Int) -> ReaderT ViewerCtx IO Picture+pictureFromRowColValue ((r, c), v) = do+  sq <- asks vctxSqSize+  vcolor <- colorFromValue v+  let mon = mconcat+        [ Endo $ translate (fromIntegral c * sq) (negate (fromIntegral r * sq))+        , Endo $ color vcolor+        ]+--  lift $ putStrLn $ "((r,c,),val)=" ++ show ((r,c), v) ++ " vcolor=" ++ show vcolor ++ " "+  return $ appEndo mon $ rectangleSolid sq sq

@@ -0,0 +1,56 @@+module View where++import Graphics.Gloss+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader+import qualified Data.List as L+import ArcGrid++import Types+import ColorScheme+import Vector+import Raster++viewArcGridFile :: ReaderT Options IO ()+viewArcGridFile = do+  opts <- ask+  ag <- lift $ arcGridFromFile (optInput opts)+  lift $ putStrLn $+    "Parser done. " +++    "Forming " ++ show (ncols ag) ++ "x" ++ show (nrows ag) ++ " viewport... "++  let rcs = [(r, c) | r <- [0..(nrows ag) - 1], c <- [0..(ncols ag) - 1]]+  let vs' = L.sort $ vat ag+  let vctx = ViewerCtx+             { vctxRenderMode = optRenderMode opts+             , vctxColorScheme = optColorScheme opts+             , vctxBGColor = optBGColor opts+             , vctxSqSize = optSqSize opts+             , vctxValTblSize = (ncols ag, nrows ag)+             , vctxValTblData = zip rcs (vat ag)+             , vctxMinMaxVal = (head vs', last vs')+             , vctxNodataVal = nodata_value ag+             }+--  lift $ putStrLn $ show $ vctxValTblData vctx++  lift $ runReaderT viewContext vctx+++makePicture :: ReaderT ViewerCtx IO Picture+makePicture = do+  r <- asks vctxRenderMode+  case r of+    VectorMode -> makeVectorPicture+    RasterMode -> makeRasterPicture+++viewContext :: ReaderT ViewerCtx IO ()+viewContext = do+  bg <- asks vctxBGColor+  pic <- makePicture+  lift $ display FullScreen bg pic+++++