{-#LANGUAGE OverloadedLists #-}
{-#LANGUAGE FlexibleContexts #-}
module ProductMixAuction.DotBids.Visualize
where

import Codec.Picture
import ProductMixAuction.DotBids
import Data.List (foldl')
import qualified Data.Vector.Storable as StorableVector
import Control.Lens ( (^.) )

visualizeBidsDemand :: Int -> Int -> [DotBid b] -> Image PixelRGBF
visualizeBidsDemand w h bids =
  additiveBlend
    (colorize 5 red good1Img)
    (colorize 5 blue good2Img)

  where
    (good1Img, good2Img) = drawBidsDemand w h bids
    red = PixelRGBF 1 0 0
    blue = PixelRGBF 0 0 1

drawBidsDemand :: Int -> Int -> [DotBid b] -> (Image PixelF, Image PixelF)
drawBidsDemand w h bids =
  ( drawBidsDemandOn 1 w h bids
  , drawBidsDemandOn 2 w h bids
  )

colorize :: PixelF -> PixelRGBF -> Image PixelF -> Image PixelRGBF
colorize maxIn targetOut src =
  pixelMap (colorMapPixel . toRGBF) $ src
  where
    colorMapPixel =
      mixWith
        (\_ input target -> input / maxIn * target)
        targetOut
    toRGBF :: PixelF -> PixelRGBF
    toRGBF i = PixelRGBF i i i

additiveBlend :: (Pixel a, Num (PixelBaseComponent a))
              => Image a -> Image a -> Image a
additiveBlend (Image w1 h1 px1) (Image _w2 _h2 px2) =
  Image w1 h1 $ StorableVector.zipWith (+) px1 px2

drawBidsDemandOn :: Good -> Int -> Int -> [DotBid b] -> Image PixelF
drawBidsDemandOn good w h =
  foldl' additiveBlend emptyImage . map (drawBidDemandOn good w h)
  where
    emptyImage = generateImage (const $ const 0) w h

drawBidDemandOn :: Good -> Int -> Int -> DotBid b -> Image PixelF
drawBidDemandOn i w h bid =
  generateImage demandAt w h
  where
    demandAt x y =
      let p = mkPV2 (fromIntegral x, fromIntegral (h - y))
      in
        if isNonMarginallyAcceptedOn i p bid then
          fromIntegral (_Units $ bid ^. dotBidQuantity)
        else
          0