packages feed

identicon-style-squares (empty) → 0.1.0.0

raw patch · 6 files changed

+199/−0 lines, 6 filesdep +JuicyPixelsdep +basedep +bytestringsetup-changed

Dependencies added: JuicyPixels, base, bytestring, cryptohash, identicon, identicon-style-squares, polyvariadic

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for identicon-style-squares++## 0.1.0.0  -- 2018-02-26++* First version.
+ Graphics/Identicon/Styles/Squares.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE CPP                  #-}++-- |+-- Module      :  Graphics.Identicon.Styles.Squares+-- Copyright   :  (c) Francesco Gazzetta 2017+-- License     :  BSD3 (see the file LICENSE)+--+-- Maintainer  :  francygazz@gmail.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Squares style for the identicon package.++module Graphics.Identicon.Styles.Squares+( Squares+, squares+)+where++import Graphics.Identicon+import Graphics.Identicon.Primitive+import Codec.Picture (PixelRGB8 (PixelRGB8))+import Data.Proxy (Proxy)+import Data.Bits (Bits, FiniteBits, testBit, finiteBitSize)+import GHC.TypeLits+import Data.Word (Word8)++import Data.Function.Polyvariadic++#if !MIN_VERSION_base(4,8,0)+import Data.Foldable+import Data.Monoid+#endif++-- | A grid of colored squares on a white background, with vertical symmetry.+-- The argument @n@ represents the number of columns on one side of the simmetry,+-- excluding the central column. For example @Squares 3@ produces a 7x7 square (5=3*2+1).+-- To have a github-like style, use @Squares 2@+type Squares n = Identicon (3 + NecessaryBytes n) :+ Consumer (NecessaryBytes n) :+ Consumer 3++-- | Bytes necessary to generate the given number of columns on one side+type NecessaryBytes sideColumns = NearestByte (Cells sideColumns)++-- | Calculate the total number of cells in the grid from the number+--   of columns on one side+type Cells sideColumns = (sideColumns+sideColumns+1)*(sideColumns+1)++-- | Raise the number of bits to the nearest byte+type NearestByte n = NearestByte' (CmpNat 8 n) n++type family NearestByte' c n where+  NearestByte' comp 0 = 0+  NearestByte' 'GT  n = 1+  NearestByte' comp n = 1 + NearestByte (n-8)++-- | Implementation for the 'Squares' style. See 'Squares' for the meaning of @n@.+squares :: (KnownNat n, Polyvariadic [Word8] Layer (ToLayer (NecessaryBytes n)))+        => Proxy n+        -> Implementation (Squares n)+squares proxy = Identicon :+ polyvariadic mempty maskingSquares :+ solidColorLayer+  where+    maskingSquares :: [Word8] -> Layer+    maskingSquares xs = foldMap makeMaskingSquare+                      $ filterOn positions+                      $ foldMap extractBits xs+    makeMaskingSquare = foldMap (\n -> onGrid columns columns n $ color white)+    positions = foldMap columnCellToRowCells centralColumnCells -- on which cells each bit will act+    columnCellToRowCells n = [n] : fmap (\offset -> [n-offset, n+offset]) [1..sideColumns]+    centralColumnCells = [sideColumns,columns+sideColumns..columns^(2::Int) -sideColumns -1]+    sideColumns = fromIntegral $ natVal proxy+    columns = sideColumns * 2 + 1++solidColorLayer :: Word8 -> Word8 -> Word8 -> Layer+solidColorLayer r g b = color (PixelRGB8 r g b)++white :: PixelRGB8+white = PixelRGB8 255 255 255++filterOn :: [a] -> [Bool] -> [a] --MAYBE swap args+filterOn xs conditions = fmap fst $ filter snd $ zip xs conditions++extractBits :: (Bits bits, FiniteBits bits) => bits -> [Bool]+extractBits bits = fmap (testBit bits) [0..finiteBitSize bits -1]+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Francesco Gazzetta++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 Francesco Gazzetta 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
+ identicon-style-squares.cabal view
@@ -0,0 +1,45 @@+name:                identicon-style-squares+version:             0.1.0.0+synopsis:            Squares style for the identicon package+description:         An identicon style with colored squares, similar to the+                     github default avatars. The number of square in a single+                     identicon can be configured.+homepage:            https://github.com/fgaz/identicon-styles+license:             BSD3+license-file:        LICENSE+author:              Francesco Gazzetta+maintainer:          francygazz@gmail.com+-- copyright:           +category:            Graphics+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++source-repository head+  type:     git+  location: git://github.com/fgaz/identicon-styles.git++library+  exposed-modules:     Graphics.Identicon.Styles.Squares+  -- other-modules:       +  other-extensions:    DataKinds, TypeOperators, TypeFamilies, UndecidableInstances, FlexibleContexts+  build-depends:       base >=4.7 && <4.11+                     , identicon >=0.2 && <0.3+                     , JuicyPixels >=3.2 && <3.3+                     , polyvariadic >=0.2 && <0.4+  -- hs-source-dirs:      +  default-language:    Haskell2010+  ghc-options:         -O2 -Wall++test-suite squares+  type:            exitcode-stdio-1.0+  main-is:         squares.hs+  hs-source-dirs:  tests+  build-depends:   base+                 , JuicyPixels+                 , identicon+                 , identicon-style-squares+                 , bytestring+                 , cryptohash+  default-language:    Haskell2010+
+ tests/squares.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE DataKinds            #-}++import Graphics.Identicon+import Graphics.Identicon.Styles.Squares+import Crypto.Hash.MD5+import Codec.Picture+import Data.ByteString.Lazy (toStrict)+import Data.ByteString (ByteString)+import Data.Proxy+import Control.Exception.Base (assert)++genIcon+  :: Int               -- ^ Desired width+  -> Int               -- ^ Desired height+  -> ByteString        -- ^ Input (some sort of hash)+  -> Maybe (Image PixelRGB8) -- ^ Resulting image+genIcon = renderIdenticon (Proxy :: Proxy (Squares 2))+        $ squares (Proxy :: Proxy 2)+++main :: IO ()+main = do+  let h = hash "identicon"+  let Just img = genIcon 200 200 h+  let ih = hash $ toStrict $ encodeBitmap img+  assert (ih == "\251\173\EM\135\209sH\136\192\234=\DC4\214\255e\195") $ return ()+