{-- This file is part of the OscPacking library. Copyright 2016 Christopher Howard. OscPacking is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. OscPacking is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with OscPacking. If not, see . --} module Graphics.OscPacking.Packing ( Packing(..), defaultPacking, pack ) where import Graphics.OscPacking.Geometry import System.Random import Graphics.OscPacking.Boundary fit :: Maybe Float -> Point -> [Circle] -> Maybe Boundary -> Maybe Circle fit cap point srtCircles boundary = fmap (\distance -> Circle { position = point, radius = distance }) (foldr chooseCloser (Just (1/0)) srtCircles) where chooseCloser _ Nothing = Nothing chooseCloser circle (Just minval) = let d = distToCircle point circle in if d <= 0 then Nothing else let upperlim = case cap of Nothing -> 1 / 0 Just cap' -> cap' in case boundary of Nothing -> Just (min upperlim (min d minval)) Just boundary' -> case boundary' point of Nothing -> Nothing Just bDist -> Just (min bDist (min upperlim (min d minval))) data Packing = Packing { boxWidth :: Float, boxHeight :: Float, capRadius :: Maybe Float, boundary :: Maybe Boundary, startingCircles :: [Circle], seedX :: Int, seedY :: Int } defaultPacking :: Packing defaultPacking = Packing { boxWidth = 800.0, boxHeight = 600.0, capRadius = Nothing, boundary = Just (rectB (20, 20) 760 560), startingCircles = [Circle { position = (400, 300), radius = 10 }], seedX = 1, seedY = 2 } rndPoints :: Float -> Float -> Int -> Int -> [Point] rndPoints width height xseed yseed = zip xvals yvals where (xgen, ygen) = (mkStdGen xseed, mkStdGen yseed) (xvals, yvals) = (randomRs (0, width) xgen, randomRs (0, height) ygen) -- Provides /infinite/ list of Circles pack :: Packing -> [Circle] pack pkg = (startingCircles pkg) ++ build (startingCircles pkg) points where points = rndPoints (boxWidth pkg) (boxHeight pkg) (seedX pkg) (seedY pkg) build accCircles remPoints = case fit (capRadius pkg) (head remPoints) accCircles (boundary pkg) of Nothing -> build accCircles (tail remPoints) Just circle -> circle : build (circle : accCircles) (tail remPoints)