-- | 
-- Module:     FRP.Timeless.Tutorial2
-- Copyright:  (c) Rongcui Dong, 2015
-- License:    BSD3
-- Maintainer: Rongcui Dong <karl_1702@188.com>

{-# LANGUAGE Arrows #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

module FRP.Timeless.Tutorial2
       (
         -- * Warning
         -- $Warning
         
         -- * Introduction
         -- $Introduction

         -- * Input/Output
         -- $IO
         sInput
       , drawPlayerAt
       , testIO
         
         -- * Game State
         -- ** Player State
         -- $GameState-Player
       , Move(..)
       , updatePosX
       , sPlayerX
       , toMove
       , testPlayer
         
         -- ** Enemy State
         -- $GameState-Enemy
       , EnemyEvent(..)
       , Enemy(..)
       , dPos
       , sUpdateEnemy0
       , testEnemy0

       -- ** Player State, Again
       -- $GameState-Player2
       , Player(..)
       , PlayerEvent(..)
       , updatePosX'
       , sToFireSig
       , sFire
       , sUpdatePlayer
       , toPlayerEvent
       , testPlayer2
         
       -- ** Firing Bullets
       -- $GameState-Bullets
       , Bullet(..)

       -- ** Enemy State, Again
       -- $GameState-Enemy2
       , sUpdateBoundedPosition
       , testUBP
       , sUpdateEnemy
       , testEnemy

       -- * Dynamic Generating and Collision Handling
       -- $DGCH
       , sDrawEnemies
       , sDrawBullets
       , spawnBullet
       , bulletIsOutOfBound
       , collides
       , sBulletStep
       , sBullets
       , sDrawPlayer
       , updateEnemies
       , sBulletEnemies
       , main
       )
       where

import Prelude hiding ((.))
import System.Console.ANSI
import FRP.Timeless
import FRP.Timeless.Framework.Console
import Data.Char
import Data.Monoid
import Control.Monad.Fix
import Linear
import Linear.Affine
import Control.Monad.IO.Class
import qualified Debug.Trace as D

-- $Warning
--
-- This tutorial gets really messed up at the final part since the
-- data structures used were not completely a good fit of the
-- problem. It has currently some bugs, mainly related to
-- rendering. Basically, the bullet and enemies do not disappear from
-- screen after destroyed; random ANSI sequences pollutes the
-- screen. I know some solutions, but it changes quite a bit of this
-- program, and I don't want to spend too much time on Console
-- framework since my main goal is to make something work under SDL,
-- gtk, etc. Also, since I have changed the program structure quite a
-- bit, there might be some minor mismatch in the
-- explanation. However, this tutorial is still a good reference on
-- how to implement things in @timeless@.
--
-- Maybe I should plan the control flow on paper first, like when I
-- started learning imperative language, or when I started with
-- functional languages, or when I started with Monads, since FRP is
-- still not quite my native language yet.
--
-- P.S. The solutions are:
-- 
-- 1. Clear screen every frame, which flickers violently
-- 
-- 2. Use the "stateful draw", which basically requires me to
-- rewrite the whole dynamic logic

-- $Introduction
--
-- In this tutorial, we are going to use the framework
-- "FRP.Timeless.Framework.Console" to build a small console game,
-- "SpHase Invadoors"!
--
-- The console framework is based on "System.Console.ANSI", so make
-- sure you have that installed.
--
-- Also, as a prerequisite, please read tutorial 1 in module
-- "FRP.Timeless.Tutorial". Sorry that I did not expect Haddock
-- doesn't work as I expected with Literate Haskell, so please read
-- the source of that instead.
--
-- Just a warning, this tutorial is written as a guide for my
-- development. Therefore, it is the case that @timeless@ will be much
-- more extensive at the end of the tutorial than it is at the
-- beginning. Also, my understanding of the problem will change as I
-- write this tutorial, so expect some style difference in the code,
-- and probably quite a few wrappers to adapt older code to newer
-- ones. Nevertheless, these wrappers and adapters should show
-- multiple ways how a @timeless@ program can be structured.


-- $IO
--
-- First, since this is a game, we cannot block IO. Therefore, we use
-- 'sInputNonBlocking'. Notice that the signals in this tutorial may have
-- different meanings from the previous one. In this case, 'sInputNonBlocking'
-- no longer waits for an interval, but just checks whether input is available.
--
-- > sInput = sInputNonBlocking
--
-- To make a nice output for the game, let's consider creating a
-- bounding box that is 60x30 character size, giving a board size of
-- 58x28, and changes color on request. We won't make that a separate
-- signal since semantically, we cannot guarentee the evaluation order
-- of different 'Signal's. We will need a unified 'sOutput', which
-- will be built along this tutorial.
--
-- We will implement a function to draw the player spaceship, which is
-- just a charcter @^@ on the bottom line. Making use of the
-- 'drawChar' function provided, we can easily create a signal
-- 'drawPlayerAt' (read the source), which takes the column number and
-- draws the player. However, if we just implement by clearing a line
-- and drawing a new character, serious flicker will
-- appear. Therefore, we implement a stateful version that keeps track
-- of the previous position. This function can easily be composed into
-- a larger stateful render action. Notice that the initial value of
-- 'drawChar' is set to (-1) since it is an impossible value for a
-- normal update, so the console is rendered correctly on the first
-- "frame". A similar function provided in the framework is
-- 'drawCharS', and a signal 'sMoveChar'
--
-- Again, testing with @timeless@ is easy: Just connect a simple
-- box. Here, the test function is `testIO`, where almost everything
-- is hard coded. But for a testing, it is fine. Be careful that if
-- you interrupt the program, it is likely to color stain your console.



sInput = sInputNonBlocking

-- | Draws a vivid white @^@ on the bottom line, and deals with flickering
drawPlayerAt :: Int -> Int -> IO Int
drawPlayerAt c c'
    | c /= c' =
      do
        -- v Clear line
        clearLineRange 28 1 59
        -- V Draw character
        drawChar '^' 28 c' Vivid White
        return c'
    | otherwise = return c

testIO = initConsole defaultInitConfig >> runBox clockSession_ b
    where
      fMove x0 (Just c) | toLower c == 'a' = x0-1
                        | toLower c == 'd' = x0+1
                        | otherwise = x0
      fMove x0 _ = x0
      fBound x | x > 59 = 59
               | x < 1 = 1
               | otherwise = x
      b = proc _ -> do
        mc <- sInput -< ()
        x <- (arr fBound) <<< (mkSW_ 30 fMove) -< mc
        mkSK_ (-1) drawPlayerAt -< x
        returnA -< ()

-- $GameState-Player
-- 
-- Next, we are going to make something complicated. Considering that
-- this is a __game__, we don't want the objects to move
-- unevenly. At the same time, we want to give the ability to 'cooldown'.
--
-- Before all that, let's look at the central game states. Player first!
--
-- Since only the X coordinate matters, our state for the player is
-- just one integer, giving an overall state transition function of
-- type, where 'Move' is the type for the player input. In this game,
-- `Move' is just an enumerate.
-- 
-- > Int -> Move -> Int
--
-- Look at 'sPlayerX' to get an idea. In order to get the 'Move' data
-- from user input, we need another signal that converts `Maybe Char`
-- to 'Move':
--
-- > Signal s m (Maybe Char) Move
--
-- We will call this function 'toMove'. Again, try to construct a box
-- for testing: `testPlayer`. 

data Move = MLeft | MRight | MStay deriving (Show)


-- | Updates an X coordinate
updatePosX x MLeft | x <= 1 = 1
                   | otherwise = x-1
updatePosX x MRight | x >= 59 = 59
                    | otherwise = x+1
updatePosX x _ = x

-- | The stateful signal of player X coordinate
sPlayerX :: (Monad m) => Signal s m Move Int
sPlayerX = mkSW_ 30 updatePosX -- 30 is the middle

-- | Convert a keypress to 'Move'
toMove Nothing = MStay
toMove (Just c)
    | toLower c == 'a' = MLeft
    | toLower c == 'd' = MRight
    | otherwise = MStay

testPlayer = initConsole defaultInitConfig >> runBox clockSession_ b
    where
      b = proc _ -> do
        mkActM $ asciiBox 60 30 Vivid Green -< ()
        mc <- sInput -< ()
        mv <- arr toMove -< mc
        x <- sPlayerX -< mv
        mkSK_ (-1) drawPlayerAt -< x
        returnA -< ()

-- $GameState-Enemy
--
-- As a foreword, run 'testEnemy0' to see how enemy data is
-- updated. Press 'k' (lower case, for simplicity) to kill the enemy
--
-- After getting a working player state, we are going to create the
-- data and states for ememies. For this simple demo game, the enemy
-- only keeps three states: Position, movement, and live. Let's make a
-- data type for enemy, 'Enemy', and a data type for enemy related
-- events, 'EnemyEvent'. Since we want modularity, we will compose a
-- big signal, 'sUpdateEnemy0' with the type:
--
-- > sUpdateEnemy0 :: (Monad m) => Enemy -> Signal s m EnemyEvent Enemy
--
-- Inspecting the type, we know that this signal is pure. We are going
-- to create this signal from some small and reusable ones. Check the
-- source to have a glance. I will explain each part.
--
-- First, let's handle the position update. /Physically/, the position
-- is just the integral of velocity over time. Note that although
-- enemies can only occupy integer positions, internally we can keep
-- fractional positions. Therefore, we use the following prefab signal:
--
-- > integrateM :: (Monad m, Monoid b, Monoid s) => b -> (s -> a -> b) -> Signal s m a b
--
-- Does it look familiar? It looks just like an extension of the
-- `mkSW_` factory! Let's first guess what this signal does from the
-- type of its factory.
--
-- `s` is a 'Monoid' because it is the delta 'Session', or time. The
-- input type is 'a', output type is `b`, and it has to be a
-- 'Monoid'. We are supplying one single `b`, and a function with type
-- `s -> a -> b`. First, the single `b` is probably an initial
-- state. Then, being a 'Monoid' means that two `b`s can be combined
-- together. If the function supplied just generates a new `b` like
-- `mkSW_` does, then there is no need to make it a
-- `Monoid`. Therefore, we can conclude that the function supplied
-- must produce the difference between the current state and the next
-- state.
--
-- As stated, we need a 'Monoid' for integration. Since numerical
-- integration involves summing the results of each step, if we use
-- the 'integrateM' factory, we will use the monoid 'Sum' provided by
-- "Data.Monoid". However, since numerical integration is so common,
-- there is a more convenient signal factory:
--
-- > integrate :: (Monad m, Num a, Monoid s) => a -> (s -> a -> a) -> Signal s m a a
--
-- In the code of 'sUpdateEnemy0', this line models the system of enemy
-- position:
--
-- > p' <- integrate p0 dPos -< dP'
--
-- It reads very clear: integratethe velocity vector (__dP__) over
-- time using function 'dPos' to get the enemy position.
--
-- Then, since our 'Enemy' type stores integer position, we need to
-- round the fractional position:
--
-- > iP' <- arr (fmap round) -< p'
--
-- The other thing to model is whether the enemy is alive. This is
-- easy too:
--
-- > a' <- latchR <<< arr (\case {EKill -> True; _ -> False}) -< ev
--
-- I used the LambdaCase extension to make the lambda very
-- short. 'latchR' is one of the latches provided in
-- "FRP.Timeless.Prefab", which outputs 'True' until the input becomes
-- 'True', then it latches at 'False'. If you know digital circuits,
-- think "Reset Latch". Side note: as you may guess, there are
-- actually three latches at the time of writing: 'latch', 'latchS',
-- 'latchR'.
--
-- A latch is used here because events are discrete, and we know that
-- enemies die when they are killed. Of course the hero don't like to
-- see that an enemy has to be constantly killed to be dead!
--
-- Finally, we just return an updated copy of enemy, and return. Don't
-- worry about constantly making new objects: the garbage collector
-- will do its work. Also note that due to Haskell's laziness, if a
-- Signal is not used, it will not be evaluated. If you try to debug a
-- signal, make sure to wire it up to 'sDebug' somewhere, or use its
-- output in some way that forces evaluation (such as printing or
-- pattern matching).
--
-- The 'testEnemy0' function is easy, too. We just takes input, create
-- events out of them, feed the event to an enemy, and finally print
-- the enemy. The print signal here is written in a way so that
-- information will not flood the console.



data EnemyEvent = EKill | ENoevent

data Enemy = Enemy {
      ePos :: Point V2 Int -- ^ Enemy Position
    , eDir :: V2 Int -- ^ Direction vector
    , eSpeed :: Double -- ^ Speed, affecting update interval
    , eAlive :: Bool -- ^ Is it alive?
    } deriving (Eq)

instance Show Enemy where
  show e = "[Enemy] At: "
           ++ (show (x,y))
           ++ " Velocity: "
           ++ (show (vx,vy))
           ++ " Alive: "
           ++ show (eAlive e)
               where
                 P (V2 x y) = ePos e
                 V2 vx vy = (fromIntegral <$> eDir e) / (pure $ eSpeed e)

-- | Modeling the change of position
dPos :: (HasTime t s) =>
       s
    -- ^ Delta session/time
    -> V2 Double
    -- ^ Velocity vector
    -> V2 Double
        -- ^ delta Position
dPos s v = let dt = realToFrac $ dtime s
           in v * dt

-- | Main signal to update an enemy
sUpdateEnemy0 :: (Monad m, HasTime t s) =>
                Enemy
                -> Signal s m EnemyEvent Enemy
sUpdateEnemy0 e0 =
  let P p0 = fromIntegral <$> ePos e0
      -- ^ initial position
      uP0 = eDir e0
      -- ^ Direction vector
      v = eSpeed e0
      -- ^ Speed value
      -- | Is it alive?
      a0 = eAlive e0
  in proc ev -> do
    uP' <- mkId -< uP0 -- Direction does not change for now
    dP' <- arr (\u -> (fromIntegral <$> u) / (pure v)) -< uP'
    -- v Integrate speed to get position
    p' <- integrate p0 dPos -< dP'
    -- v Round position to get the row/col position
    iP' <- arr (fmap round) -< p'
    a' <- latchR <<< arr (\case {EKill -> True; _ -> False}) -< ev
    -- v Return the updated enemy
    let e' = e0 {ePos = P iP', eAlive = a'}
    returnA -< e'

testEnemy0 :: IO ()
testEnemy0 = runBox clockSession_ b
    where
      enemy = Enemy (P $ V2 1 1) (V2 1 1) 1 True
      b = proc _ -> do
        mc <- sInput -< ()
        ev <- arr (\case {Just 'k' -> EKill; _ -> ENoevent}) -< mc
        e' <- sUpdateEnemy0 enemy -< ev
        mkKleisli_ putStr -< show e' ++ "\r"
        returnA -< ()

-- $GameState-Player2
--
-- Now, learning from our enemies, we can also package our player
-- up. Our player does not die, but it does move, and fire
-- bullets. Therefore, we can make the 'Player' and 'PlayerEvent' data
-- types. Similarly, we will make an 'sUpdatePlayer' signal.
--
-- To get a feeling of how it works, run 'testPlayer2'. Press 'a' or
-- 'd' to move around, and '<Space>' to fire. Note that you won't be
-- able to see it fire unless your computer is unacceptably slow:
-- Firing is an impulse which is supposed to take infinitely short
-- time. Though it is technically impossible to achieve this, a
-- reasonable computer should process this fast enough to make the
-- change impossible to see.
--
-- Modeling the position is trivil here too:
--
-- > x' <- mkSW_ x0 updatePosX' -< ev
--
-- We are almost doing the same thing as 'sPlayerX'. The only
-- differences are that we no longer hard code the initial position
-- here, and we use 'PlayerEvent' instead of 'Move'.
--
-- Now, it comes to firing bullets. Different from moving, which can
-- be done as fast as the player hits the keyboard, the cannon of
-- player's ship needs cooldown. To achieve this, we are going to use
-- the switching ability of signals.
--
-- > (-->) :: (Monad m) => Signal s m a b -> Signal s m a b -> Signal s m a b
--
-- A signal, @s1 --> s2@, will produce the output of @s1@ so long as
-- it is active. When @s1@ inhibits, the signal then activates and
-- switches to @s2@, and never come back. The timing of cannon can be
-- done surprisingly easy:
--
-- > sFire = (Nothing <=> Just False) --> oneShot True --> (pure False >>> wait 0.25) --> sFire
--
-- '(\<=\>)' is a convenient signal that takes 'Bool' as input, and
-- outputs the left value when 'True' and right value when
-- 'False'. Remember that 'Nothing' denotes inhibition. 'oneShot'
-- resembles an impulse function, which produces an output for a
-- semantically infinitely short period of time. The signal reads
-- very straightforward: When input is 'False', output 'False'; once
-- input becomes 'True'(Fire key is pressed), output 'True' for one
-- shot, then stay 'False' regardless of input for 0.25 seconds, then
-- reset.

data Player = Player {
      playerPos :: Point V2 Int -- ^ Position
    , playerFiring :: Bool -- ^ Whether player is firing bullets
    }

instance Show Player where
  show p = "[Player] Position: "
           ++ (show (x, y))
           ++ " Firing: "
           ++ (show $ playerFiring p)
      where
        P (V2 x y) = playerPos p

data PlayerEvent = PMoveL | PMoveR | PFire | PNoevent deriving (Show)

-- | Just a wrapper around 'updatePosX'
updatePosX' x PMoveL = updatePosX x MLeft
updatePosX' x PMoveR = updatePosX x MRight
updatePosX' x _ = updatePosX x MStay

-- | Interface 'PlayerEvent' to logic signal
sToFireSig :: Monad m => Signal s m PlayerEvent Bool
sToFireSig = arr f
    where
      f PFire = True
      f _ = False

-- | The logic signal to handle fire and cooldown
sFire :: (HasTime t s, Monad m) => Signal s m Bool Bool
sFire = (Nothing <=> Just False)
        --> oneShot True
        --> waitWith False 0.5
        --> sFire

-- | The signal to update player
sUpdatePlayer :: (Monad m, HasTime t s) =>
                 Player
                 -> Signal s m PlayerEvent Player
sUpdatePlayer pl0 =
  let P p0@(V2 x0 y0) = playerPos pl0
      -- ^ Initial position
  in proc ev -> do
    -- v Get X coordinate from event
    x' <- mkSW_ x0 updatePosX' -< ev
    -- v Fire bullets
    firing <- sFire <<< sToFireSig -< ev
    returnA -< pl0 {playerPos = (P $ V2 x' y0), playerFiring = firing}

-- | Converts a raw input to a 'PlayerEvent'
toPlayerEvent :: Maybe Char -> PlayerEvent
toPlayerEvent Nothing = PNoevent
toPlayerEvent (Just c)
    | toLower c == 'a' = PMoveL
    | toLower c == 'd' = PMoveR
    | c == ' ' = PFire
    | otherwise = PNoevent

testPlayer2 :: IO ()
testPlayer2 = runBox clockSession_ b
    where
      pl0 = Player (P $ V2 30 28) False
      b = proc _ -> do
        pe <- arr toPlayerEvent <<< sInput -< ()
        pl' <- sUpdatePlayer pl0 -< pe
        mkKleisli_ putStr -< show pl' ++ "\r"
        returnA -< ()


-- $GameState-Bullets
-- 
-- After properly handling fire interval, we know that we have a logic
-- signal that denotes the status of firing. To actually fire a
-- bullet, we need some dynamic generating, so we will test this
-- section later when we have written collision handling.
--
-- First, we need 'Bullet' and 'BulletEvent' types. Since there are no
-- fancy special bullets here, we only need two internal states:
-- position and velocity. For this simple game, the only thing can be
-- done to a bullet is destroying. Similar to enemies, bullets has its
-- own system on velocity and position. Therefore, we are going to use
-- the 'integrate' signal and 'dPos' again. See 'sUpdateBullet' for
-- details. It looks basically like 'sUpdateEnemy0', so it is not hard
-- to grasp. Actually, it is perfectly fine to write a general version
-- like @sUpdateObject@ and write data class about destructable or
-- movable objects, but I won't go as far since the bullet will be the
-- only object with this implementation. That is why the previous
-- function is called 'sUpdateEnemy0': it will be replaced by another
-- implementation.

data Bullet = Bullet
              {
                bulletVec :: Point V2 Double
              , bulletVel :: V2 Double
              }

instance Show Bullet where
  show b = "[Bullet] Pos: "
           ++ show (x, y)
           ++ " Velocity: "
           ++ show (dx, dy)
      where
        P (V2 x y) = bulletVec b
        V2 dx dy = bulletVel b

--type BulletLogic = (Monad m, HasTime t s) => Signal s m [Enemy] (Bullet, [Enemy])

-- sBulletLogic :: (Monad m, HasTime t s) =>
--                 V2 Int
--              -> Bullet
--              -> BulletLogic
-- sBulletLogic b0 =
--   let P p0 = fromIntegral <$> bulletPos b0
--       dP0 = fromIntegral <$> bulletVel b0
--       checkCollision p es = filter (\e -> p `collides` e) es
--   in proc es -> do
--     p' <- integrate p0 dPos -< dP0
--     iP' <- arr (fmap round) -< p'
--     (d', ecs) <- first latchS <<< arr checkCollision -< es
--     returnA -< (b0 {bulletPos = P iP', bulletIsDestroyed = d'}, ecs)


-- $GameState-Enemy2
--
-- Now, our enemy has constant velocity. This is a problem: if we just
-- keep it in this way, the enemy will soon run off the screen. We
-- have to flip the horizontal direction when the enemy reaches the
-- boundary. This introduces a slight problem: our position depends on
-- velocity, and velocity depends on position. To solve this, we will
-- use the black magic of 'ArrowLoop', which somehow magically solves
-- this problem easily (I have read the book /Functional Reactive
-- Programming/, which uses Java 8 as the language. The circular
-- dependancy solution there seems a lot more complicated).
--
-- Since we are making the signals more complicated, it is a good idea
-- to further divide them. We observe that the position-velocity
-- system can be isolated away, so let's make a signal that only deals
-- with that. Take a look at 'sUpdateBoundedPosition', and try it by
-- running 'testUBP'.
--
-- The type is long, but you may already guessed what it does. We pass
-- in the initial position, velocity, and boundary size. We get a
-- /constant/ signal that outputs the position of a point. I call it
-- /constant/ because it ignores any input. However, it does update
-- its state using the implicit time parameter.
--
-- Now I am going to explain the magical 'ArrowLoop'. I call it
-- /magical/ because I don't fully understand step by step how it
-- works yet (it is most likely to work similar to the fixed point
-- function 'fix', which I still don't quite get yet).
--
-- The 'loop' function has the following type:
--
-- > loop :: ArrowLoop a => a (b, d) (c, d) -> a b c
--
-- Where the @d@ is fed back to input. The main problem we have here
-- is to feed the initial value in without diverging the function. We
-- use a 'delay' function to shift the input for a minimalistic amount
-- of time, and the /black magic/ of laziness will prevent the signal
-- from diverging. The simplified structure is like following:
--
-- > update :: Signal s m a b
-- > update = loop $ second (delay initialValue) >>> Signal s m (a,c) (b,c)
--
-- The @c@ in this particular signal is @dP@, the velocity vector. I
-- apologize that I cannot explain this more thoroughly, but since it
-- is pure functional programming, if it works in one place, it should
-- work in other places. I will do further tutorials once I grasp the
-- essentials of 'fix', 'rec', and 'loop'.
--
-- Next, we are ready to integrate that into our enemy update signal,
-- 'sUpdateEnemy'. The basic structure is the same, except that the
-- style may have changed a little bit. Notice that there are less
-- exposed details comparing to 'sUpdateEnemy0'. The most notable
-- change is that the living status is no longer latched. Instead,
-- when an enemy is dead, its signal is immediately inhibited. This
-- change is to help preventing resources from being used on dead
-- enemies. Of course, if you want to revive them, it may still be
-- necessary to use latches to keep a state.
--
-- Try 'testEnemy' now.

-- | The signal of position in a boundary
sUpdateBoundedPosition :: (MonadFix m, HasTime t s) =>
                          Point V2 Double -- ^ Initial position
                       -> V2 Double -- ^ Velocity vector
                       -> V2 Int -- ^ Boundary size
                       -> Signal s m a (Point V2 Double)
sUpdateBoundedPosition (P vp0) dP0 b@(V2 w h) =
  let
    -- | Gets new velocity vector from position and velocity
    f (P (V2 x y)) (V2 dx dy) = V2 (g w x dx) (g h y dy)
    -- | Flips @du@ if @u@ is out of bounds and is diverging
    g uM u du
      | (u <= 0.0 && du < 0.0) || (u >= fromIntegral uM && du > 0) = -du
      | otherwise = du
  in loop $ second (delay dP0) >>> proc (_, dP) -> do
    -- v Integrate as usual
    vp' <- integrate vp0 dPos -< dP
    let dP' = f (P vp') dP
    returnA -< (P vp', dP') 

-- | Testing 'sUpdateBoundedPosition'
testUBP :: IO ()
testUBP = runBox clockSession_ b
    where
      p0 = P $ V2 0.0 0.0
      dP0 = V2 1.0 2.0
      bound = V2 1 3
      b = proc _ -> do
        p' <- sUpdateBoundedPosition p0 dP0 bound -< ()
        mkKleisli_ putStr -< show p' ++ "\r"
        returnA -< ()

-- | The signal to update an enemy
sUpdateEnemy :: (MonadFix m, HasTime t s) =>
                Enemy
             -> V2 Int -- ^ Bound size
             -> Signal s m EnemyEvent Enemy
sUpdateEnemy e0 b =
  let p0 = fromIntegral <$> ePos e0
      -- ^ initial position
      uP0 = eDir e0
      -- ^ Direction vector
      v = eSpeed e0
      -- ^ Speed value
      dP0 = (fromIntegral <$> uP0) * (pure v)
      -- | Is it alive?
      a0 = eAlive e0
  in proc ev -> do
    -- v Need to shift since the "origin" is at (1,1) when drawing
    p' <- arr (+ (P $ V2 1 1)) <<< sUpdateBoundedPosition p0 dP0 b -< ()
    -- v Notice that this time we use 'truncate'
    iP' <- arr (fmap truncate) -< p'
    a' <- arr (\case {EKill -> True; _ -> False}) -< ev
    let e' = e0 {ePos = iP', eAlive = a'}
    returnA <<< (mkEmpty <-- when' eAlive) -< e'

testEnemy :: IO ()
testEnemy = runBox clockSession_ b
    where
      enemy = Enemy (P $ V2 1 1) (V2 2 1) 1.5 True
      b = proc _ -> do
        mc <- sInput -< ()
        ev <- arr (\case {Just 'k' -> EKill; _ -> ENoevent}) -< mc
        e' <- sUpdateEnemy enemy (V2 2 2) -< ev
        mkKleisli_ putStr -< show e' ++ "\r"
        returnA -< ()

-- $DGCH
--
-- Warning: This is the part which corrupts the entire tutorial. I
-- paused for two weeks before continuing the implementation, and when
-- I came back, I made the mistake that I totally forgot about
-- rendering problem (which I mentioned briefly in previous sections),
-- and while I should keep the bullets/enemies alive for one more step
-- just to remove them from screen, I did not make use of the boolean
-- indicating whether the enemy/bullet is alive (totally forgot its
-- purpose). However, another shot at the same place will clear the screen
--
-- In this part, we are implementing a dynamic generating and
-- collision handling. For simplicity, our game will have only one
-- enemy (if one enemy is handled correctly, it is easy to expand).
--
-- Notice that, although @timeless@ support dynamic switching, the
-- structure of program is determined at compile time. For example,
-- you cannot create a dynamic list of 'Signal's, and feed a value
-- into every one of them, and get all their results. The /type/ of a
-- Signal is determined at compile time --- However, you can freely
-- switch a Signal with another with the same type. Of course, not all
-- Signal's support this. In fact, since dynamic switching is not yet
-- needed in this tutorial, I have not implemented higher order
-- signals and dynamic switching yet.
--
-- Read the source for an insight. It should not be too hard to follow
-- (despite the bugs on rendering I mentioned before).
--
-- Finally, run 'main' to test it out!
--
-- P.S After writing a few 'loop' magics, I now start to get how to
-- use it (not how it works). Basically, the magic is that you can
-- treat it as an Arrow recursion, and the initial value is fed in by
-- the 'delay' Signal. I will write a separate tutorial just on that
-- topic.

sDrawEnemies :: ColorIntensity -> Color -> Signal s IO [Enemy] ()
sDrawEnemies i c = arr (map $ (\(P v) -> v) . ePos)
                   >>>
                   mkSK_ (repeat $ V2 0 0) draw
                   >>> mkConstM (return ())
  where
    draw :: [V2 Int] -> [V2 Int] -> IO [V2 Int]
    draw ps0 ps = do
      (\(p0, p) -> drawCharS 'W' i c p0 p) `mapM` (zip ps0 ps) >> (return ps)

sDrawBullets :: ColorIntensity -> Color -> Signal s IO [Bullet] ()
sDrawBullets i c = arr (map $ fmap round . (\(P v) -> v) . bulletVec)
                   >>>
                   mkSK_ (repeat $ V2 0 0) draw
                   >>> mkConstM (return ())
  where
    draw :: [V2 Int] -> [V2 Int] -> IO [V2 Int]
    draw ps0 ps = do
      (\(p0, p) -> drawCharS '.' i c p0 p) `mapM` (zip ps0 ps) >> (return ps)

spawnBullet :: (V2 Double, Bool, [Bullet])
            -> [Bullet]
spawnBullet (V2 x y, True, bs) = (Bullet (P $ V2 x y) (V2 0 (-5))):bs
spawnBullet (V2 x y, False, bs) = bs

bulletIsOutOfBound :: V2 Int -- ^ Boundary
                   -> Bullet -> Bool
bulletIsOutOfBound bound@(V2 r _) b@(Bullet (P (V2 _ y)) _) = y < 0 

collides :: Bullet -> Enemy -> Bool
collides b e = (round <$> bulletVec b) == ePos e

-- | Steps position of a list of bullets
sBulletStep :: (Monad m, HasTime t s) =>
                 Signal s m [Bullet] [Bullet]
sBulletStep = mkSF $ \ds bs ->
  (map (stepBullet ds) bs, sBulletStep)
  where
    stepBullet ds b =
      let v = bulletVel b
          dt = realToFrac $ dtime ds
          vP' :: Point V2 Double
          vP' = bulletVec b + (P $ v * dt)
      in b {bulletVec=vP'}

-- | Logic of bullet updating
sBullets :: (MonadFix m, HasTime t s) =>
            [Bullet] -- ^ Initial list of bullets
            -> V2 Int -- ^ Boundary size
            -- | Takes in Player and Enemy list, returns a list of
            -- bullets and destroyed enemies
            -> Signal s m (Player, [Enemy]) ([Bullet], [Enemy])
sBullets b0 size@(V2 xM yM) =
  let
    collidedEnemies :: ([Bullet], [Enemy]) -> ([Bullet], [Enemy])
    collidedEnemies (bs, []) = (bs, [])
    collidedEnemies (bs, es) =
      let
        esD' :: [Enemy]
        esD' = concat $ map (\b -> filter (collides b) es) bs
        bs' = concat $ map (\e -> filter (\b -> not $ collides b e) bs) es
      in (bs', esD')
  in loop $ second (delay b0) >>> proc ((p, es), bs) -> do
    let firing = playerFiring p
        pos@(P (V2 x' y')) = playerPos p
        (V2 x y) :: V2 Double = fromIntegral <$> V2 x' y'
    -- v Spawn a new bullet if player is firing, and steps all bullets
    bs' <- sBulletStep <<< (arr spawnBullet) -< (V2 x (y-1), firing, bs)
    (bs'', esD) <- arr collidedEnemies -< (bs', es)
    returnA -< ((bs'', esD), bs'')

sDrawPlayer :: Signal s IO Player ()
sDrawPlayer = proc pl -> do
  let P (V2 x _) = playerPos pl
  mkSK_ (-1) drawPlayerAt -< x
  returnA -< ()

-- | Kills enemies
updateEnemies :: [Enemy] -> [Enemy] -> [Enemy]
updateEnemies es kill = filter (\e -> not (e `elem` kill)) es

-- | Combines logic of Bullets and Enemies
sBulletEnemies :: (MonadFix m, HasTime t s) =>
                  [Enemy]
               -> V2 Int -- ^ Boundary Size
               -> Signal s m Player ([Bullet], [Enemy])
sBulletEnemies es0 size =
  loop $ second (delay []) >>> proc (pl, eks) -> do
    es' <- mkSW_ es0 updateEnemies -< eks
    (bs, eks') <- sBullets [] size -< (pl, es')
    returnA -< ((bs, es'), eks')

main :: IO ()
main = initConsole defaultInitConfig >> clearScreen >> runBox clockSession_ b
  where
    pl0 = Player (P $ V2 30 28) False
    enemy0 = [Enemy (P $ V2 30 5) (V2 2 1) 1.5 True]
    size@(V2 x y) = V2 60 30
    b = proc _ -> do
      placeholder <- mkActM $ asciiBox x y Vivid Green -< ()
      pl' <- sUpdatePlayer pl0 <<< arr toPlayerEvent <<< sInput -< placeholder
      (bs, es') <- sBulletEnemies enemy0 size -< pl'
      sDrawBullets Vivid Blue -< bs
      sDrawEnemies Vivid Red -< es'
      sDrawPlayer -< pl'
      returnA -< ()