From a9673a53ebc7c7bd42847da645dae36909f3605d Mon Sep 17 00:00:00 2001
From: David Shere <david.e.shere@gmail.com>
Date: Sat, 16 Feb 2013 17:26:47 -0800
Subject: [PATCH] Changed configuration code a bit to allow for easier
undefined defaults.
---
foldbanner.cabal | 4 ++--
res/cfg/user.yaml | 22 ++++++++++------------
src/BannerConfig.hs | 34 +++++++++++++++++-----------------
src/Main.hs | 14 ++++++++++++--
4 files changed, 41 insertions(+), 33 deletions(-)
diff --git a/foldbanner.cabal b/foldbanner.cabal
index e4056da..2150021 100644
--- a/foldbanner.cabal
+++ b/foldbanner.cabal
@@ -1,5 +1,5 @@
name: foldbanner
-version: 0.1.0.4
+version: 0.1.0.5
synopsis: Folding@home banner generator.
description: Foldbanner is a utility for generating Folding@home banners for users and teams. It uses a YAML configuration file containing the keys and positioning for the text on the banner.
license: MIT
@@ -14,5 +14,5 @@ cabal-version: >=1.8
executable foldbanner
main-is: Main.hs
-- other-modules:
- build-depends: base ==4.6.*, bytestring ==0.10.*, containers ==0.5.*, yaml-light ==0.1.*, split ==0.2.*, cairo ==0.12.*, download-curl ==0.1.*, cmdargs ==0.10.*, directory ==1.2.*, xml ==1.3.*
+ build-depends: base ==4.6.*, bytestring ==0.10.*, containers ==0.5.*, yaml-light ==0.1.*, split ==0.2.*, cairo ==0.12.*, download-curl ==0.1.*, cmdargs ==0.10.*, directory ==1.2.*, xml ==1.3.*, JuicyPixels
hs-source-dirs: src
diff --git a/res/cfg/user.yaml b/res/cfg/user.yaml
index e0caa03..cb8c8a9 100644
--- a/res/cfg/user.yaml
+++ b/res/cfg/user.yaml
@@ -5,22 +5,22 @@
query_url: http://folding.extremeoverclocking.com/xml/user_summary.php?u=
# Position individual stat positions will be offset from.
-# Defaults to 0,0 if not defined. Defined here anyway just for the sake of example.
-position_origin:
- x: 0
- y: 0
+# Defaults to 0,0
+#position_origin:
+# x: 0
+# y: 0
# Default font settings. Any of these may be overridden by defining them
# in an individual key's configuration section.
-font_face: monospace # The font to use
-font_size: 12 # The font size
-stroke_width: 0.25 # The stroke width to apply to the font.
-key_color: # The key color
+#font_face: monospace # The font to use. Defaults to monospace
+#font_size: 12 # The font size. Defaults to 12
+#stroke_width: 0.25 # The stroke width to apply to the font. Defaults to 0.25
+key_color: # The key color. Defaults to Black (0,0,0,1)
r: 1.0
g: 1.0
b: 1.0
a: 1.0
-val_color: # The value color
+val_color: # The value color. Defaults to Black (0,0,0,1)
r: 1.0
g: 1.0
b: 0.0
@@ -31,7 +31,7 @@ stat_configs:
- key: User_Name # XML element name for the statistic.
type: user # Type of statistic (user, team, status)
name: " User: " # Display name for this key.
- use_commas: False # Insert commas every three characters? (True or False)
+# use_commas: False # Insert commas every three characters? Defaults to False
position_offset: # lower left corner of the output for this statistic
x: 12 # as offset from the position_origin
y: 20
@@ -79,7 +79,6 @@ stat_configs:
- key: TeamID
type: team
name: " Team: "
- use_commas: False
position_offset:
x: 203
y: 20
@@ -87,7 +86,6 @@ stat_configs:
- key: Team_Name
type: team
name: " "
- use_commas: False
position_offset:
x: 203
y: 20
diff --git a/src/BannerConfig.hs b/src/BannerConfig.hs
index bc56bb3..c0aa6fe 100644
--- a/src/BannerConfig.hs
+++ b/src/BannerConfig.hs
@@ -10,7 +10,7 @@ module BannerConfig
,defaultKeyColor
,defaultValueColor
,defaultStrokeWidth
- --,defaultUseCommas
+ ,defaultUseCommas
,statConfigs)
,StatConfig(
StatConfig
@@ -51,7 +51,7 @@ data BannerConfig = BannerConfig
, defaultKeyColor :: Color --
, defaultValueColor :: Color --
, defaultStrokeWidth :: Double --
- --, defaultUseCommas :: Bool --
+ , defaultUseCommas :: Bool --
, statConfigs :: [StatConfig]
} deriving (Show)
@@ -65,7 +65,7 @@ data StatConfig = StatConfig
, keyColor :: Maybe Color -- The color to use for the key name
, valueColor :: Maybe Color -- The color to use for the value
, strokeWidth :: Maybe Double -- The amount to stroke the text
- , useCommas :: Maybe Bool -- Wether or not to add commas
+ , useCommas :: Bool -- Wether or not to add commas
} deriving (Show)
data Color = Color
@@ -92,12 +92,12 @@ readBannerConfig configFile = do
( BannerConfig
{ queryURL = getString "query_url" map
, originPosition = getPosition "position_origin" map
- , defaultFontFace = fromJust $ getString "font_face" map
- , defaultFontSize = fromJust $ getString "font_size" map >>= toDouble
- , defaultKeyColor = fromJust $ getColor "key_color" map
- , defaultValueColor = fromJust $ getColor "val_color" map
- , defaultStrokeWidth = fromJust $ getString "stroke_width" map >>= toDouble
- --, defaultUseCommas = getString "use_commas" map >>= toBool
+ , defaultFontFace = fromMaybe "monospace" $ getString "font_face" map
+ , defaultFontSize = fromMaybe 12.0 $ getString "font_size" map >>= toDouble
+ , defaultKeyColor = fromMaybe (Color 0 0 0 1) $ getColor "key_color" map
+ , defaultValueColor = fromMaybe (Color 0 0 0 1) $ getColor "val_color" map
+ , defaultStrokeWidth = fromMaybe 0.25 $ getString "stroke_width" map >>= toDouble
+ , defaultUseCommas = fromMaybe False $ getString "use_commas" map >>= toBool
, statConfigs = getStatConfigs map })
toDouble val = Just (read val :: Double)
toBool val = Just (read val :: Bool)
@@ -114,16 +114,16 @@ getStatConfigs map = case lookup of
lookup = M.lookup (YStr "stat_configs") map >>= unSeq
>>= mapM (\cfgMap -> Just (getStatConfig (unMap cfgMap)))
getStatConfig map = StatConfig {
- key = fromJust $ getString "key" (fromJust map),
- keyType = fromJust $ getString "type" (fromJust map),
- name = fromJust $ getString "name" (fromJust map),
+ key = fromMaybe "null" $ getString "key" (fromJust map),
+ keyType = fromMaybe "null" $ getString "type" (fromJust map),
+ name = fromMaybe "null" $ getString "name" (fromJust map),
position = getPosition "position_offset" (fromJust map),
fontFace = getString "font_face" (fromJust map),
fontSize = getString "font_size" (fromJust map) >>= toDouble,
keyColor = getColor "key_color" (fromJust map),
valueColor = getColor "val_color" (fromJust map),
strokeWidth = getString "stroke_width" (fromJust map) >>= toDouble,
- useCommas = getString "use_commas" (fromJust map) >>= toBool
+ useCommas = fromMaybe False $ getString "use_commas" (fromJust map) >>= toBool
}
toDouble val = Just (read val :: Double)
toBool val = Just (read val :: Bool)
@@ -138,10 +138,10 @@ getColor :: BS.ByteString -> Map YamlLight YamlLight -> Maybe Color
getColor key map = getValue key map >>= unMap >>= makeColor
where
makeColor map = Just (Color
- (fromJust (getString "r" map >>= toDouble))
- (fromJust (getString "g" map >>= toDouble))
- (fromJust (getString "b" map >>= toDouble))
- (fromJust (getString "a" map >>= toDouble)))
+ (fromMaybe 0 (getString "r" map >>= toDouble))
+ (fromMaybe 0 (getString "g" map >>= toDouble))
+ (fromMaybe 0 (getString "b" map >>= toDouble))
+ (fromMaybe 1 (getString "a" map >>= toDouble)))
toDouble val = Just (read val :: Double)
getPosition :: BS.ByteString -> Map YamlLight YamlLight -> Position
diff --git a/src/Main.hs b/src/Main.hs
index 7b5d062..dfc50f6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -21,6 +21,12 @@ import System.Exit
import Text.XML.Light
import Text.XML.Light.Cursor
import Text.XML.Light.Input
+import Codec.Picture.Bitmap
+import Codec.Picture.Png
+import Codec.Picture.Jpg
+import Codec.Picture.Gif
+import Codec.Picture.Saving
+
data MyOptions = MyOptions
{ config :: FilePath
@@ -49,7 +55,7 @@ getOpts = cmdArgs $ myProgOpts
&= program _PROGRAM_NAME
_PROGRAM_NAME = "foldbanner"
-_PROGRAM_VERSION = "1.0.4"
+_PROGRAM_VERSION = "1.0.5"
_PROGRAM_INFO = _PROGRAM_NAME ++ " version " ++ _PROGRAM_VERSION
_PROGRAM_ABOUT = "A configurable program for generating statistics banners for Folding@home"
_COPYRIGHT = "(c) 2012-2013 David Shere"
@@ -122,6 +128,10 @@ getStats cfg (StatFile file) = do
createBanner :: BannerConfig -> Element -> FilePath -> FilePath -> IO ()
createBanner mainConfig stats out bg = withImageSurfaceFromPNG bg $ \surface -> do
renderWith surface $ do mapM_ writeStat $ statConfigs mainConfig
+ --image <- imageSurfaceGetData surface
+ --case decodeBitmap image of
+ -- Left err -> putStrLn err >> exitWith (ExitFailure 1)
+ -- Right img -> writeDynamicPng out img
surfaceWriteToPNG surface out
return ()
where
@@ -138,7 +148,7 @@ createBanner mainConfig stats out bg = withImageSurfaceFromPNG bg $ \surface ->
writeStat cfg = do
selectFontFace statFontFace FontSlantNormal FontWeightNormal
setFontSize statFontSize
- let value = if fromJust $ useCommas cfg
+ let value = if useCommas cfg
then do addCommas $ getData (keyType cfg) (key cfg)
else getData (keyType cfg) (key cfg)
writeText (BannerConfig.name cfg) value statKeyColor statValueColor statStrokeWidth (originPosition mainConfig) (position cfg)
--
1.9.1