{-# OPTIONS_GHC -optc-D_LARGEFILE_SOURCE #-}
{-# OPTIONS_GHC -optc-D_LARGEFILE64_SOURCE #-}
{-# OPTIONS_GHC -optc-D_THREAD_SAFE #-}
{-# OPTIONS_GHC -optc-D_REENTRANT #-}
{-# OPTIONS_GHC -optc-DBUILD_DIR="build/debug" #-}
{-# OPTIONS_GHC -optc-DGHC_VERSION=90202 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Ui/TrackC.hsc" #-}
-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | A Track is a container for Events.  A track goes from ScoreTime 0 until
    the end of the last Event.
-}
module Ui.TrackC (with_track) where
import ForeignC
import qualified Util.FFI as FFI
import qualified Util.Seq as Seq
import qualified Util.Then as Then

import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Style as Style
import qualified Ui.Track as Track

import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal
import Types
import Global




-- | Since converting a Track requires both a track and merged events, poke
-- needs two args.  So keep it out of Storable to prevent accidental use of
-- 'with'.
with_track :: Track.Track -> Track.SetStyle -> [Events.Events]
    -> (Ptr Track.Track -> IO a) -> IO a
with_track track (track_bg, event_style) merged_events f =
    allocaBytesAligned size align $ \trackp -> do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) trackp (track_bg track)
{-# LINE 35 "Ui/TrackC.hsc" #-}
        poke_find_events trackp (event_style (Track.track_title track))
            (Track.track_events track : merged_events)
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) trackp (Track.track_render track)
{-# LINE 38 "Ui/TrackC.hsc" #-}
        initialize_track_signal (((\hsc_ptr -> hsc_ptr `plusPtr` 32)) trackp)
{-# LINE 39 "Ui/TrackC.hsc" #-}
        f trackp
    where
    size = (80)
{-# LINE 42 "Ui/TrackC.hsc" #-}
    align = alignment (0 :: CDouble)

type EventStyle = Event.Event -> Style.StyleId

poke_find_events :: Ptr Track.Track -> EventStyle -> [Events.Events] -> IO ()
poke_find_events trackp event_style event_lists = do
    let time_end = maximum (0 : map Events.time_end event_lists)
    find_events <- make_find_events event_style event_lists
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) trackp find_events
{-# LINE 51 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) trackp time_end
{-# LINE 52 "Ui/TrackC.hsc" #-}

make_find_events :: EventStyle -> [Events.Events] -> IO (FunPtr FindEvents)
make_find_events event_style event_lists = FFI.makeFunPtr "find_events" $
    c_make_find_events (cb_find_events event_style event_lists)

instance CStorable Track.RenderConfig where
    sizeOf _ = (8)
{-# LINE 59 "Ui/TrackC.hsc" #-}
    alignment _ = alignment (0 :: CDouble)
    peek _ = error "RenderConfig peek unimplemented"
    poke = poke_render_config

poke_render_config :: Ptr Track.RenderConfig -> Track.RenderConfig -> IO ()
poke_render_config configp (Track.RenderConfig style color) = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) configp (encode_style style)
{-# LINE 66 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) configp color
{-# LINE 67 "Ui/TrackC.hsc" #-}

instance CStorable Track.TrackSignal where
    sizeOf _ = (48)
{-# LINE 70 "Ui/TrackC.hsc" #-}
    alignment _ = alignment (0 :: CDouble)
    peek _ = error "TrackSignal peek unimplemented"
    poke = poke_track_signal

-- | This does a memcpy to marshal the signal for c++.  I could pass the
-- pointer directly, but then I would have to arrange for haskell and c++
-- to coordinate its lifespan.  I believe I could hold the ForeignPtr in
-- a FunPtr which is then manually deleted from c++ via the usual finalizer.
-- If that failed, I could use a StablePtr with a little more work.
--
-- However, memcpy is quite fast.  At 0.01s sampling rate, one minute of
-- a control track is 8 bytes/Double * 600 = 4.6kb.  So * 60 minutes * 8 tracks
-- = 2.25mb.  Since I tested 0.01s to copy 32mb, this should totally be fast
-- enough.
poke_track_signal :: Ptr Track.TrackSignal -> Track.TrackSignal -> IO ()
poke_track_signal tsigp (Track.TrackSignal sig shift stretch) = do
    initialize_track_signal tsigp
    (offset, destp, len) <- if Signal.null sig then return (0, nullPtr, 0)
        else Signal.with_ptr sig $ \offset sigp len -> do
            destp <- mallocArray len
            copyArray destp sigp len
            return (offset, destp, len)
    -- This TrackSignal's signal is actually in ScoreTime.
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) tsigp (shift + RealTime.to_score offset)
{-# LINE 94 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) tsigp stretch
{-# LINE 95 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) tsigp destp
{-# LINE 96 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) tsigp (FFI.c_int len)
{-# LINE 97 "Ui/TrackC.hsc" #-}

    -- Calculated by c++, in c_interface.cc.  I'd rather do it here,
    -- but I'm worried all those peeks will generate garbage.
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) tsigp (-1 :: CDouble)
{-# LINE 101 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) tsigp (-1 :: CDouble)
{-# LINE 102 "Ui/TrackC.hsc" #-}

-- | Objects constructed from haskell don't have their constructors run,
-- so make sure it doesn't have garbage.
initialize_track_signal :: Ptr Track.TrackSignal -> IO ()
initialize_track_signal tsigp = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) tsigp nullPtr
{-# LINE 108 "Ui/TrackC.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) tsigp (0 :: CInt)
{-# LINE 109 "Ui/TrackC.hsc" #-}

encode_style :: Track.RenderStyle -> (Int32)
{-# LINE 111 "Ui/TrackC.hsc" #-}
encode_style style = case style of
    Track.NoRender -> (0)
{-# LINE 113 "Ui/TrackC.hsc" #-}
    Track.Line {} -> (1)
{-# LINE 114 "Ui/TrackC.hsc" #-}
    Track.Filled {} -> (2)
{-# LINE 115 "Ui/TrackC.hsc" #-}

-- typedef int (*FindEvents)(
--     const ScoreTime *start_pos, const ScoreTime *end_pos,
--     Event **ret_events, int **ret_ranks);
type FindEvents = Ptr ScoreTime -> Ptr ScoreTime
    -> Ptr (Ptr Event.Event) -> Ptr (Ptr CInt) -> IO Int

cb_find_events :: EventStyle -> [Events.Events] -> FindEvents
cb_find_events event_style event_lists startp endp ret_events ret_ranks = do
    start <- peek startp
    end <- peek endp
    let (events, ranks) = unzip $ Seq.merge_lists key $
            zipWith (\rank -> map (, rank)) [0..] $
            map (map set_style . in_range start end) event_lists
        key (event, rank) = (Event.start event, rank)
        set_style event = Event.style_ #= event_style event $ event
    unless (null events) $ do
        -- Calling c++ is responsible for freeing these.
        poke ret_events =<< newArray events
        poke ret_ranks =<< newArray ranks
    return (length events)
    where
    -- Get everything in the inclusive range, plus one event before and after.
    -- The drawing code needs to know if the previous event text would overlap
    -- the first one.  The same goes for the last event, in case it has
    -- negative duration and the text goes above.
    --
    -- Almost, but not quite the same as 'Events.in_range_around'.
    in_range start end events =
        take 1 pre ++ Then.takeWhile1 ((<=end) . Event.start) post
        where (pre, post) = Events.split_lists start events

foreign import ccall "wrapper"
    c_make_find_events :: FindEvents -> IO (FunPtr FindEvents)