-- Copyright 2016 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

{-# OPTIONS_GHC -fno-warn-unused-matches #-}
-- | This is a stubbed out version of BlockC.  The real BlockC will use this
-- when TESTING is defined, since they don't work from ghci if they have
-- a C dependency.
--
-- It's just a big copy-paste from BlockC, but should be ok since that changes
-- very rarely.
module Ui.BlockCStub where
import qualified Util.Rect as Rect
import qualified Ui.Block as Block
import qualified Ui.Color as Color
import qualified Ui.Events as Events
import Ui.Fltk (Fltk, fltk)
import qualified Ui.Sel as Sel
import qualified Ui.Skeleton as Skeleton
import qualified Ui.Track as Track
import qualified Ui.Types as Types
import qualified Ui.Zoom as Zoom

import Global
import Types


-- * query

get_screens :: IO [Rect.Rect]
get_screens :: IO [Rect]
get_screens = forall (m :: * -> *) a. Monad m => a -> m a
return [Int -> Int -> Int -> Int -> Rect
Rect.xywh Int
0 Int
0 Int
800 Int
600]

-- * view creation

create_view :: ViewId -> Text -> Rect.Rect -> Block.Config -> Fltk ()
create_view :: ViewId -> Text -> Rect -> Config -> Fltk ()
create_view ViewId
view_id Text
window_title Rect
rect Config
block_config = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

destroy_view :: ViewId -> Fltk ()
destroy_view :: ViewId -> Fltk ()
destroy_view ViewId
view_id = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

get_view_status :: ViewId -> Fltk (Rect.Rect, Zoom.Zoom, Int, Int)
get_view_status :: ViewId -> Fltk (Rect, Zoom, Int, Int)
get_view_status ViewId
view_id = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO Text
"unimplemented"

set_size :: ViewId -> Rect.Rect -> Fltk ()
set_size :: ViewId -> Rect -> Fltk ()
set_size ViewId
view_id Rect
rect = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_zoom :: ViewId -> Zoom.Zoom -> Fltk ()
set_zoom :: ViewId -> Zoom -> Fltk ()
set_zoom ViewId
view_id Zoom
zoom = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_track_scroll :: ViewId -> Types.Width -> Fltk ()
set_track_scroll :: ViewId -> Int -> Fltk ()
set_track_scroll ViewId
view_id Int
offset = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_selection :: ViewId -> Sel.Num -> [TrackNum] -> [Selection] -> Fltk ()
set_selection :: ViewId -> Int -> [Int] -> [Selection] -> Fltk ()
set_selection ViewId
view_id Int
selnum [Int]
tracknums [Selection]
sels = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

bring_to_front :: ViewId -> Fltk ()
bring_to_front :: ViewId -> Fltk ()
bring_to_front ViewId
view_id = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Block operations

set_config :: ViewId -> Block.Config -> Fltk ()
set_config :: ViewId -> Config -> Fltk ()
set_config ViewId
view_id Config
config = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_skeleton :: ViewId -> Skeleton.Skeleton
    -> [(Color.Color, [(TrackNum, TrackNum)])] -> Fltk ()
set_skeleton :: ViewId -> Skeleton -> [(Color, [(Int, Int)])] -> Fltk ()
set_skeleton ViewId
view_id Skeleton
skel [(Color, [(Int, Int)])]
integrate_edges = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_title :: ViewId -> Text -> Fltk ()
set_title :: ViewId -> Text -> Fltk ()
set_title ViewId
view_id Text
title = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_status :: ViewId -> Text -> Color.Color -> Fltk ()
set_status :: ViewId -> Text -> Color -> Fltk ()
set_status ViewId
view_id Text
status Color
color = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_display_track :: ViewId -> TrackNum -> Block.DisplayTrack -> Fltk ()
set_display_track :: ViewId -> Int -> DisplayTrack -> Fltk ()
set_display_track ViewId
view_id Int
tracknum DisplayTrack
dtrack = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

floating_open :: ViewId -> TrackNum -> ScoreTime -> Text -> (Int, Int)
    -> Fltk ()
floating_open :: ViewId -> Int -> ScoreTime -> Text -> (Int, Int) -> Fltk ()
floating_open ViewId
view_id Int
tracknum ScoreTime
pos Text
text (Int
sel_start, Int
sel_end) = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

floating_insert :: [ViewId] -> Text -> Fltk ()
floating_insert :: [ViewId] -> Text -> Fltk ()
floating_insert [ViewId]
view_ids Text
text = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

tracks :: ViewId -> Fltk TrackNum
tracks :: ViewId -> Fltk Int
tracks ViewId
view_id = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Int
0

insert_track :: ViewId -> TrackNum -> Block.Tracklike -> [Events.Events]
    -> Track.SetStyle -> Types.Width -> Fltk ()
insert_track :: ViewId
-> Int -> Tracklike -> [Events] -> SetStyle -> Int -> Fltk ()
insert_track ViewId
view_id Int
tracknum Tracklike
tracklike [Events]
merged SetStyle
set_style Int
width =
    forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

remove_track :: ViewId -> TrackNum -> Fltk ()
remove_track :: ViewId -> Int -> Fltk ()
remove_track ViewId
view_id Int
tracknum = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

update_track :: Bool -- ^ True if the ruler has changed and should be copied
    -- over.  It's a bit of a hack to be a separate flag, but rulers are
    -- updated rarely and copied over entirely for efficiency.
    -> ViewId -> TrackNum -> Block.Tracklike
    -> [Events.Events] -> Track.SetStyle -> ScoreTime -> ScoreTime -> Fltk ()
update_track :: Bool
-> ViewId
-> Int
-> Tracklike
-> [Events]
-> SetStyle
-> ScoreTime
-> ScoreTime
-> Fltk ()
update_track Bool
update_ruler ViewId
view_id Int
tracknum Tracklike
tracklike [Events]
merged SetStyle
set_style ScoreTime
start
        ScoreTime
end = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like 'update_track' except update everywhere.
update_entire_track :: Bool -> ViewId -> TrackNum -> Block.Tracklike
    -> [Events.Events] -> Track.SetStyle -> Fltk ()
update_entire_track :: Bool
-> ViewId -> Int -> Tracklike -> [Events] -> SetStyle -> Fltk ()
update_entire_track Bool
update_ruler ViewId
view_id Int
tracknum Tracklike
tracklike [Events]
merged SetStyle
set_style =
    -- -1 is special cased in c++.
    Bool
-> ViewId
-> Int
-> Tracklike
-> [Events]
-> SetStyle
-> ScoreTime
-> ScoreTime
-> Fltk ()
update_track Bool
update_ruler ViewId
view_id Int
tracknum Tracklike
tracklike [Events]
merged SetStyle
set_style
        (-ScoreTime
1) (-ScoreTime
1)

-- | Unlike other Fltk functions, this doesn't throw if the ViewId is not
-- found.  That's because it's called asynchronously when derivation is
-- complete.
set_track_signal :: ViewId -> TrackNum -> Track.TrackSignal -> Fltk ()
set_track_signal :: ViewId -> Int -> TrackSignal -> Fltk ()
set_track_signal ViewId
view_id Int
tracknum TrackSignal
tsig = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_waveform :: ViewId -> TrackNum -> Track.WaveformChunk -> Fltk ()
set_waveform :: ViewId -> Int -> WaveformChunk -> Fltk ()
set_waveform ViewId
_ Int
_ WaveformChunk
_ = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

clear_waveforms :: ViewId -> Fltk ()
clear_waveforms :: ViewId -> Fltk ()
clear_waveforms ViewId
_ = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

gc_waveforms :: Fltk ()
gc_waveforms :: Fltk ()
gc_waveforms = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_track_title :: ViewId -> TrackNum -> Text -> Fltk ()
set_track_title :: ViewId -> Int -> Text -> Fltk ()
set_track_title ViewId
view_id Int
tracknum Text
title = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_track_title_focus :: ViewId -> TrackNum -> Fltk ()
set_track_title_focus :: ViewId -> Int -> Fltk ()
set_track_title_focus ViewId
view_id Int
tracknum = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

set_block_title_focus :: ViewId -> Fltk ()
set_block_title_focus :: ViewId -> Fltk ()
set_block_title_focus ViewId
view_id = forall a. IO a -> Fltk a
fltk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- ** debugging

print_debug :: ViewId -> Fltk ()
print_debug :: ViewId -> Fltk ()
print_debug ViewId
view_id = forall (m :: * -> *) a. Monad m => a -> m a
return ()

dump :: IO [(ViewId, String)]
dump :: IO [(ViewId, String)]
dump = forall (m :: * -> *) a. Monad m => a -> m a
return []

-- ** selection

-- TODO copy and pasted with "Ui.BlockC".  Put them in Ui.BlockCTypes if there
-- are ever any more.

-- | This is the low level version of 'Sel.Selection'.  It only applies to
-- a single track, and has an explicit color.
data Selection = Selection {
    Selection -> Color
sel_color :: !Color.Color
    , Selection -> ScoreTime
sel_start :: !TrackTime
    , Selection -> ScoreTime
sel_cur :: !TrackTime
    , Selection -> SelectionOrientation
sel_orientation :: !SelectionOrientation
    }
    deriving (Selection -> Selection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c== :: Selection -> Selection -> Bool
Eq, Eq Selection
Selection -> Selection -> Bool
Selection -> Selection -> Ordering
Selection -> Selection -> Selection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Selection -> Selection -> Selection
$cmin :: Selection -> Selection -> Selection
max :: Selection -> Selection -> Selection
$cmax :: Selection -> Selection -> Selection
>= :: Selection -> Selection -> Bool
$c>= :: Selection -> Selection -> Bool
> :: Selection -> Selection -> Bool
$c> :: Selection -> Selection -> Bool
<= :: Selection -> Selection -> Bool
$c<= :: Selection -> Selection -> Bool
< :: Selection -> Selection -> Bool
$c< :: Selection -> Selection -> Bool
compare :: Selection -> Selection -> Ordering
$ccompare :: Selection -> Selection -> Ordering
Ord, Int -> Selection -> ShowS
[Selection] -> ShowS
Selection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection] -> ShowS
$cshowList :: [Selection] -> ShowS
show :: Selection -> String
$cshow :: Selection -> String
showsPrec :: Int -> Selection -> ShowS
$cshowsPrec :: Int -> Selection -> ShowS
Show)

data SelectionOrientation = None | Positive | Negative | Both
    deriving (Int -> SelectionOrientation -> ShowS
[SelectionOrientation] -> ShowS
SelectionOrientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionOrientation] -> ShowS
$cshowList :: [SelectionOrientation] -> ShowS
show :: SelectionOrientation -> String
$cshow :: SelectionOrientation -> String
showsPrec :: Int -> SelectionOrientation -> ShowS
$cshowsPrec :: Int -> SelectionOrientation -> ShowS
Show, SelectionOrientation -> SelectionOrientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionOrientation -> SelectionOrientation -> Bool
$c/= :: SelectionOrientation -> SelectionOrientation -> Bool
== :: SelectionOrientation -> SelectionOrientation -> Bool
$c== :: SelectionOrientation -> SelectionOrientation -> Bool
Eq, Eq SelectionOrientation
SelectionOrientation -> SelectionOrientation -> Bool
SelectionOrientation -> SelectionOrientation -> Ordering
SelectionOrientation
-> SelectionOrientation -> SelectionOrientation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelectionOrientation
-> SelectionOrientation -> SelectionOrientation
$cmin :: SelectionOrientation
-> SelectionOrientation -> SelectionOrientation
max :: SelectionOrientation
-> SelectionOrientation -> SelectionOrientation
$cmax :: SelectionOrientation
-> SelectionOrientation -> SelectionOrientation
>= :: SelectionOrientation -> SelectionOrientation -> Bool
$c>= :: SelectionOrientation -> SelectionOrientation -> Bool
> :: SelectionOrientation -> SelectionOrientation -> Bool
$c> :: SelectionOrientation -> SelectionOrientation -> Bool
<= :: SelectionOrientation -> SelectionOrientation -> Bool
$c<= :: SelectionOrientation -> SelectionOrientation -> Bool
< :: SelectionOrientation -> SelectionOrientation -> Bool
$c< :: SelectionOrientation -> SelectionOrientation -> Bool
compare :: SelectionOrientation -> SelectionOrientation -> Ordering
$ccompare :: SelectionOrientation -> SelectionOrientation -> Ordering
Ord, Int -> SelectionOrientation
SelectionOrientation -> Int
SelectionOrientation -> [SelectionOrientation]
SelectionOrientation -> SelectionOrientation
SelectionOrientation
-> SelectionOrientation -> [SelectionOrientation]
SelectionOrientation
-> SelectionOrientation
-> SelectionOrientation
-> [SelectionOrientation]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SelectionOrientation
-> SelectionOrientation
-> SelectionOrientation
-> [SelectionOrientation]
$cenumFromThenTo :: SelectionOrientation
-> SelectionOrientation
-> SelectionOrientation
-> [SelectionOrientation]
enumFromTo :: SelectionOrientation
-> SelectionOrientation -> [SelectionOrientation]
$cenumFromTo :: SelectionOrientation
-> SelectionOrientation -> [SelectionOrientation]
enumFromThen :: SelectionOrientation
-> SelectionOrientation -> [SelectionOrientation]
$cenumFromThen :: SelectionOrientation
-> SelectionOrientation -> [SelectionOrientation]
enumFrom :: SelectionOrientation -> [SelectionOrientation]
$cenumFrom :: SelectionOrientation -> [SelectionOrientation]
fromEnum :: SelectionOrientation -> Int
$cfromEnum :: SelectionOrientation -> Int
toEnum :: Int -> SelectionOrientation
$ctoEnum :: Int -> SelectionOrientation
pred :: SelectionOrientation -> SelectionOrientation
$cpred :: SelectionOrientation -> SelectionOrientation
succ :: SelectionOrientation -> SelectionOrientation
$csucc :: SelectionOrientation -> SelectionOrientation
Enum)