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 +5/−0
- Graphics/Identicon/Styles/Squares.hs +89/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- identicon-style-squares.cabal +45/−0
- tests/squares.hs +28/−0
+ 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 ()+