From 87647dc427a4c970581c44f1fcc2ef322e15d44d Mon Sep 17 00:00:00 2001 From: Jack Wines Date: Thu, 22 Feb 2024 23:43:28 -0800 Subject: [PATCH] upgrade from hip to massiv-io, move to nixpkgs unstable in the process --- flake.lock | 32 +++++++++++++++---------------- flake.nix | 28 +-------------------------- image-triangles.cabal | 4 +++- src/Main.hs | 43 +++++++++++++++++++++--------------------- src/Triangles.hs | 44 ++++++++++++++++--------------------------- 5 files changed, 57 insertions(+), 94 deletions(-) diff --git a/flake.lock b/flake.lock index f07fab7..bce3794 100644 --- a/flake.lock +++ b/flake.lock @@ -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": { diff --git a/flake.nix b/flake.nix index 908fd84..5d0cd0c 100644 --- a/flake.nix +++ b/flake.nix @@ -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. diff --git a/image-triangles.cabal b/image-triangles.cabal index 26d9bec..b50f77a 100644 --- a/image-triangles.cabal +++ b/image-triangles.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs index dc0fa8f..0975055 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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') diff --git a/src/Triangles.hs b/src/Triangles.hs index 869833c..fc266d4 100644 --- a/src/Triangles.hs +++ b/src/Triangles.hs @@ -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)]