{--
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 <http://www.gnu.org/licenses/>.
--}

module Graphics.OscPacking.Paint where

import Graphics.OscPacking.Packing
import Graphics.OscPacking.Interpret
import Graphics.Gloss

buildPicture :: Interpretation -> Packing -> Int -> Picture
buildPicture intp pkg maxcircles =
  translate ((-1) * boxWidth pkg / 2) ((-1) * boxHeight pkg / 2)
    (intp (take maxcircles (pack pkg)))

displayWindow :: (Int, Int) -> Color -> Picture -> IO ()
displayWindow (width, height) bg pic =
  display (InWindow "KC" (width, height) (0, 0)) bg pic

displayFullscreen :: (Int, Int) -> Color -> Picture -> IO ()
displayFullscreen (width, height) bg pic =
  display (FullScreen (width, height)) bg pic

growWindow :: (Int, Int) -> Color -> Interpretation -> Int -> Packing -> IO ()
growWindow (width, height) bg intp stepsPerSec pkg =
  simulate (InWindow "KC" (width, height) (0, 0)) bg stepsPerSec
    ([head circles], tail circles) toPic step
  where circles = pack pkg
        toPic (usedCircles, _) = translate ((-1) * boxWidth pkg / 2)
                                   ((-1) * boxHeight pkg / 2)
                                   (intp usedCircles)
        step _ _ (usedCircles, remCircles) = (head remCircles : usedCircles, tail remCircles)