{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}

module MusicPad.Core.Scene where

import MusicPad.Env
import Prelude ()
import qualified Prelude as P
import MusicPad.Model.Sample
import MusicPad.Toolkit.Console

import MusicPad.Model

import Rika.Engine.Render.GL.Helper (camera_view_space_hit_test, camera_view_m)
import qualified Rika.Type as Rika
import Control.Arrow ((&&&))

import MusicPad.Env.Constant

excape_to_exit :: IOAction State
excape_to_exit g x = do
  _env <- read - g.env
  
  when (_env.input.keys.map key_code .has ('\27')) - 
    g.global_state $= GameEnded

play_sound_action :: IOAction State
play_sound_action g x = do
  game_object <- read x

  when (game_object.tag.is (Just - Tag "speaker")) - do
    with_state g - \_state -> do
  
      let current_verse = _state.song.verses.at (_state.song.current_verse_index)
    
      _env <- read - g.env
      let t = _env.game_time.current_script_time
          t0 = _state.loop_start_time
          delta_time = current_verse.tempo.tempo_to_interval
          elapsed_time = t + (-t0)
          
          _beats = current_verse.beats
          
          current_beat = floor - elapsed_time / delta_time
    
      -- log - "t0: " ++ show t0
      -- log - "t: " ++ show t
      -- log - show elapsed_time
      -- log - show current_beat
      with_state g - \_state -> do
  
        let current_track = current_verse.tracks.at (current_verse.current_track_index)
        let { active_tracks = 
          if _state.song.solo
            then [current_track]
            else current_verse.tracks
          }
          
        when ( _state.last_beat P.< current_beat) - do
          g.state $~ set __last_beat current_beat
  
          let beat = current_beat `P.mod` _beats
              notes_on_beat track = track.notes.select note_enabled .select (note_y > is beat)
              
          active_tracks.mapM_ (\active_track -> do
            active_track.notes_on_beat.mapM_ (play_note g active_track)
            )
          
          current_track.notes_on_beat .highlight_notes g delta_time
          

highlight_notes :: Game State -> Double -> [TrackNote] -> IO ()
highlight_notes g delta_time notes = do
  let ids = notes.map (note_x &&& note_y)
  
  _scene <- read - g.scene
  _scene.objects.filterT (tag > is (Just - Tag "note")) >>= mapM_ (\o -> do
    _attributes <- note_data o

    _attributes.want - \_attr -> do
      when ( (_attr.note_index_x, _attr.note_index_y ).belongs_to ids ) - do
        highlight_note g delta_time o
    )
  

play_note :: Game State -> Track -> TrackNote -> IO ()
play_note g track note = do
  with_state g - \_state -> do
    let _sample_db = _state.sample_db
    
    _sample_db.find (sample_id > is (track.track_sample_id)) .want - \sample -> do
      let ind = note.note_x
          scale_loop i xs = [0,12 ..].concat_map (\i -> xs.map (+i)) .take i
          
          max_scale = _state.app_env.pad_width + 1
          offset = track.scale .scale_loop max_scale .at ind 
          
          note_abs_pitch = track.key.absPitch + offset
      
      let sorted_notes = sample.samples.sortBy (compare_by (sample_pitch > absPitch > (P.- note_abs_pitch) > abs )) 
      
      let closest_note = sorted_notes.first
      
          path = closest_note.sample_path
          
      play_audio path
      
  logf g - show note


is_in_square_of :: (Real a) => a -> (a, a) -> (a, a) -> Bool
is_in_square_of radius (origin_x, origin_y) (point_x, point_y) =
  ( abs( origin_x + (-point_x) ) <= radius ) && ( abs( origin_y + (-point_y) ) <= radius )
  

touch_note_action :: IOAction State
touch_note_action g x = do
  _env <- read - g.env
  let _touches = _env.input.touches.select (touch_type > is TouchUp)

  when (_touches.null.not) - do
    _scene <- read - g.scene
    
    let _touch = _touches.first
    
        _pos = _touch.touch_pos

        _screen_pos = Vector2 (_pos.x2) (_env.window_height.from_i + (-_pos.y2))
    
    main_camera _scene.wantM - \_camera -> do
      let { _hit_ray = 
        camera_view_space_hit_test 
          (_env.window_width.from_i, _env.window_height.from_i)
          (_screen_pos.x2)
          (_screen_pos.y2)
          _camera
        }
      
      _camera_object <- main_camera_object _scene
      let inv_view_matrix = _camera_object.fromMaybe def .camera_view_m .invert_matrix
      
          Vector4 touch_pos_x touch_pos_y _ _ = inv_view_matrix `mul` _hit_ray.fst
      
      _scene.objects.filterT (tag > is (Just - Tag "note")) >>= mapM_ (\o -> do
        _game_object <- read o
      
        let 
            pos_x = _game_object.transform.position.x3
            pos_y = _game_object.transform.position.y3

            hit = is_in_square_of c_square_radius (pos_x, pos_y) (touch_pos_x, touch_pos_y)
        
        when hit - do
          _attributes <- note_data o

          _attributes.want - \_attr -> do
            logf g - "found note: " ++ show _attributes
        
            touch_note_on_object g o (_attr.note_index_x) (_attr.note_index_y)
          
          logf g - "origin: " ++ show (pos_x, pos_y)
          logf g - "point: " ++ show (touch_pos_x, touch_pos_y)
        )

touch_track_action :: IOAction State
touch_track_action g x = do
  _env <- read - g.env
  let _touches = _env.input.touches.select (touch_type > is TouchUp)

  when (_touches.null.not) - do
    _scene <- read - g.scene
    
    let _touch = _touches.first
    
        _pos = _touch.touch_pos

        _screen_pos = Vector2 (_pos.x2) (_env.window_height.from_i + (-_pos.y2))
    
    main_camera _scene.wantM - \_camera -> do
      let { _hit_ray = 
        camera_view_space_hit_test 
          (_env.window_width.from_i, _env.window_height.from_i)
          (_screen_pos.x2)
          (_screen_pos.y2)
          _camera
        }
      
      _camera_object <- main_camera_object _scene
      let inv_view_matrix = _camera_object.fromMaybe def .camera_view_m .invert_matrix
          Vector4 touch_pos_x touch_pos_y _ _ = inv_view_matrix `mul` _hit_ray.fst
      
      _scene.objects.filterT (tag > is (Just - Tag "track")) >>= mapM_ (\o -> do
        _game_object <- read o
      
        let 
            pos_x = _game_object.transform.position.x3
            pos_y = _game_object.transform.position.y3

            hit = is_in_square_of c_square_radius (pos_x, pos_y) (touch_pos_x, touch_pos_y)
        
        when hit - do
          _attributes <- track_data o

          _attributes.want - \_attr -> do
            logf g - "found note: " ++ show _attributes
        
            set_active_track_on_object g o (_attr.track_no)
            
            update_all_note_color g
        )


touch_verse_action :: IOAction State
touch_verse_action g x = do
  _env <- read - g.env
  let _touches = _env.input.touches.select (touch_type > is TouchUp)

  when (_touches.null.not) - do
    _scene <- read - g.scene
    
    let _touch = _touches.first
    
        _pos = _touch.touch_pos

        _screen_pos = Vector2 (_pos.x2) (_env.window_height.from_i + (-_pos.y2))
    
    main_camera _scene.wantM - \_camera -> do
      let { _hit_ray = 
        camera_view_space_hit_test 
          (_env.window_width.from_i, _env.window_height.from_i)
          (_screen_pos.x2)
          (_screen_pos.y2)
          _camera
        }
      
      _camera_object <- main_camera_object _scene
      let inv_view_matrix = _camera_object.fromMaybe def .camera_view_m .invert_matrix
          Vector4 touch_pos_x touch_pos_y _ _ = inv_view_matrix `mul` _hit_ray.fst
      
      _scene.objects.filterT (tag > is (Just - Tag "verse")) >>= mapM_ (\o -> do
        _game_object <- read o
      
        let 
            pos_x = _game_object.transform.position.x3
            pos_y = _game_object.transform.position.y3

            hit = is_in_square_of c_square_radius (pos_x, pos_y) (touch_pos_x, touch_pos_y)
        
        when hit - do
          _attributes <- verse_data o

          _attributes.want - \_attr -> do
            logf g - "found verse: " ++ show _attributes
        
            set_active_verse_on_object g o (_attr.verse_no)
            
            update_all_track_color g
            update_all_note_color g
        )


touch_home_action :: IOAction State
touch_home_action g x = do
  _env <- read - g.env
  let _touches = _env.input.touches.select (touch_type > is TouchUp)

  when (_touches.null.not) - do
    _scene <- read - g.scene
    
    let _touch = _touches.first
    
        _pos = _touch.touch_pos

        _screen_pos = Vector2 (_pos.x2) (_env.window_height.from_i + (-_pos.y2))
    
    main_camera _scene.wantM - \_camera -> do
      let { _hit_ray = 
        camera_view_space_hit_test 
          (_env.window_width.from_i, _env.window_height.from_i)
          (_screen_pos.x2)
          (_screen_pos.y2)
          _camera
        }
      
      _camera_object <- main_camera_object _scene
      let inv_view_matrix = _camera_object.fromMaybe def .camera_view_m .invert_matrix
          Vector4 touch_pos_x touch_pos_y _ _ = inv_view_matrix `mul` _hit_ray.fst
      
      _scene.objects.filterT (tag > is (Just - Tag "home")) >>= mapM_ (\o -> do
        _game_object <- read o
      
        let 
            pos_x = _game_object.transform.position.x3
            pos_y = _game_object.transform.position.y3

            hit = is_in_square_of c_square_radius (pos_x, pos_y) (touch_pos_x, touch_pos_y)
        
        when hit - do
          g.global_state $= GameEnded
        )


tempo_to_interval :: Double -> Double
tempo_to_interval = (15 /)

debug_script :: IOAction State
debug_script g x = do
  -- e <- read - g.env
  -- let fps_str = e.game_time.fps .printf "%2.0f"
  
  -- logf g - fps_str
  return ()

show_touch :: IOAction State
show_touch g x = don't - do
  _env <- read - g.env
  let _touches = _env.input.touches.select (touch_type > is TouchUp)
  when (_touches.null.not) - do
    let _touch = _touches.first
    
        _pos = _touch.touch_pos

        _screen_pos = Vector2 (_pos.x2) (_env.window_height.from_i + (-_pos.y2))
        
    
    _scene <- read - g.scene
    main_camera _scene.wantM - \_camera -> do
      let { _hit_ray = 
        camera_view_space_hit_test 
          (_env.window_width.from_i, _env.window_height.from_i)
          (_screen_pos.x2)
          (_screen_pos.y2)
          _camera
        }
      
      _scene.objects.mapM_ (\game_object -> do
        _game_object <- read game_object
        logf g - show _hit_ray
        logf g - show - _game_object.transform.position
        )

note_position_from_index :: (Int, Int) -> (RikaPrim, RikaPrim)
note_position_from_index (idx_x, idx_y) = (( idx_x.from_i + (-5) ) * 2, (-idx_y.from_i + 8) * 2 )

init_pad_scene :: Game State -> (Scene State) -> IO (Scene State)
init_pad_scene g _scene = do
  logf g - "init pad scene"
  
  _state <- read - g.state
  
  let _app_env = _state.app_env
  
      from_prefab :: GameObject a -> GameObject a -> GameObject a
      from_prefab prefab o = o {mesh = prefab.mesh, renderer = prefab.renderer}
      
  button_note_prefab <- _scene.objects.find_or_fail_with_message_T "Button.Note.Prefab" (name > unpack > is "Button.Note.Prefab")
  _button_note_prefab <- read button_note_prefab

  button_note_objects <- mapM newTVarIO - do
    index_x <- [ 0 .. _app_env.pad_width ]
    index_y <- [ 0 .. _app_env.pad_height ]
    
    let attributes = Just - def {note_index_x = index_x, note_index_y = index_y} .encodeJSON
        position_2d = note_position_from_index (index_x, index_y)
        position = Vector3 (position_2d.fst) (position_2d.snd) 1.0
        
        _transform = _button_note_prefab.transform.set __position position
        tag = Just - Tag "note"
        
    return - def { tag, attributes, transform = _transform, renderer = _button_note_prefab.renderer, prefab = Just button_note_prefab }
  

  button_track_prefab <- _scene.objects.find_or_fail_with_message_T "Button.Track.Prefab" (name > unpack > is "Button.Track.Prefab")
  _button_track_prefab <- read button_track_prefab
  
  button_track_objects <- mapM newTVarIO - do
    index_x <- [ 0 .. _app_env.pad_width ]
    
    let position_from_index idx_x = (( idx_x.from_i + (-5) ) * 2, -17)
    
        attributes = Just - def {track_no = index_x} .encodeJSON
        
        position_2d = position_from_index index_x
        position = Vector3 (position_2d.fst) (position_2d.snd) 1.0
        
        _transform = _button_track_prefab.transform.set __position position
        
        tag = Just - Tag "track"
        
        r = _button_track_prefab.renderer
        _renderer = if index_x.is 0 then r.fmap (set __materials [ Linked "TrackEnabled" ] ) else r
        
    return - def { tag, attributes, transform = _transform, prefab = Just button_track_prefab, renderer = _renderer}
  
  button_verse_prefab <- _scene.objects.find_or_fail_with_message_T "Button.Verse.Prefab" (name > unpack > is "Button.Verse.Prefab")
  _button_verse_prefab <- read button_verse_prefab
  
  button_verse_objects <- mapM newTVarIO - do
    index_y <- [ 0 .. _app_env.pad_height ]
    
    let position_from_index idx_y = (11,  (-idx_y.from_i + 8) * 2 )
        
        attributes = Just - def {verse_no = index_y} .encodeJSON
        
        position_2d = position_from_index index_y
        position = Vector3 (position_2d.fst) (position_2d.snd) 1.0
        
        _transform = _button_verse_prefab.transform.set __position position
        
        tag = Just - Tag "verse"
        
        r = _button_verse_prefab.renderer
        _renderer = if index_y.is 0 then r.fmap (set __materials [ Linked "VerseEnabled" ] ) else r
        
    return - def { tag, attributes, transform = _transform, prefab = Just button_verse_prefab , renderer = _renderer}
  
  
  button_verse_prefab <- _scene.objects.find_or_fail_with_message_T "Button.Home.Prefab" (name > unpack > is "Button.Home.Prefab")
  _button_verse_prefab <- read button_verse_prefab
  
  button_home_objects <- mapM newTVarIO - do
    let
        position_2d = (11, -17)
        position = Vector3 (position_2d.fst) (position_2d.snd) 1.0
        
        tag = Just - Tag "home"
        
        _transform = _button_verse_prefab.transform.set __position position
    
    return - def { tag, transform = _transform, prefab = Just button_verse_prefab }
    
  let button_objects = button_note_objects ++ button_track_objects ++ button_verse_objects ++ button_home_objects
  
  speaker_object <- newTVarIO def
  
  let _objects = speaker_object : button_objects
  

  speaker_object $~ set __tag (Just - Tag "speaker")

  _scene <- read - g.scene
  
  let {
    scene = 
      _scene 
        .mod __objects (++ _objects)
        .set __background_color (Vector4 0.88 0.88 0.88 0)
        .set ( __renderer_config > __with_normal_buffer ) False
        .set ( __renderer_config > __with_depth_buffer ) False
        .set ( __renderer_config > __with_color_buffer ) False
        
        .set ( __scene_config > __output_fps_to_console ) True
        
    }
    
  
  speaker_object.attach_io_action play_sound_action
  
  scene.objects .filterT (name > is "Camera") >>= mapM_ (\o -> do
    -- Game State
    o.attach_io_action excape_to_exit

    -- Debug
    -- o.attach_io_action debug_script
    -- o.attach_input_action show_touch
    
    -- Game Logic
    o.attach_input_action touch_note_action
    o.attach_input_action touch_track_action
    o.attach_input_action touch_verse_action
    o.attach_input_action touch_home_action
    
    )
  
  scene.update_all_object_matrix_cache

  return scene

init_hook :: Game State -> (Scene State) -> IO (Scene State)
init_hook g s = do
  _scene <- init_pad_scene g s
  logf g "before hook done"
  
  -- less CPU intensive to prevent crash ><
  -- g.env $~ set __script_update_interval 1.0
  -- g.env $~ set __display_update_interval 1.0
  
  
  return _scene

before_hook :: Game State -> (Scene State) -> IO (Scene State)
before_hook g s = do
  init_pad g
  return s


after_hook :: Game State -> (Scene State) -> IO (Scene State)
after_hook g s = do
  logf g - "saving scrap pad"
  save_scrap_pad g
  return s

default_state :: State
default_state = init_state c_pad_width c_pad_height



default_sample_id :: SampleID
default_sample_id = 
  def
    {
      sample_name = "Wide Marimba"
    , sample_author = "mp"
    }

init_song ::  Int -> Int -> Song
init_song pad_width pad_height = 
  let 
    notes = [def {note_x, note_y} | note_x <- [ 0 .. pad_width ], note_y <- [ 0 .. pad_height ] ]
    
    track_sample_id = default_sample_id
    scale = [0, 2, 4, 7, 9]
    key = (D, 4)

    track = def {notes, track_sample_id, scale, key}
    
    track_number = pad_width
    tracks = (track_number + 1).times track

    tempo = 120
    
    beats = pad_height + 1
          
    verse  = def {tracks, tempo, beats}
    
    verse_number = pad_height
    
    verses = (verse_number + 1).times verse

    song = def {verses, song_version = _song_version}
  in
  song

init_state ::  Int -> Int -> State
init_state pad_width pad_height = 
  let 
    song = init_song pad_width pad_height
    app_env = def { pad_width, pad_height }
  in
  def {song, app_env, state_version = _state_version}


scene_hook :: Hook State (Scene State) IO
scene_hook = def 
  {
    initialize = Just init_hook
  , before = Just before_hook
  , after = Just after_hook
  , dealloc = Nothing
  }
