module Scratchy.Syntax where

import Graphics.Gloss.Interface.Pure.Game


-- Types
------------------------------------------------------------

type Duration  = Int
type Pos       = (Float, Float)
type Cell      = (Int, Int)
type SpritePtr = Int


-- Constants
------------------------------------------------------------

cellsPerSec :: Float
cellsPerSec = 5

gridW, gridH :: Int
gridW = 30
gridH = 30 -- FIXME: move.

inBounds :: (Int,Int) -> Bool
inBounds (x,y) = x >= 0 && x < gridW && y >= 0 && y < gridH

cellSize :: Float
cellSize = 30

winW, winH :: Int
winW = round (fromIntegral gridW * cellSize)
winH = round (fromIntegral gridH * cellSize)


-- Direction
------------------------------------------------------------

data Dir = U | D | L | R deriving (Eq,Ord,Show)

dirVec :: Dir -> (Int, Int)
dirVec U = (0, 1)
dirVec D = (0,-1)
dirVec L = (-1,0)
dirVec R = (1, 0)

nextCell :: Dir -> (Int, Int) -> (Int, Int)
nextCell d (cx,cy) =
  let (dx,dy) = dirVec d
  in (cx + dx, cy + dy)


-- Syntax
------------------------------------------------------------

data InspectionResult
  = HasBarrier | HasSprite | IsFree

data SProg a
  = Pure a

  -- Event listening
  | OnKeyEvent Key (SProg ()) (SProg a) -- Listener for a specific key
  | OnTargetReached SpritePtr (Cell -> SProg ()) (SProg a) -- Listener for a specific sprite
  | OnTargetUpdated SpritePtr (Cell -> Cell -> SProg ()) (SProg a) -- Listener for a specific sprite
  | OnBarrierHit SpritePtr (Cell -> Cell -> SProg ()) (SProg a)

  -- Sprite and grid actions
  | NewSprite Cell Picture (SpritePtr -> SProg a)
  | SetColor SpritePtr Color (SProg a)
  | SetTarget SpritePtr Cell (SProg a)
  | GetTarget SpritePtr (Cell -> SProg a)
  | SetBackgroundColor Color (SProg a)
  | InspectCell Cell (InspectionResult -> SProg a)

  -- Timer
  | After Duration (SProg ()) (SProg a)
  deriving Functor


-- Combining programs
------------------------------------------------------------

combine :: SProg () -> SProg () -> SProg ()

-- Base cases
combine (Pure ()) p2 = p2
combine p1 (Pure ()) = p1

combine (OnKeyEvent k1 handler1 cont1) p2 =
    OnKeyEvent k1 handler1 (combine cont1 p2)

combine p1 (OnKeyEvent k2 handler2 cont2) =
    OnKeyEvent k2 handler2 (combine p1 cont2)

combine (OnTargetReached sp1 h1 c1) p2 =
    OnTargetReached sp1 h1 (combine c1 p2)
 
combine p1 (OnTargetReached sp2 h2 c2) =
    OnTargetReached sp2 h2 (combine p1 c2)

combine (OnTargetUpdated sp1 h1 c1) p2 =
    OnTargetUpdated sp1 h1 (combine c1 p2)

combine p1 (OnTargetUpdated sp2 h2 c2) =
    OnTargetUpdated sp2 h2 (combine p1 c2)

combine (OnBarrierHit sp1 h1 c1) p2 =
    OnBarrierHit sp1 h1 (combine c1 p2)

combine p1 (OnBarrierHit sp2 h2 c2) =
    OnBarrierHit sp2 h2 (combine p1 c2)

combine (After dur1 handler1 cont1) p2 =
    After dur1 handler1 (combine cont1 p2)

combine p1 (After dur2 handler2 cont2) =
    After dur2 handler2 (combine p1 cont2)

combine (NewSprite cell pic k1) p2 =
    NewSprite cell pic (\sp -> combine (k1 sp) p2)

combine p1 (NewSprite cell pic k2) =
    NewSprite cell pic (combine p1 . k2)

combine (SetColor sp c cont1) p2 =
    SetColor sp c (combine cont1 p2)
 
combine p1 (SetColor sp c cont2) =
    SetColor sp c (combine p1 cont2)

combine (SetTarget sp cell cont1) p2 =
    SetTarget sp cell (combine cont1 p2)

combine p1 (SetTarget sp cell cont2) =
    SetTarget sp cell (combine p1 cont2)

combine (GetTarget sp k1) p2 =
    GetTarget sp (\cell -> combine (k1 cell) p2)
 
combine p1 (GetTarget sp k2) =
    GetTarget sp (combine p1 . k2)

combine (SetBackgroundColor c cont1) p2 =
    SetBackgroundColor c (combine cont1 p2)
 
combine p1 (SetBackgroundColor c cont2) =
    SetBackgroundColor c (combine p1 cont2)

combine (InspectCell cell k1) p2 =
    InspectCell cell (\result -> combine (k1 result) p2)