initial commit
This commit is contained in:
commit
81a386bd63
23
.gitignore
vendored
Normal file
23
.gitignore
vendored
Normal file
@ -0,0 +1,23 @@
|
||||
#### joe made this: http://goel.io/joe
|
||||
#### haskell ####
|
||||
dist
|
||||
dist-*
|
||||
cabal-dev
|
||||
*.o
|
||||
*.hi
|
||||
*.chi
|
||||
*.chs.h
|
||||
*.dyn_o
|
||||
*.dyn_hi
|
||||
.hpc
|
||||
.hsenv
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
*.prof
|
||||
*.aux
|
||||
*.hp
|
||||
*.eventlog
|
||||
.stack-work/
|
||||
cabal.project.local
|
||||
.HTF/
|
||||
|
30
LICENSE
Normal file
30
LICENSE
Normal file
@ -0,0 +1,30 @@
|
||||
Copyright Author name here (c) 2016
|
||||
|
||||
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 Author name here 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.
|
78
app/Main.hs
Normal file
78
app/Main.hs
Normal file
@ -0,0 +1,78 @@
|
||||
module Main where
|
||||
import Picture
|
||||
import System.Environment
|
||||
|
||||
data Options = Options { file :: FilePath
|
||||
, output :: FilePath
|
||||
, argInvert :: Bool
|
||||
, argGrayscale :: Bool
|
||||
, argRotate :: Double
|
||||
, argFade :: Double
|
||||
, argContrast :: Double
|
||||
, argGamma :: Int
|
||||
, argBrightness :: Double
|
||||
}
|
||||
|
||||
opts = Options { file = ""
|
||||
, output = "output.png"
|
||||
, argInvert = False
|
||||
, argGrayscale = False
|
||||
, argRotate = 0
|
||||
, argFade = 100
|
||||
, argContrast = 0
|
||||
, argGamma = 1
|
||||
, argBrightness = 0
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
print args
|
||||
|
||||
if null args
|
||||
then do
|
||||
putStrLn "Usage: picedit <input> [OPTIONS]"
|
||||
putStrLn "Options:"
|
||||
putStrLn " --contrast <n> - a number between -255 and 255"
|
||||
putStrLn " --brightness <n> - a number between -255 and 255"
|
||||
putStrLn " --gamma <n>"
|
||||
putStrLn " --fade <n> - a number between 0 and 100"
|
||||
putStrLn " --rotate <n> - rotate image by n degrees"
|
||||
putStrLn " --grayscale - turn the image grayscale"
|
||||
putStrLn " --invert - invert (negative) the image"
|
||||
putStrLn " --output <filename> - output name, defaults to output.png"
|
||||
else do
|
||||
let options = parseArgs args opts
|
||||
|
||||
pic <- readPicture (file options)
|
||||
|
||||
case pic of
|
||||
Left err -> print err
|
||||
Right p -> do
|
||||
let edited = rotate (argRotate options) Nothing
|
||||
. fade (argFade options / 100)
|
||||
. contrast (argContrast options)
|
||||
. gamma (argGamma options)
|
||||
. brightness (argBrightness options)
|
||||
. conditionalFn grayscale (argGrayscale options)
|
||||
. conditionalFn invert (argInvert options) $ p
|
||||
writePicturePng "output.png" edited
|
||||
|
||||
return ()
|
||||
|
||||
where
|
||||
conditionalFn f True = f
|
||||
conditionalFn f False = id
|
||||
|
||||
parseArgs :: [String] -> Options -> Options
|
||||
parseArgs [] opts = opts
|
||||
parseArgs ("--invert":rest) opts = parseArgs rest (opts { argInvert = True })
|
||||
parseArgs ("--grayscale":rest) opts = parseArgs rest (opts { argGrayscale = True })
|
||||
parseArgs ("--rotate":n:rest) opts = parseArgs rest (opts { argRotate = read n })
|
||||
parseArgs ("--fade":n:rest) opts = parseArgs rest (opts { argFade = read n })
|
||||
parseArgs ("--contrast":n:rest) opts = parseArgs rest (opts { argContrast = read n })
|
||||
parseArgs ("--brightness":n:rest) opts = parseArgs rest (opts { argBrightness = read n })
|
||||
parseArgs ("--gamma":n:rest) opts = parseArgs rest (opts { argGamma = read n })
|
||||
parseArgs ("--output":n:rest) opts = parseArgs rest (opts { output = n })
|
||||
parseArgs (name:rest) opts = parseArgs rest (opts { file = name })
|
||||
|
BIN
dreamboy-gs.png
Normal file
BIN
dreamboy-gs.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 382 KiB |
BIN
dreamboy.jpg
Normal file
BIN
dreamboy.jpg
Normal file
Binary file not shown.
After Width: | Height: | Size: 60 KiB |
BIN
output.png
Normal file
BIN
output.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 290 KiB |
36
picedit.cabal
Normal file
36
picedit.cabal
Normal file
@ -0,0 +1,36 @@
|
||||
name: picedit
|
||||
version: 0.1.0.0
|
||||
synopsis: simple image manipulation functions
|
||||
description: Simple set of functions for image manipulation: contrast, brightnesss, rotation, etc.
|
||||
homepage: https://github.com/mdibaiee/image-editor-hs#readme
|
||||
license: GPL-3
|
||||
license-file: LICENSE
|
||||
author: Author name here
|
||||
maintainer: example@example.com
|
||||
copyright: 2016 Author name here
|
||||
category: Image, Picture, Matrix
|
||||
build-type: Simple
|
||||
-- extra-source-files:
|
||||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: Picture
|
||||
build-depends: base >= 4.7 && < 5,
|
||||
JuicyPixels >= 3.2.8 && < 3.3,
|
||||
hmatrix >= 0.17.0.2 && < 0.18,
|
||||
vector >= 0.11.0.0 && < 0.12
|
||||
default-language: Haskell2010
|
||||
|
||||
executable image-editor-hs-exe
|
||||
hs-source-dirs: app
|
||||
main-is: Main.hs
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends: base
|
||||
, picedit
|
||||
, cli >= 0.1.2 && < 0.2
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/mdibaiee/picedit
|
129
src/Picture.hs
Normal file
129
src/Picture.hs
Normal file
@ -0,0 +1,129 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Picture ( grayscale
|
||||
, readPicture
|
||||
, fromImage
|
||||
, toImage
|
||||
, writePicturePng
|
||||
, fade
|
||||
, rotate
|
||||
, contrast
|
||||
, brightness
|
||||
, gamma
|
||||
, invert
|
||||
)
|
||||
where
|
||||
|
||||
import Codec.Picture
|
||||
import Numeric.LinearAlgebra
|
||||
import qualified Data.Vector.Storable as V
|
||||
import System.IO
|
||||
import Data.Maybe
|
||||
import Debug.Trace
|
||||
|
||||
-- RGBA
|
||||
|
||||
-- | 'Picture' type is just a triple of color channel matrices: (R, G, B)
|
||||
type Picture = (Matrix Double, Matrix Double, Matrix Double)
|
||||
|
||||
-- |Converts a JuicyPixel 'Image PixelRGB8' to 'Picture'
|
||||
fromImage :: Image PixelRGB8 -> Picture
|
||||
fromImage Image { imageWidth = w, imageHeight = h, imageData = vec } =
|
||||
let [r, g, b] = map (reshape w . V.fromList . reverse) (snd $ V.foldl' gp (0, [[],[],[]]) (V.map fromIntegral vec))
|
||||
in (r, g, b)
|
||||
where
|
||||
gp acc x =
|
||||
case acc of
|
||||
(0, [r, g, b]) -> (1, [x:r, g, b])
|
||||
(1, [r, g, b]) -> (2, [r, x:g, b])
|
||||
(2, [r, g, b]) -> (0, [r, g, x:b])
|
||||
|
||||
-- |Converts a 'Picture' to JuicyPixel 'Image PixelRGB8'
|
||||
toImage :: Picture -> Image PixelRGB8
|
||||
toImage (r, g, b) =
|
||||
let (fr, fg, fb) = (toList $ flatten r, toList $ flatten g, toList $ flatten b)
|
||||
img = V.map (fromIntegral . floor) . V.concat $ zipWith3 (\a b c -> vector [a, b, c]) fr fg fb
|
||||
in Image { imageWidth = cols r, imageHeight = rows r, imageData = img }
|
||||
|
||||
|
||||
-- | Reads a 'Picture' from specified path
|
||||
readPicture :: FilePath -> IO (Either String Picture)
|
||||
readPicture path = do
|
||||
img <- readImage path
|
||||
return $ case img of
|
||||
Left err -> Left err
|
||||
Right im -> Right $ fromImage (convertRGB8 im)
|
||||
|
||||
-- | Write the specified 'Picture' to a PNG file
|
||||
writePicturePng :: FilePath -> Picture -> IO ()
|
||||
writePicturePng path pic = writePng path (toImage pic)
|
||||
|
||||
-- | Turn the 'Picture' grayscale
|
||||
grayscale :: Picture -> Picture
|
||||
grayscale (r, g, b) =
|
||||
let (fr, fg, fb) = (flatten r, flatten g, flatten b)
|
||||
mean = reshape (cols r) $ V.map (/ 3) (fr + fg + fb)
|
||||
in (mean, mean, mean)
|
||||
|
||||
-- | Fade the 'Picture' by a number between 0 and 1
|
||||
fade :: Double -> Picture -> Picture
|
||||
fade opacity (r, g, b) = (f r, f g, f b)
|
||||
where
|
||||
f = cmap (*opacity)
|
||||
|
||||
-- | Set contrast level of 'Picture', a number between -255 and 255
|
||||
contrast :: Double -> Picture -> Picture
|
||||
contrast level (r, g, b) = (f r, f g, f b)
|
||||
where
|
||||
cfactor = (259 * (level + 255)) / (255 * (259 - level))
|
||||
f = cmap (\x -> pixelBound $ cfactor * (x - 128) + 128)
|
||||
|
||||
-- | Set brightness level of 'Picture', a number between -255 and 255
|
||||
brightness :: Double -> Picture -> Picture
|
||||
brightness level (r, g, b) = (f r, f g, f b)
|
||||
where
|
||||
f = cmap (pixelBound . (+level))
|
||||
|
||||
-- | Set gamma level of 'Picture'
|
||||
gamma :: Int -> Picture -> Picture
|
||||
gamma level (r, g, b) = (f r, f g, f b)
|
||||
where
|
||||
f = cmap (\x -> pixelBound $ 255 * (x / 255) ^ level)
|
||||
|
||||
-- | Inverts the 'Picture'
|
||||
invert :: Picture -> Picture
|
||||
invert (r, g, b) = (f r, f g, f b)
|
||||
where
|
||||
f = cmap (`subtract` 255)
|
||||
|
||||
{- | Rotate 'Picture' for the specified degrees, around the specified origin.
|
||||
- If the origin is `Nothing`, rotates around the center
|
||||
-}
|
||||
rotate :: Double -> Maybe (Int, Int) -> Picture -> Picture
|
||||
rotate deg orig (r, g, b) = (f r, f g, f b)
|
||||
where
|
||||
-- rotation in radians
|
||||
rad = deg * pi / 180
|
||||
|
||||
-- rotation matrix (clockwise)
|
||||
rm = fromLists [[cos rad, sin rad],
|
||||
[negate $ sin rad, cos rad]]
|
||||
|
||||
-- origin of rotation
|
||||
(originX, originY) = if isJust orig then fromJust orig else (cols r `div` 2, rows r `div` 2)
|
||||
|
||||
-- all index pairs
|
||||
indices = [vector [fromIntegral x - fromIntegral originX, fromIntegral y - fromIntegral originY] | y <- [0..rows r - 1], x <- [0..cols r - 1]]
|
||||
|
||||
-- rotate them using rotation matrix
|
||||
rotatedIndices :: [[Int]] = map (\r -> toList . V.map (fromIntegral . round) $ rm #> r) indices
|
||||
|
||||
-- move them back to the origin
|
||||
movedIndices = map (\[x, y] -> [x + originX, y + originY]) rotatedIndices
|
||||
|
||||
f m = reshape (cols m) $ fromList $ map (\[x, y] -> if y < 0 || y >= rows r || x < 0 || x >= cols r then 255 else m `atIndex` (y, x)) movedIndices
|
||||
|
||||
bound (l, u) x = max l $ min u x
|
||||
pixelBound = bound (0, 255)
|
27
src/highlight.js
Normal file
27
src/highlight.js
Normal file
@ -0,0 +1,27 @@
|
||||
|
||||
var highlight = function (on) {
|
||||
return function () {
|
||||
var links = document.getElementsByTagName('a');
|
||||
for (var i = 0; i < links.length; i++) {
|
||||
var that = links[i];
|
||||
|
||||
if (this.href != that.href) {
|
||||
continue;
|
||||
}
|
||||
|
||||
if (on) {
|
||||
that.classList.add("hover-highlight");
|
||||
} else {
|
||||
that.classList.remove("hover-highlight");
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
window.onload = function () {
|
||||
var links = document.getElementsByTagName('a');
|
||||
for (var i = 0; i < links.length; i++) {
|
||||
links[i].onmouseover = highlight(true);
|
||||
links[i].onmouseout = highlight(false);
|
||||
}
|
||||
};
|
55
src/style.css
Normal file
55
src/style.css
Normal file
@ -0,0 +1,55 @@
|
||||
body {
|
||||
background-color: #fdf6e3;
|
||||
}
|
||||
|
||||
.hs-identifier {
|
||||
color: #073642;
|
||||
}
|
||||
|
||||
.hs-identifier.hs-var {
|
||||
}
|
||||
|
||||
.hs-identifier.hs-type {
|
||||
color: #5f5faf;
|
||||
}
|
||||
|
||||
.hs-keyword {
|
||||
color: #af005f;
|
||||
}
|
||||
|
||||
.hs-string, .hs-char {
|
||||
color: #cb4b16;
|
||||
}
|
||||
|
||||
.hs-number {
|
||||
color: #268bd2;
|
||||
}
|
||||
|
||||
.hs-operator {
|
||||
color: #d33682;
|
||||
}
|
||||
|
||||
.hs-glyph, .hs-special {
|
||||
color: #dc322f;
|
||||
}
|
||||
|
||||
.hs-comment {
|
||||
color: #8a8a8a;
|
||||
}
|
||||
|
||||
.hs-pragma {
|
||||
color: #2aa198;
|
||||
}
|
||||
|
||||
.hs-cpp {
|
||||
color: #859900;
|
||||
}
|
||||
|
||||
a:link, a:visited {
|
||||
text-decoration: none;
|
||||
border-bottom: 1px solid #eee8d5;
|
||||
}
|
||||
|
||||
a:hover, a.hover-highlight {
|
||||
background-color: #eee8d5;
|
||||
}
|
66
stack.yaml
Normal file
66
stack.yaml
Normal file
@ -0,0 +1,66 @@
|
||||
# This file was automatically generated by 'stack init'
|
||||
#
|
||||
# Some commonly used options have been documented as comments in this file.
|
||||
# For advanced use and comprehensive documentation of the format, please see:
|
||||
# http://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||
# A snapshot resolver dictates the compiler version and the set of packages
|
||||
# to be used for project dependencies. For example:
|
||||
#
|
||||
# resolver: lts-3.5
|
||||
# resolver: nightly-2015-09-21
|
||||
# resolver: ghc-7.10.2
|
||||
# resolver: ghcjs-0.1.0_ghc-7.10.2
|
||||
# resolver:
|
||||
# name: custom-snapshot
|
||||
# location: "./custom-snapshot.yaml"
|
||||
resolver: lts-7.2
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
#
|
||||
# packages:
|
||||
# - some-directory
|
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||
# - location:
|
||||
# git: https://github.com/commercialhaskell/stack.git
|
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
# extra-dep: true
|
||||
# subdirs:
|
||||
# - auto-update
|
||||
# - wai
|
||||
#
|
||||
# A package marked 'extra-dep: true' will only be built if demanded by a
|
||||
# non-dependency (i.e. a user package), and its test suites and benchmarks
|
||||
# will not be run. This is useful for tweaking upstream packages.
|
||||
packages:
|
||||
- '.'
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||
# (e.g., acme-missiles-0.3)
|
||||
extra-deps: []
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
flags: {}
|
||||
|
||||
# Extra package databases containing global packages
|
||||
extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
#
|
||||
# Require a specific version of stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
# require-stack-version: ">=1.1"
|
||||
#
|
||||
# Override the architecture used by stack, especially useful on Windows
|
||||
# arch: i386
|
||||
# arch: x86_64
|
||||
#
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
# extra-lib-dirs: [/path/to/dir]
|
||||
#
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
2
test/Spec.hs
Normal file
2
test/Spec.hs
Normal file
@ -0,0 +1,2 @@
|
||||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
Loading…
Reference in New Issue
Block a user