gdritter repos pixels / ba214f6
First pass at Pixels library Getty Ritter 7 years ago
4 changed file(s) with 247 addition(s) and 0 deletion(s). Collapse all Expand all
+4
-0
.gitignore less more
1 *~
2 dist
3 dist-newstyle
4 *.pbm
+35
-0
examples/Main.hs less more
1 {-# LANGUAGE MultiWayIf #-}
2
3 module Main where
4
5 import Control.Monad (forM_)
6 import Image.Pixels
7 import qualified System.Random as R
8
9 glyph :: FilePath -> IO ()
10 glyph fp = do
11 rs <- fmap R.randoms R.newStdGen
12
13 let (w, h) = (3, 3)
14 (fw, fh) = (w * 2 - 1, h * 2 - 1)
15
16 let img = scaleUp 16 $ image black (fw + 2) (fh + 2) $ do
17 forM_ (zip [1..fw ] (cycle [True,False])) $ \ (x, xConn) ->
18 forM_ (zip [1..fh] (cycle [True,False])) $ \ (y, yConn) ->
19 let color = if | xConn && yConn ->
20 white
21 | xConn || yConn ->
22 if rs !! fromIntegral (x + fw * y)
23 then black
24 else white
25 | otherwise ->
26 black
27 in draw color x y
28
29 savePBM fp img
30
31
32 main :: IO ()
33 main = do
34 forM_ [0..15] $ \ n -> do
35 glyph ("glyph" ++ show n ++ ".pbm")
+29
-0
pixels.cabal less more
1 name: pixels
2 version: 0.1.0.0
3 synopsis: A simple library for working with image data on
4 a pixel-by-pixel basis
5 -- description:
6 license: BSD3
7 license-file: LICENSE
8 author: Getty Ritter <gettylefou@gmail.com>
9 maintainer: Getty Ritter <gettylefou@gmail.com>
10 copyright: ©2017 Getty Ritter
11 -- category:
12 build-type: Simple
13 cabal-version: >= 1.12
14
15 library
16 exposed-modules: Image.Pixels
17 hs-source-dirs: src
18 ghc-options: -Wall
19 build-depends: base >=4.7 && <5
20 , array
21 , bytestring
22 , monadLib
23 default-language: Haskell2010
24
25 executable sample
26 hs-source-dirs: examples
27 main-is: Main.hs
28 build-depends: base, pixels, random
29 default-language: Haskell2010⏎
+179
-0
src/Image/Pixels.hs less more
1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE TypeFamilies #-}
4
5 module Image.Pixels where
6
7 import Data.Array (Array)
8 import qualified Data.Array as Array
9 import qualified Data.ByteString.Builder as BS
10 import qualified Data.ByteString.Lazy as BS
11 import qualified Data.Ix as Ix
12 import Data.Monoid ((<>))
13 import Data.Word
14 import MonadLib
15
16 data Index = Index {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32 deriving (Eq, Ord, Show)
17
18 instance Ix.Ix Index where
19 range (Index x1 y1, Index x2 y2) =
20 concat [ [ Index x y
21 | x <- [x1..x2] ]
22 | y <- [y1..y2] ]
23 index (Index x1 _, Index x2 _) (Index x y) =
24 let w = (x2 - x1) + 1
25 in fromIntegral (x + w * y)
26 inRange (Index x1 y1, Index x2 y2) (Index x y) =
27 Ix.inRange (x1, x2) x && Ix.inRange (y1, y2) y
28
29 data RGB8 =
30 RGB8 {-# UNPACK #-} !Word8
31 {-# UNPACK #-} !Word8
32 {-# UNPACK #-} !Word8
33 deriving (Eq)
34
35 data RGB16 =
36 RGB16 {-# UNPACK #-} !Word16
37 {-# UNPACK #-} !Word16
38 {-# UNPACK #-} !Word16
39 deriving (Eq)
40
41 data RGBA8 =
42 RGBA8 {-# UNPACK #-} !Word8
43 {-# UNPACK #-} !Word8
44 {-# UNPACK #-} !Word8
45 {-# UNPACK #-} !Word8
46 deriving (Eq)
47
48 data RGBA16 =
49 RGBA16 {-# UNPACK #-} !Word16
50 {-# UNPACK #-} !Word16
51 {-# UNPACK #-} !Word16
52 {-# UNPACK #-} !Word16
53 deriving (Eq)
54
55 data Gray8 = Gray8 {-# UNPACK #-} !Word8 deriving (Eq)
56 data Gray16 = Gray16 {-# UNPACK #-} !Word16 deriving (Eq)
57 newtype BW = BW Bool deriving (Eq, Show)
58
59 class BWPixel pixel where
60 black :: pixel
61 white :: pixel
62
63 class GrayPixel pixel where
64 gray :: Double -> pixel
65
66 class RGBPixel pixel where
67 red :: Double -> pixel
68 green :: Double -> pixel
69 blue :: Double -> pixel
70 rgb :: Double -> pixel
71
72 instance BWPixel BW where
73 black = BW False
74 white = BW True
75
76 data Image pixel = Image
77 { imgWidth :: Word32
78 , imgHeight :: Word32
79 , imgPixels :: Array Index pixel
80 } deriving Show
81
82 instance Functor Image where
83 fmap f img = img { imgPixels = fmap f (imgPixels img) }
84
85 image :: pixel -> Word32 -> Word32 -> PixelM pixel () -> Image pixel
86 image def w h (PixelM mote) = snd (runId (runStateT img mote))
87 where
88 img = Image
89 { imgWidth = w
90 , imgHeight = h
91 , imgPixels =
92 let range = (Index 0 0, Index (w - 1) (h - 1))
93 in Array.array range [ (ix, def)
94 | ix <- Ix.range range
95 ]
96 }
97
98 squareImg :: pixel -> Word32 -> PixelM pixel () -> Image pixel
99 squareImg def s mote = image def s s mote
100
101 getWidth :: PixelM pixel Word32
102 getWidth = PixelM (fmap imgWidth get)
103
104 getHeight :: PixelM pixel Word32
105 getHeight = PixelM (fmap imgHeight get)
106
107 horizontal :: PixelM pixel () -> PixelM pixel ()
108 horizontal (PixelM mote) = PixelM $ do
109 w <- fmap imgWidth get
110 let flipHoriz = sets_ $ \i ->
111 i { imgPixels =
112 imgPixels i Array.//
113 [ (ix, imgPixels i Array.! Index ((w - 1) - x) y)
114 | ix@(Index x y) <- Ix.range (Array.bounds (imgPixels i))
115 ]
116 }
117 mote
118 flipHoriz
119 mote
120 flipHoriz
121
122 vertical :: PixelM pixel () -> PixelM pixel ()
123 vertical (PixelM mote) = PixelM $ do
124 h <- fmap imgHeight get
125 let flipVert = sets_ $ \i ->
126 i { imgPixels =
127 imgPixels i Array.//
128 [ (ix, imgPixels i Array.! Index x ((h - 1) - y))
129 | ix@(Index x y) <- Ix.range (Array.bounds (imgPixels i))
130 ]
131 }
132 mote
133 flipVert
134 mote
135 flipVert
136
137 newtype PixelM pixel a = PixelM { runPixelM :: StateT (Image pixel) Id a }
138 deriving (Functor, Applicative, Monad)
139
140 inImage :: Word32 -> Word32 -> Image pixel -> Bool
141 inImage x y Image { imgWidth = w, imgHeight = h } =
142 Ix.inRange (Index 0 0, Index w h) (Index x y)
143
144 draw :: pixel -> Word32 -> Word32 -> PixelM pixel ()
145 draw p x y = PixelM $ sets_ $ \ img ->
146 img { imgPixels = imgPixels img Array.// [ (Index x y, p) ] }
147
148 scaleUp :: Word8 -> Image pixel -> Image pixel
149 scaleUp n img =
150 let n' = fromIntegral n
151 range = ( Index 0 0
152 , Index (imgWidth img * n' - 1)
153 (imgHeight img * n' - 1)
154 )
155 in Image
156 { imgWidth = imgWidth img * n'
157 , imgHeight = imgHeight img * n'
158 , imgPixels = Array.array range
159 [ (ix, imgPixels img Array.! Index (x `div` n') (y `div` n'))
160 | ix@(Index x y) <- Ix.range range
161 ]
162 }
163
164
165 toPBM :: Image BW -> BS.ByteString
166 toPBM img = BS.toLazyByteString pbmFile
167 where pbmFile = BS.string7 "P1\n" <>
168 BS.word32Dec (imgWidth img) <>
169 BS.char7 ' ' <>
170 BS.word32Dec (imgHeight img) <>
171 BS.char7 '\n' <>
172 mconcat [ go (imgPixels img Array.! ix)
173 | ix <- Ix.range (Array.bounds (imgPixels img))
174 ]
175 go (BW True) = BS.char7 '0' <> BS.char7 ' '
176 go (BW False) = BS.char7 '1' <> BS.char7 ' '
177
178 savePBM :: FilePath -> Image BW -> IO ()
179 savePBM path img = BS.writeFile path (toPBM img)