comic (empty) → 0
raw patch · 5 files changed
+221/−0 lines, 5 filesdep +aesondep +basedep +textsetup-changed
Dependencies added: aeson, base, text
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- comic.cabal +28/−0
- src/Data/Comic.hs +156/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for comic++## 0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, davean++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 davean 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ comic.cabal view
@@ -0,0 +1,28 @@+name: comic+version: 0+synopsis: A format for describing comics.+-- description: +homepage: https://oss.xkcd.com/+license: BSD3+license-file: LICENSE+author: davean+maintainer: oss@xkcd.com+copyright: 2013-2017+category: Data+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++source-repository head+ type: git+ location: https://code.xkrd.net/xkcd/comic.git+ +library+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ Data.Comic+ build-depends:+ base >=4.9 && <4.11+ , text >= 1.2 && < 1.3+ , aeson >= 1.1 && < 1.2
+ src/Data/Comic.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE OverloadedStrings #-}+module Data.Comic (+ Hint(..), Position(..), Font(..), FontName, FontSize, RGBA, Comic(..), Panel(..)+ , HintSize, ImageName+ , ComicDelta(..)+ , blackRGBA+ ) where++import Control.Monad+import Control.Applicative+import Data.Text (Text)+import qualified Data.Aeson as JS+import qualified Data.Aeson.Types as JS+import Data.Aeson (ToJSON(..), FromJSON(..), (.:))++type ImageName = Text+type FontName = Text+type FontSize = Int+type HintSize = Int+type RGBA = (Float, Float, Float, Float)++blackRGBA :: RGBA+blackRGBA = (0, 0, 0, 1)++data Font =+ Font FontName FontSize RGBA+ deriving (Show, Eq, Ord)++data Position =+ Pos Int Int+ deriving (Show, Eq, Ord)++instance ToJSON Position where+ toJSON (Pos x y) = JS.object [("x", toJSON x), ("y", toJSON y)]++instance FromJSON Position where+ parseJSON (JS.Object v) = Pos <$> v .: "x" <*> v .: "y"+ parseJSON _ = mzero++data Hint =+ ZoneHint {+ _hintTxt :: Text+ }+ | ClickZoneHint {+ _hintLocal :: Maybe (Position, HintSize)+ , _hintLink :: Text+ }+ | HoverHint {+ -- Where the hint is, in relation to the slice it is in.+ _hintPos :: Position+ -- How far off the target they'll get the hint on hover and how large we highlight.+ , _hintSize :: HintSize+ -- What the actual hint is.+ , _hintTxt :: Text+ }+ deriving (Show, Eq, Ord)++instance ToJSON Hint where+ toJSON (ZoneHint t) = JS.object [("txt", toJSON t)]+ toJSON (ClickZoneHint ml l) = JS.object $ [ ("href", toJSON l) ] +++ maybe [] (\(p, s) -> [("size", toJSON s), ("pos", toJSON p)]) ml+ toJSON (HoverHint p s t) =+ JS.object+ [ ("pos", toJSON p)+ , ("size", toJSON s)+ , ("txt", toJSON t) ]++instance FromJSON Hint where+ parseJSON (JS.Object v) =+ (ClickZoneHint <$> (((\s p -> Just (p, s)) <$> v .: "size" <*> v .: "pos") <|> pure Nothing) <*> v .: "href") <|>+ (HoverHint <$> v .: "pos" <*> v .: "size" <*> v .: "txt") <|>+ (ZoneHint <$> v .: "txt")+ parseJSON _ = mzero++data Panel =+ Panel {+ -- List of panel parts, left to right.+ _panelBackground :: ImageName+ -- Zone hints.+ , _panelHints :: [Hint]+ , _panelTexts :: [((Position, Position), Font, Text)]+ , _panelOverlays :: [(Position, ImageName)]+ }+ deriving (Show, Eq, Ord)++text2json :: ((Position, Position), Font, Text) -> JS.Value+text2json ((tl, br), Font fn fs c, t) =+ JS.object [ ("tl", toJSON tl), ("br", toJSON br)+ , ("font", toJSON fn), ("size", toJSON fs), ("color", toJSON c)+ , ("txt", toJSON t) ]++json2text :: JS.Value -> JS.Parser ((Position, Position), Font, Text)+json2text (JS.Object v1) = + (\tl br fn fs c t -> ((tl, br), Font fn fs c, t)) <$>+ v1 .: "tl" <*> v1 .: "br" <*>+ v1 .: "font" <*> v1 .: "size" <*> v1 .: "color" <*>+ v1 .: "txt"+json2text _ = mzero++instance ToJSON Panel where+ toJSON (Panel ss hs txts overs) =+ JS.object $ [+ ("background", toJSON ss)+ , ("hints", toJSON hs)+ , ("texts", toJSON $ map text2json txts)+ , ("overlays", toJSON $ map (\(p, i) ->+ JS.object [ ("tl", toJSON p)+ , ("img", toJSON i) ]) overs)+ ]++instance FromJSON Panel where+ parseJSON (JS.Object v) = + Panel <$> + v .: "background" <*>+ v .: "hints" <*>+ (v .: "texts" >>= mapM json2text) <*>+ (v .: "overlays" >>= mapM parseOver)+ where+ parseOver (JS.Object v1) = (,) <$> v1 .: "tl" <*> v1 .: "img"+ parseOver _ = mzero+ parseJSON _ = mzero++data Comic =+ Comic {+ _comicPanels :: [Panel]+ , _comicAlt :: Text+ -- This needs something more to tell us how to layout the panels.+ , _comicPad :: Int+ }+ deriving (Show, Eq, Ord)++instance ToJSON Comic where+ toJSON (Comic ps alt pad) = JS.object [("panels", toJSON ps), ("pad", toJSON pad), ("alt", toJSON alt)]++instance FromJSON Comic where+ parseJSON (JS.Object v) =+ Comic <$> v .: "panels" <*> v .: "alt" <*> v .: "pad"+ parseJSON _ = mzero++data ComicDelta =+ CompleteComic Comic+ | AppendPanels [Panel]+ | AddTexts [((Position, Position), Font, Text)]+ deriving (Show, Eq)++instance ToJSON ComicDelta where+ toJSON (CompleteComic c) = JS.object [("complete", toJSON c)]+ toJSON (AppendPanels ps) = JS.object [("append_panels", toJSON ps)]+ toJSON (AddTexts txts) = JS.object [("add_texts", toJSON $ map text2json txts)]++instance FromJSON ComicDelta where+ parseJSON (JS.Object v) =+ (CompleteComic <$> v .: "complete") <|>+ (AppendPanels <$> v .: "append_panels") <|>+ (AddTexts <$> (v .: "add_texts" >>= mapM json2text)) + parseJSON _ = mzero