{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Rumpus.TestScene where

import Rumpus

-- | For profiling (where we can't run code)
-- and for other prototyping.

loadTestScene :: ECSMonad ()
loadTestScene = do
    -- testEntity <- spawnEntity $ return ()
    -- addCodeExpr testEntity "CollisionBegan" "collisionStart" myCollisionBeganExpr myCollisionBegan
    -- selectEntity testEntity


    -- Spawn objects
    forM_ [room, city, fountain] $ \onStart -> do
    --forM_ [room] $ \onStart -> do
        spawnEntity $ do
            myStart ==> onStart
            mySize  ==> 0.3
            myShape ==> Cube

    setWorldPlaying True

    return ()

------------------------------------------------------------------------------
-- Room
roomCube, roomW, roomH, roomD, wallD, shelfH, roomOffset :: GLfloat
roomCube = 4
(roomW, roomH, roomD) = (roomCube,roomCube,roomCube)
wallD = 1
shelfH = 0.15

roomOffset = (roomH/2 - wallD/2)

room :: Start
room = do
    setPose (identity & translation .~ V3 0 roomOffset (-roomD/2 + 0.4))
    removeChildren
    builderID <- ask
    let makeWall pos size hue = spawnEntity_ $ do
            myParent            ==> builderID
            myPose              ==> position (pos & _y +~ roomOffset)
            myShape             ==> Cube
            myBody              ==> Animated
            myBodyFlags         ==> [Ungrabbable]
            mySize              ==> size
            myColor             ==> colorHSL hue 0.8 0.6
            myMass              ==> 0
    --makeWall (V3 0 0 (-roomD/2)) (V3 roomW roomH wallD) 0.1 -- back
    --makeWall (V3 0 0 (roomD/2))  (V3 roomW roomH wallD) 0.2 -- front
    --makeWall (V3 (-roomW/2) 0 0) (V3 wallD roomH roomD) 0.3 -- left
    --makeWall (V3 (roomW/2)  0 0) (V3 wallD roomH roomD) 0.4 -- right
    makeWall (V3 0 (-roomH/2) 0) (V3 roomW wallD roomD) 0.5 -- floor
    makeWall (V3 0 (roomH/2)  0) (V3 roomW wallD roomD) 0.6 -- ceiling

    let numShelves = 4
    forM_ [1..(numShelves - 1)] $ \n -> do
        let shelfY = (roomH/realToFrac numShelves)
                        * n - (roomH/2)
        makeWall (V3 0 shelfY (roomD/2))
                 (V3 roomW shelfH (wallD*2)) 0.7 -- shelf


-------------------------------------------------------------------------------
-- City

-- Golden Section Spiral
-- (via http://www.softimageblog.com/archives/115)
pointsOnSphere :: Int -> [V3 GLfloat]
pointsOnSphere (fromIntegral -> n) =
    let inc = pi * (3 - sqrt 5)
        off = 2 / n
    in flip map [0..n] $ \k ->
        let y = k * off - 1 + (off / 2)
            r = sqrt (1 - y*y)
            phi = k * inc
        in V3 (cos phi * r) y (sin phi * r)

city :: Start
city = do
    removeChildren
    createBuildings
    createStars

createBuildings :: EntityMonad ()
createBuildings = do
    rootEntityID <- ask
    let n = 8
        dim = 200
        height = dim * 5
        buildSites = [V3 (x * dim * 2) (-height) (z * dim * 2) | x <- [-n..n], z <- [-n..n]]
    forM_ (zip [0..] buildSites) $ \(_i::Int, V3 x y z) -> do
        hue <- liftIO randomIO

        when (x /= 0 && z /= 0) $ spawnEntity_ $ do
            myParent               ==> rootEntityID
            myPose                 ==> position (V3 x y z)
            myShape                ==> Cube
            --myUpdate ==> do
            --    now <- getNow
            --    let newHeight = ((sin (now+_i) + 1) + 1) * height
            --    setSize (V3 dim newHeight dim)
            mySize                 ==> V3 dim height dim
            myColor                ==> colorHSL hue 0.8 0.8

createStars :: EntityMonad ()
createStars = do
    rootEntityID <- ask

    let numPoints = 300 :: Int
        sphere = pointsOnSphere numPoints
        hues = map ((/ fromIntegral numPoints) . fromIntegral) [0..numPoints]
    forM_ (zip sphere hues) $ \(pos, hue) -> spawnEntity_ $ do
        myParent           ==> rootEntityID
        myPose             ==> position (pos * 1000)
        myShape            ==> Sphere
        mySize             ==> 5
        myColor            ==> colorHSL hue 0.8 0.8

-------------------------
-- Fountain

rate :: Float
rate = 10

majorScale :: [GLfloat]
majorScale = map (+60) [0,2,4,7,9]

fountain :: Start
fountain = do
    removeChildren

    myUpdate ==> do
        withState $ \timer -> do
            shouldSpawn <- checkTimer timer
            when shouldSpawn $ do
                -- Play a note
                note <- randomFrom majorScale
                sendSynth "note" (Atom $ realToFrac note)

                -- Spawn a ball
                pose <- getPose
                _ <- spawnEntity $ do
                    myPose      ==> pose & translation +~
                                        (pose ^. _m33) !* (V3 0 0.3 0)
                    myShape ==> Sphere
                    mySize      ==> 0.03
                    myMass      ==> 0.1
                    myColor     ==> colorHSL (note / 12) 0.9 0.8
                    myStart     ==> do
                        setLifetime 10
                        applyForce $ (pose ^. _m33) !* (V3 0 0.3 0)

                -- Create a new timer
                newTimer <- createNewTimer rate
                setState newTimer

    -- Create the initial timer
    newTimer <- createNewTimer rate
    setState newTimer
