Jack/image-triangles
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

upgrade from hip to massiv-io, move to nixpkgs unstable in the process

Browse source
This commit is contained in:
Jack Wines 2024-02-22 23:43:28 -08:00
parent 125762ea59
commit 87647dc427
No known key found for this signature in database
GPG key ID: 25B20640600571E6
5 changed files with 57 additions and 94 deletions
Download patch file Download diff file Expand all files Collapse all files

32
flake.lock generated
View file

@ -5,11 +5,11 @@
"nixpkgs-lib": "nixpkgs-lib"
},
"locked": {
"lastModified": 1704982712,
"narHash": "sha256-2Ptt+9h8dczgle2Oo6z5ni5rt/uLMG47UFTR1ry/wgg=",
"lastModified": 1706830856,
"narHash": "sha256-a0NYyp+h9hlb7ddVz4LUn1vT/PLwqfrWYcHMvFB1xYg=",
"owner": "hercules-ci",
"repo": "flake-parts",
"rev": "07f6395285469419cf9d078f59b5b49993198c00",
"rev": "b253292d9c0a5ead9bc98c4e9a26c6312e27d69f",
"type": "github"
},
"original": {
@ -20,11 +20,11 @@
},
"haskell-flake": {
"locked": {
"lastModified": 1705079807,
"narHash": "sha256-8snpmo0PGMqirgVnw9OnHF2FtsVkcdWLup+TzV3PCIE=",
"lastModified": 1708536395,
"narHash": "sha256-z6rxsqQ9/xS3FWc2iLvFnElNt45XehD7bzPe4Yooz08=",
"owner": "srid",
"repo": "haskell-flake",
"rev": "55efd0cbf1b5b4a402dc88c3c962c24e13f0fd8b",
"rev": "1e297173b23c5113dd90a2d299d6e0d864af35f1",
"type": "github"
},
"original": {
@ -51,16 +51,16 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1704290814,
"narHash": "sha256-LWvKHp7kGxk/GEtlrGYV68qIvPHkU9iToomNFGagixU=",
"lastModified": 1708475490,
"narHash": "sha256-g1v0TsWBQPX97ziznfJdWhgMyMGtoBFs102xSYO4syU=",
"owner": "nixos",
"repo": "nixpkgs",
"rev": "70bdadeb94ffc8806c0570eb5c2695ad29f0e421",
"rev": "0e74ca98a74bc7270d28838369593635a5db3260",
"type": "github"
},
"original": {
"owner": "nixos",
"ref": "nixos-23.05",
"ref": "nixos-unstable",
"repo": "nixpkgs",
"type": "github"
}
@ -68,11 +68,11 @@
"nixpkgs-lib": {
"locked": {
"dir": "lib",
"lastModified": 1703961334,
"narHash": "sha256-M1mV/Cq+pgjk0rt6VxoyyD+O8cOUiai8t9Q6Yyq4noY=",
"lastModified": 1706550542,
"narHash": "sha256-UcsnCG6wx++23yeER4Hg18CXWbgNpqNXcHIo5/1Y+hc=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "b0d36bd0a420ecee3bc916c91886caca87c894e9",
"rev": "97b17f32362e475016f942bbdfda4a4a72a8a652",
"type": "github"
},
"original": {
@ -115,11 +115,11 @@
]
},
"locked": {
"lastModified": 1704649711,
"narHash": "sha256-+qxqJrZwvZGilGiLQj3QbYssPdYCwl7ejwMImgH7VBQ=",
"lastModified": 1708335038,
"narHash": "sha256-ETLZNFBVCabo7lJrpjD6cAbnE11eDOjaQnznmg/6hAE=",
"owner": "numtide",
"repo": "treefmt-nix",
"rev": "04f25d7bec9fb29d2c3bacaa48a3304840000d36",
"rev": "e504621290a1fd896631ddbc5e9c16f4366c9f65",
"type": "github"
},
"original": {

28
flake.nix
View file

@ -1,14 +1,12 @@
{
description = "srid/haskell-template: Nix template for Haskell projects";
inputs = {
nixpkgs.url = "github:nixos/nixpkgs/nixos-23.05";
nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
systems.url = "github:nix-systems/default";
flake-parts.url = "github:hercules-ci/flake-parts";
haskell-flake.url = "github:srid/haskell-flake";
treefmt-nix.url = "github:numtide/treefmt-nix";
treefmt-nix.inputs.nixpkgs.follows = "nixpkgs";
hip.url = "github:lehins/hip";
hip.flake = false;
};
outputs = inputs:
@ -30,28 +28,10 @@
packages = {
# Add source or Hackage overrides here
# (Local packages are added automatically)
# https://github.com/lehins/hip.git
# hip.source = inputs.hip + "/hip";
};
# Add your package overrides here
settings = {
/*
haskell-template = {
haddock = false;
};
aeson = {
check = false;
};
*/
hip = {
jailbreak = true;
broken = false;
failOnAllWarnings = false;
check = false;
# extraBuildFlags = ["--ghc-option=-Wno-incomplete-uni-patterns"];
};
};
# Development shell configuration
@ -75,12 +55,6 @@
# We use fourmolu
programs.ormolu.package = pkgs.haskellPackages.fourmolu;
settings.formatter.ormolu = {
options = [
"--ghc-opt"
"-XImportQualifiedPost"
];
};
};
# Default package & app.

4
image-triangles.cabal
View file

@ -77,11 +77,13 @@ executable image-triangles
build-depends: base
, random
, array
, hip
, vector-th-unbox
, colour
, Color
, diagrams-lib
, diagrams-cairo
, massiv-io
, massiv
, diagrams-svg
, diagrams-contrib
, parallel

43
src/Main.hs
View file

@ -12,7 +12,11 @@ import Data.Colour.RGBSpace (uncurryRGB)
import qualified Data.Colour.SRGB as CL
import qualified Data.Colour.SRGB.Linear as CL
import Data.List
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Massiv.Array as M
import qualified Data.Massiv.Array as Ma
import qualified Data.Massiv.Array.IO as M
import qualified Data.Maybe as My
import qualified Data.Set as S
import qualified Data.Vector.Unboxed as Vec
@ -26,9 +30,7 @@ import Diagrams.Backend.SVG.CmdLine
import Diagrams.Prelude
import qualified Diagrams.Prelude as D
import GHC.Generics
import Graphics.Image as Img hiding (map, zipWith)
import qualified Graphics.Image.ColorSpace as G
import qualified Graphics.Image.Interface as Int
import qualified Graphics.Color.Space as Co
import qualified MinDistanceSample as MDS
import Options.Generic
import qualified System.Environment as Env
@ -38,11 +40,8 @@ import System.Random.SplitMix
import Triangles (getTriangleAverageRGB)
import qualified Triangles as Tri
-- CL.rgb might be the wrong fn...
tosRGB' :: (Ord b, Floating b) => Pixel G.RGB b -> CL.Colour b
tosRGB' (G.PixelRGB r g b) = CL.rgb r g b
convImage = Vec.map tosRGB' . Int.toVector
toColour :: Fractional a => Co.Color (Co.SRGB Co.Linear) a -> Colour a
toColour (Co.ColorSRGB r g b) = CL.rgb r g b
corners :: [(Double, Double)]
corners = (,) <$> [0, 1] <*> [0, 1]
@ -50,8 +49,8 @@ corners = (,) <$> [0, 1] <*> [0, 1]
shapeCircumference :: [Point V2 Double] -> Double
shapeCircumference = Data.List.sum . map D.norm . loopOffsets . fromVertices
genImage :: Image VU G.RGB Double -> Double -> StdGen -> QDiagram SVG V2 Double Any
genImage image minDistance gen =
genImage :: M.Image M.S (Co.SRGB 'Co.Linear) Double -> V2 Double -> Double -> StdGen -> QDiagram SVG V2 Double Any
genImage image dimensionsVec minDistance gen =
scaleX widthHeightRatio
. reflectY
. rectEnvelope (mkP2 0 0) (1 ^& 1)
@ -64,17 +63,16 @@ genImage image minDistance gen =
where
drawVoroniRegion shape =
lw 0
. fillColor (Tri.voroniRegionAverageColor img' dimensions shape)
. fillColor (Tri.voroniRegionAverageColor image dimensions shape)
. strokeLocLoop
. fromVertices
$ shape
widthHeightRatio :: Double
widthHeightRatio = (fromIntegral . fst $ dimensions) / (fromIntegral . snd $ dimensions)
widthHeightRatio = (dimensionsVec ^. _x) / (dimensionsVec ^. _y)
img' = convImage image
dimensions = uncurry (flip (,)) . Img.dims $ image
dimensionsVec = fromIntegral <$> uncurry V2 dimensions
dimensions :: (Int, Int)
dimensions = (ceiling $ dimensionsVec ^. _x, ceiling $ dimensionsVec ^. _y)
singleVoroni = last voroni
@ -94,7 +92,7 @@ genImage image minDistance gen =
averageSideSize = (fromIntegral (uncurry (+) dimensions)) / 2
padding = (/) 10 . (*) widthHeightRatio <$> V2 1 1
padding = (/ 10) <$> V2 1 1
corners' :: [P2 Double]
corners' = map (p2 . Bi.first (/ widthHeightRatio) . unp2 . (.-^ ((/ 2) <$> padding))) . MDS.randomPoints ((mkP2 widthHeightRatio 1) .+^ padding) (minDistance * widthHeightRatio) $ gen
@ -102,10 +100,11 @@ genImage image minDistance gen =
deriving instance Generic (CL.RGB a)
deriving instance NFData a => NFData (CL.RGB a)
toDimensionVector :: (Int.BaseArray arr cs e, Fractional n) => Image arr cs e -> SizeSpec V2 n
toDimensionVector :: (Ma.Size r, Fractional a) => Ma.Array r Ma.Ix2 e -> V2 a
toDimensionVector image =
Diagrams.Prelude.dims $
p2 (fromIntegral $ cols image, fromIntegral $ rows image) .-. p2 (0.0, 0.0)
p2 (fromIntegral $ cols, fromIntegral $ rows) .-. p2 (0.0, 0.0)
where
(M.Sz2 rows cols) = Ma.size image
data CLIOptions = CLIOptions
{ input :: FilePath
@ -121,6 +120,6 @@ main = do
CLIOptions{..} <- getRecord "image options"
gen' <- getStdGen -- for consistency, swap with something like: pure . mkStdGen $ 2344
print gen'
image <- Img.readImageRGB VU input
let dimVector = toDimensionVector image
renderSVG output dimVector (genImage image minDistance gen')
image :: M.Image M.S (Co.SRGB 'Co.Linear) Double <- M.readImageAuto input
let dims = toDimensionVector image
renderSVG output (Diagrams.Prelude.dims dims) (genImage image dims minDistance gen')

44
src/Triangles.hs
View file

@ -2,16 +2,21 @@ module Triangles where
import Control.Arrow
import Control.Parallel.Strategies
import qualified Data.Array as A
import qualified Data.Colour as C
import qualified Data.Colour.Names as C
import Data.Colour.SRGB.Linear (Colour)
import qualified Data.Colour.SRGB.Linear as C
import qualified Data.Colour.SRGB.Linear as CL
import Data.Fixed
import qualified Data.Function as F
import Data.List
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Massiv.Array as Ma
import qualified Data.Massiv.Array.IO as Ma
import Data.Maybe
import qualified Data.Ord as O
import Data.Ratio
import qualified Data.Set as S
import Data.Vector.Generic.Base (Vector)
@ -26,27 +31,14 @@ import Diagrams.Trail (trailPoints)
import Diagrams.TwoD
import qualified Diagrams.TwoD.Path.IntersectionExtras as I
import Diagrams.TwoD.Segment.Bernstein (listToBernstein)
import qualified Graphics.Image as H
import qualified Graphics.Color.Space as Co
import System.Random
type Image_ = Vec.Vector Pixel_
type Pixel_ = Colour Double
toSRGBTuple :: Pixel_ -> (Double, Double, Double)
toSRGBTuple = srgb' . C.toRGB
where
srgb' (C.RGB{C.channelRed = red, C.channelGreen = green, C.channelBlue = blue}) = (red, green, blue)
fromSRGBTuple :: (Double, Double, Double) -> Pixel_
fromSRGBTuple (r, g, b) = C.rgb r g b
derivingUnbox
"Pixel_"
[t|Pixel_ -> (Double, Double, Double)|]
[|toSRGBTuple|]
[|fromSRGBTuple|]
toColour :: Fractional a => Co.Color (Co.SRGB Co.Linear) a -> Colour a
toColour (Co.ColorSRGB r g b) = CL.rgb r g b
-- from -0.05 to 1.05 so there aren't missing/elongated triangles at the edges
borderSize :: Double
borderSize = 0.05
randomPoints :: StdGen -> [(Double, Double)]
@ -171,10 +163,12 @@ getPointsInTriangle image pts =
where
[p1, p2, p3] = sortOn fst . map unp2 . S.toList $ pts
blendEqually colors = C.affineCombo (zip (repeat fraction) colors) $ C.blue
blendEqually :: (Ord a, Floating a) => [Colour a] -> Colour a
blendEqually colors = C.affineCombo (zip (repeat fraction) colors) $ C.white
where
fraction = 1.0 / (fromIntegral . length $ colors)
voroniRegionAverageColor :: (Integral a, Integral b) => Ma.Image Ma.S (Co.SRGB 'Co.Linear) Double -> (a, b) -> [P2 Double] -> Colour Double
voroniRegionAverageColor image (x', y') verticies =
blendEqually
. concatMap (getColorsInTriangle image (x', y'))
@ -191,24 +185,18 @@ voroniRegionAverageColor image (x', y') verticies =
scaleToUnitCoords :: P2 Int -> P2 Double
scaleToUnitCoords p = p2 ((fromIntegral x' / (fromIntegral $ p ^. _x)), fromIntegral y' / (fromIntegral $ p ^. _y))
getColorsInTriangle :: Image_ -> (Int, Int) -> S.Set (P2 Int) -> [C.Colour Double]
getColorsInTriangle :: Ma.Image Ma.S (Co.SRGB 'Co.Linear) Double -> (a, b) -> S.Set (P2 Int) -> [Colour Double]
getColorsInTriangle image (x', y') triangle = pixels
where
pixels :: [Pixel_]
pixels = mapMaybe index' points
points :: [(Int, Int)]
points = getPointsInTriangle image triangle
index' :: (Int, Int) -> Maybe Pixel_
index' (x, y)
| y >= y' = Nothing
| x >= x' = Nothing
| y < 0 = Nothing
| x < 0 = Nothing
| otherwise = image Vec.!? ((y * x') + x)
index' :: (Int, Int) -> Maybe (C.Colour Double)
index' (x, y) = toColour . Ma.pixelColor <$> Ma.index image (Ma.Ix2 y x)
getTriangleAverageRGB :: Image_ -> (Int, Int) -> S.Set (P2 Int) -> C.Colour Double
getTriangleAverageRGB :: Ma.Image Ma.S (Co.SRGB 'Co.Linear) Double -> (a, b) -> S.Set (P2 Int) -> Colour Double
getTriangleAverageRGB image (x', y') triangle = blendEqually $ getColorsInTriangle image (x', y') triangle
ptsBtween :: LineMXB -> LineMXB -> [(Int, Int)]