Rose E. Shere / Fold Banner

Commit a9673a53ebc7c7bd42847da645dae36909f3605d

Authored by David Shere 12 years ago

Exists in master

Changed configuration code a bit to allow for easier undefined defaults.

Showing 4 changed files with 41 additions and 33 deletions Side-by-side Diff

foldbanner.cabal
res/cfg/user.yaml
src/BannerConfig.hs
src/Main.hs

1	1	name: foldbanner
2		-version: 0.1.0.4
	2	+version: 0.1.0.5
3	3	synopsis: Folding@home banner generator.
4	4	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.
5	5	license: MIT
...	...	@@ -14,6 +14,6 @@
14	14	executable foldbanner
15	15	main-is: Main.hs
16	16	-- other-modules:
17		- 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.
	17	+ 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
18	18	hs-source-dirs: src

...	...	@@ -5,22 +5,22 @@
5	5	query_url: http://folding.extremeoverclocking.com/xml/user_summary.php?u=
6	6
7	7	# Position individual stat positions will be offset from.
8		-# Defaults to 0,0 if not defined. Defined here anyway just for the sake of example.
9		-position_origin:
10		- x: 0
11		- y: 0
	8	+# Defaults to 0,0
	9	+#position_origin:
	10	+# x: 0
	11	+# y: 0
12	12
13	13	# Default font settings. Any of these may be overridden by defining them
14	14	# in an individual key's configuration section.
15		-font_face: monospace # The font to use
16		-font_size: 12 # The font size
17		-stroke_width: 0.25 # The stroke width to apply to the font.
18		-key_color: # The key color
	15	+#font_face: monospace # The font to use. Defaults to monospace
	16	+#font_size: 12 # The font size. Defaults to 12
	17	+#stroke_width: 0.25 # The stroke width to apply to the font. Defaults to 0.25
	18	+key_color: # The key color. Defaults to Black (0,0,0,1)
19	19	r: 1.0
20	20	g: 1.0
21	21	b: 1.0
22	22	a: 1.0
23		-val_color: # The value color
	23	+val_color: # The value color. Defaults to Black (0,0,0,1)
24	24	r: 1.0
25	25	g: 1.0
26	26	b: 0.0
...	...	@@ -31,7 +31,7 @@
31	31	- key: User_Name # XML element name for the statistic.
32	32	type: user # Type of statistic (user, team, status)
33	33	name: " User: " # Display name for this key.
34		- use_commas: False # Insert commas every three characters? (True or False)
	34	+# use_commas: False # Insert commas every three characters? Defaults to False
35	35	position_offset: # lower left corner of the output for this statistic
36	36	x: 12 # as offset from the position_origin
37	37	y: 20
...	...	@@ -79,7 +79,6 @@
79	79	- key: TeamID
80	80	type: team
81	81	name: " Team: "
82		- use_commas: False
83	82	position_offset:
84	83	x: 203
85	84	y: 20
...	...	@@ -87,7 +86,6 @@
87	86	- key: Team_Name
88	87	type: team
89	88	name: " "
90		- use_commas: False
91	89	position_offset:
92	90	x: 203
93	91	y: 20

...	...	@@ -10,7 +10,7 @@
10	10	,defaultKeyColor
11	11	,defaultValueColor
12	12	,defaultStrokeWidth
13		- --,defaultUseCommas
	13	+ ,defaultUseCommas
14	14	,statConfigs)
15	15	,StatConfig(
16	16	StatConfig
...	...	@@ -51,7 +51,7 @@
51	51	, defaultKeyColor :: Color --
52	52	, defaultValueColor :: Color --
53	53	, defaultStrokeWidth :: Double --
54		- --, defaultUseCommas :: Bool --
	54	+ , defaultUseCommas :: Bool --
55	55	, statConfigs :: [StatConfig]
56	56	} deriving (Show)
57	57
...	...	@@ -65,7 +65,7 @@
65	65	, keyColor :: Maybe Color -- The color to use for the key name
66	66	, valueColor :: Maybe Color -- The color to use for the value
67	67	, strokeWidth :: Maybe Double -- The amount to stroke the text
68		- , useCommas :: Maybe Bool -- Wether or not to add commas
	68	+ , useCommas :: Bool -- Wether or not to add commas
69	69	} deriving (Show)
70	70
71	71	data Color = Color
...	...	@@ -92,12 +92,12 @@
92	92	( BannerConfig
93	93	{ queryURL = getString "query_url" map
94	94	, originPosition = getPosition "position_origin" map
95		- , defaultFontFace = fromJust $ getString "font_face" map
96		- , defaultFontSize = fromJust $ getString "font_size" map >>= toDouble
97		- , defaultKeyColor = fromJust $ getColor "key_color" map
98		- , defaultValueColor = fromJust $ getColor "val_color" map
99		- , defaultStrokeWidth = fromJust $ getString "stroke_width" map >>= toDouble
100		- --, defaultUseCommas = getString "use_commas" map >>= toBool
	95	+ , defaultFontFace = fromMaybe "monospace" $ getString "font_face" map
	96	+ , defaultFontSize = fromMaybe 12.0 $ getString "font_size" map >>= toDouble
	97	+ , defaultKeyColor = fromMaybe (Color 0 0 0 1) $ getColor "key_color" map
	98	+ , defaultValueColor = fromMaybe (Color 0 0 0 1) $ getColor "val_color" map
	99	+ , defaultStrokeWidth = fromMaybe 0.25 $ getString "stroke_width" map >>= toDouble
	100	+ , defaultUseCommas = fromMaybe False $ getString "use_commas" map >>= toBool
101	101	, statConfigs = getStatConfigs map })
102	102	toDouble val = Just (read val :: Double)
103	103	toBool val = Just (read val :: Bool)
104	104
...	...	@@ -114,16 +114,16 @@
114	114	lookup = M.lookup (YStr "stat_configs") map >>= unSeq
115	115	>>= mapM (\cfgMap -> Just (getStatConfig (unMap cfgMap)))
116	116	getStatConfig map = StatConfig {
117		- key = fromJust $ getString "key" (fromJust map),
118		- keyType = fromJust $ getString "type" (fromJust map),
119		- name = fromJust $ getString "name" (fromJust map),
	117	+ key = fromMaybe "null" $ getString "key" (fromJust map),
	118	+ keyType = fromMaybe "null" $ getString "type" (fromJust map),
	119	+ name = fromMaybe "null" $ getString "name" (fromJust map),
120	120	position = getPosition "position_offset" (fromJust map),
121	121	fontFace = getString "font_face" (fromJust map),
122	122	fontSize = getString "font_size" (fromJust map) >>= toDouble,
123	123	keyColor = getColor "key_color" (fromJust map),
124	124	valueColor = getColor "val_color" (fromJust map),
125	125	strokeWidth = getString "stroke_width" (fromJust map) >>= toDouble,
126		- useCommas = getString "use_commas" (fromJust map) >>= toBool
	126	+ useCommas = fromMaybe False $ getString "use_commas" (fromJust map) >>= toBool
127	127	}
128	128	toDouble val = Just (read val :: Double)
129	129	toBool val = Just (read val :: Bool)
...	...	@@ -138,10 +138,10 @@
138	138	getColor key map = getValue key map >>= unMap >>= makeColor
139	139	where
140	140	makeColor map = Just (Color
141		- (fromJust (getString "r" map >>= toDouble))
142		- (fromJust (getString "g" map >>= toDouble))
143		- (fromJust (getString "b" map >>= toDouble))
144		- (fromJust (getString "a" map >>= toDouble)))
	141	+ (fromMaybe 0 (getString "r" map >>= toDouble))
	142	+ (fromMaybe 0 (getString "g" map >>= toDouble))
	143	+ (fromMaybe 0 (getString "b" map >>= toDouble))
	144	+ (fromMaybe 1 (getString "a" map >>= toDouble)))
145	145	toDouble val = Just (read val :: Double)
146	146
147	147	getPosition :: BS.ByteString -> Map YamlLight YamlLight -> Position

...	...	@@ -21,7 +21,13 @@
21	21	import Text.XML.Light
22	22	import Text.XML.Light.Cursor
23	23	import Text.XML.Light.Input
	24	+import Codec.Picture.Bitmap
	25	+import Codec.Picture.Png
	26	+import Codec.Picture.Jpg
	27	+import Codec.Picture.Gif
	28	+import Codec.Picture.Saving
24	29
	30	+
25	31	data MyOptions = MyOptions
26	32	{ config :: FilePath
27	33	, background :: FilePath
...	...	@@ -49,7 +55,7 @@
49	55	&= program _PROGRAM_NAME
50	56
51	57	_PROGRAM_NAME = "foldbanner"
52		-_PROGRAM_VERSION = "1.0.4"
	58	+_PROGRAM_VERSION = "1.0.5"
53	59	_PROGRAM_INFO = _PROGRAM_NAME ++ " version " ++ _PROGRAM_VERSION
54	60	_PROGRAM_ABOUT = "A configurable program for generating statistics banners for Folding@home"
55	61	_COPYRIGHT = "(c) 2012-2013 David Shere"
...	...	@@ -122,6 +128,10 @@
122	128	createBanner :: BannerConfig -> Element -> FilePath -> FilePath -> IO ()
123	129	createBanner mainConfig stats out bg = withImageSurfaceFromPNG bg $ \surface -> do
124	130	renderWith surface $ do mapM_ writeStat $ statConfigs mainConfig
	131	+ --image <- imageSurfaceGetData surface
	132	+ --case decodeBitmap image of
	133	+ -- Left err -> putStrLn err >> exitWith (ExitFailure 1)
	134	+ -- Right img -> writeDynamicPng out img
125	135	surfaceWriteToPNG surface out
126	136	return ()
127	137	where
...	...	@@ -138,7 +148,7 @@
138	148	writeStat cfg = do
139	149	selectFontFace statFontFace FontSlantNormal FontWeightNormal
140	150	setFontSize statFontSize
141		- let value = if fromJust $ useCommas cfg
	151	+ let value = if useCommas cfg
142	152	then do addCommas $ getData (keyType cfg) (key cfg)
143	153	else getData (keyType cfg) (key cfg)
144	154	writeText (BannerConfig.name cfg) value statKeyColor statValueColor statStrokeWidth (originPosition mainConfig) (position cfg)