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

-- | The selection type.
module Ui.Sel where
import qualified Prelude
import Prelude hiding (min, max)
import qualified Data.Tuple as Tuple

import qualified Util.Num as Num
import qualified Ui.Types as Types
import Global
import Types


-- | Index into the the selection list.
type Num = Int

data Selection = Selection {
    -- | The position the selection was established at.  Since a selection can
    -- logically go off the edge of a block, this is not necessarily a valid
    -- TrackNum!
    Selection -> Int
start_track :: !TrackNum
    , Selection -> TrackTime
start_pos :: !TrackTime

    -- | The position the selection is now at.  The tracks are an inclusive
    -- range, the pos are half-open.  This is because these pairs are meant to
    -- be symmetrical, but the c++ layer only supports half-open pos ranges.
    -- I don't think there's much I can do about this.
    --
    -- Unlike 'start_track', this should be a valid TrackNum, because cmds want
    -- to use it as the focused track.
    , Selection -> Int
cur_track :: !TrackNum
    , Selection -> TrackTime
cur_pos :: !TrackTime
    , Selection -> Orientation
orientation :: !Orientation
    } deriving (Selection -> Selection -> Bool
(Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool) -> Eq Selection
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
Eq Selection
-> (Selection -> Selection -> Ordering)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Selection)
-> (Selection -> Selection -> Selection)
-> Ord 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
(Int -> Selection -> ShowS)
-> (Selection -> String)
-> ([Selection] -> ShowS)
-> Show Selection
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, ReadPrec [Selection]
ReadPrec Selection
Int -> ReadS Selection
ReadS [Selection]
(Int -> ReadS Selection)
-> ReadS [Selection]
-> ReadPrec Selection
-> ReadPrec [Selection]
-> Read Selection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Selection]
$creadListPrec :: ReadPrec [Selection]
readPrec :: ReadPrec Selection
$creadPrec :: ReadPrec Selection
readList :: ReadS [Selection]
$creadList :: ReadS [Selection]
readsPrec :: Int -> ReadS Selection
$creadsPrec :: Int -> ReadS Selection
Read)

instance Pretty Selection where
    pretty :: Selection -> Text
pretty (Selection Int
strack TrackTime
spos Int
ctrack TrackTime
cpos Orientation
orientation) =
        Text
"Selection" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
o Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int, TrackTime) -> Text
forall a. Pretty a => a -> Text
pretty (Int
strack, TrackTime
spos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Int, TrackTime) -> Text
forall a. Pretty a => a -> Text
pretty (Int
ctrack, TrackTime
cpos)
        where
        o :: Text
o = case Orientation
orientation of
            Orientation
None -> Text
"_"
            Orientation
Positive -> Text
"+"
            Orientation
Negative -> Text
"-"

-- | None is used for display selections, which don't need arrows on them.
data Orientation = None | Positive | Negative
    deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Eq Orientation
-> (Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
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 :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmax :: Orientation -> Orientation -> Orientation
>= :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c< :: Orientation -> Orientation -> Bool
compare :: Orientation -> Orientation -> Ordering
$ccompare :: Orientation -> Orientation -> Ordering
Ord, Int -> Orientation
Orientation -> Int
Orientation -> [Orientation]
Orientation -> Orientation
Orientation -> Orientation -> [Orientation]
Orientation -> Orientation -> Orientation -> [Orientation]
(Orientation -> Orientation)
-> (Orientation -> Orientation)
-> (Int -> Orientation)
-> (Orientation -> Int)
-> (Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> Orientation -> [Orientation])
-> Enum Orientation
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 :: Orientation -> Orientation -> Orientation -> [Orientation]
$cenumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
enumFromTo :: Orientation -> Orientation -> [Orientation]
$cenumFromTo :: Orientation -> Orientation -> [Orientation]
enumFromThen :: Orientation -> Orientation -> [Orientation]
$cenumFromThen :: Orientation -> Orientation -> [Orientation]
enumFrom :: Orientation -> [Orientation]
$cenumFrom :: Orientation -> [Orientation]
fromEnum :: Orientation -> Int
$cfromEnum :: Orientation -> Int
toEnum :: Int -> Orientation
$ctoEnum :: Int -> Orientation
pred :: Orientation -> Orientation
$cpred :: Orientation -> Orientation
succ :: Orientation -> Orientation
$csucc :: Orientation -> Orientation
Enum, Orientation
Orientation -> Orientation -> Bounded Orientation
forall a. a -> a -> Bounded a
maxBound :: Orientation
$cmaxBound :: Orientation
minBound :: Orientation
$cminBound :: Orientation
Bounded, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
(Int -> ReadS Orientation)
-> ReadS [Orientation]
-> ReadPrec Orientation
-> ReadPrec [Orientation]
-> Read Orientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read)

-- | A point is a selection with no duration.
point :: TrackNum -> TrackTime -> Orientation -> Selection
point :: Int -> TrackTime -> Orientation -> Selection
point Int
tracknum TrackTime
pos Orientation
orientation = Selection
    { start_track :: Int
start_track = Int
tracknum, start_pos :: TrackTime
start_pos = TrackTime
pos
    , cur_track :: Int
cur_track = Int
tracknum, cur_pos :: TrackTime
cur_pos = TrackTime
pos
    , orientation :: Orientation
orientation = Orientation
orientation
    }

is_point :: Selection -> Bool
is_point :: Selection -> Bool
is_point Selection
sel = Selection -> TrackTime
start_pos Selection
sel TrackTime -> TrackTime -> Bool
forall a. Eq a => a -> a -> Bool
== Selection -> TrackTime
cur_pos Selection
sel

modify_tracks :: (TrackNum -> TrackNum) -> Selection -> Selection
modify_tracks :: (Int -> Int) -> Selection -> Selection
modify_tracks Int -> Int
f Selection
sel = Selection
sel
    { start_track :: Int
start_track = Int -> Int
f (Selection -> Int
start_track Selection
sel)
    , cur_track :: Int
cur_track = Int -> Int
f (Selection -> Int
cur_track Selection
sel)
    }

expand_tracks :: TrackNum -> Selection -> Selection
expand_tracks :: Int -> Selection -> Selection
expand_tracks Int
n Selection
sel
    | Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
start = Selection
sel { cur_track :: Int
cur_track = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }
    | Bool
otherwise = Selection
sel { start_track :: Int
start_track = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }
    where
    start :: Int
start = Selection -> Int
start_track Selection
sel
    cur :: Int
cur = Selection -> Int
cur_track Selection
sel

-- | Start and end tracks, from small to large.
track_range :: Selection -> (TrackNum, TrackNum)
track_range :: Selection -> (Int, Int)
track_range Selection
sel = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.min Int
track0 Int
track1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.max Int
track0 Int
track1)
    where (Int
track0, Int
track1) = (Selection -> Int
start_track Selection
sel, Selection -> Int
cur_track Selection
sel)

-- | TrackNums covered by the selection.  Since Selections may have out of
-- range tracks, I need the number of tracks to generate a list of valid
-- TrackNums.
tracknums :: TrackNum -> Selection -> [TrackNum]
tracknums :: Int -> Selection -> [Int]
tracknums Int
tracks Selection
sel
    | Int
tracks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    | Bool
otherwise = [Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
Num.clamp Int
0 (Int
tracksInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
start .. Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
Num.clamp Int
0 (Int
tracksInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
end]
    where (Int
start, Int
end) = Selection -> (Int, Int)
track_range Selection
sel

min :: Selection -> TrackTime
min :: Selection -> TrackTime
min Selection
sel = TrackTime -> TrackTime -> TrackTime
forall a. Ord a => a -> a -> a
Prelude.min (Selection -> TrackTime
start_pos Selection
sel) (Selection -> TrackTime
cur_pos Selection
sel)

max :: Selection -> TrackTime
max :: Selection -> TrackTime
max Selection
sel = TrackTime -> TrackTime -> TrackTime
forall a. Ord a => a -> a -> a
Prelude.max (Selection -> TrackTime
start_pos Selection
sel) (Selection -> TrackTime
cur_pos Selection
sel)

-- | Start and end points, from small to large.
range :: Selection -> (TrackTime, TrackTime)
range :: Selection -> (TrackTime, TrackTime)
range Selection
sel = (Selection -> TrackTime
min Selection
sel, Selection -> TrackTime
max Selection
sel)

event_orientation :: Selection -> Types.Orientation
event_orientation :: Selection -> Orientation
event_orientation Selection
sel = case Selection -> Orientation
orientation Selection
sel of
    Orientation
Negative -> Orientation
Types.Negative
    Orientation
_ -> Orientation
Types.Positive

duration :: Selection -> TrackTime
duration :: Selection -> TrackTime
duration Selection
sel = TrackTime -> TrackTime
forall a. Num a => a -> a
abs (Selection -> TrackTime
start_pos Selection
sel TrackTime -> TrackTime -> TrackTime
forall a. Num a => a -> a -> a
- Selection -> TrackTime
cur_pos Selection
sel)

set_duration :: TrackTime -> Selection -> Selection
set_duration :: TrackTime -> Selection -> Selection
set_duration TrackTime
dur Selection
sel
    | TrackTime
cur TrackTime -> TrackTime -> Bool
forall a. Ord a => a -> a -> Bool
> TrackTime
start = Selection
sel { cur_pos :: TrackTime
cur_pos = TrackTime
start TrackTime -> TrackTime -> TrackTime
forall a. Num a => a -> a -> a
+ TrackTime -> TrackTime -> TrackTime
forall a. Ord a => a -> a -> a
Prelude.max TrackTime
0 TrackTime
dur }
    | Bool
otherwise = Selection
sel { start_pos :: TrackTime
start_pos = TrackTime
cur TrackTime -> TrackTime -> TrackTime
forall a. Num a => a -> a -> a
+ TrackTime -> TrackTime -> TrackTime
forall a. Ord a => a -> a -> a
Prelude.max TrackTime
0 TrackTime
dur }
    where
    start :: TrackTime
start = Selection -> TrackTime
start_pos Selection
sel
    cur :: TrackTime
cur = Selection -> TrackTime
cur_pos Selection
sel

-- | Extend the current track and pos, but keep the start track and pos the
-- same.
merge :: Selection -> Selection -> Selection
merge :: Selection -> Selection -> Selection
merge (Selection Int
strack TrackTime
spos Int
_ TrackTime
_ Orientation
_) (Selection Int
_ TrackTime
_ Int
ctrack TrackTime
cpos Orientation
orient) =
    Int -> TrackTime -> Int -> TrackTime -> Orientation -> Selection
Selection Int
strack TrackTime
spos Int
ctrack TrackTime
cpos Orientation
orient

-- | Make a selection that covers both the given selections.  It tries to set
-- start and cur values based on the direction of the merge, assuming you are
-- starting with the first selection and adding the second.
union :: Selection -> Selection -> Selection
union :: Selection -> Selection -> Selection
union Selection
sel1 Selection
sel2 = Int -> TrackTime -> Int -> TrackTime -> Orientation -> Selection
Selection Int
strack TrackTime
spos Int
ctrack TrackTime
cpos (Selection -> Orientation
orientation Selection
sel2)
    where
    (Int
strack, Int
ctrack) =
        if Selection -> Int
cur_track Selection
sel2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Selection -> Int
cur_track Selection
sel1 then (Int, Int)
se else (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
Tuple.swap (Int, Int)
se
        where
        se :: (Int, Int)
se = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.min Int
s1 Int
s2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
Prelude.max Int
e1 Int
e2)
        (Int
s1, Int
e1) = Selection -> (Int, Int)
track_range Selection
sel1
        (Int
s2, Int
e2) = Selection -> (Int, Int)
track_range Selection
sel2
    (TrackTime
spos, TrackTime
cpos) = if Selection -> TrackTime
cur_pos Selection
sel2 TrackTime -> TrackTime -> Bool
forall a. Ord a => a -> a -> Bool
>= Selection -> TrackTime
cur_pos Selection
sel1 then (TrackTime, TrackTime)
se else (TrackTime, TrackTime) -> (TrackTime, TrackTime)
forall a b. (a, b) -> (b, a)
Tuple.swap (TrackTime, TrackTime)
se
        where
        se :: (TrackTime, TrackTime)
se = (TrackTime -> TrackTime -> TrackTime
forall a. Ord a => a -> a -> a
Prelude.min TrackTime
s1 TrackTime
s2, TrackTime -> TrackTime -> TrackTime
forall a. Ord a => a -> a -> a
Prelude.max TrackTime
e1 TrackTime
e2)
        (TrackTime
s1, TrackTime
e1) = Selection -> (TrackTime, TrackTime)
range Selection
sel1
        (TrackTime
s2, TrackTime
e2) = Selection -> (TrackTime, TrackTime)
range Selection
sel2

move :: TrackTime -> Selection -> Selection
move :: TrackTime -> Selection -> Selection
move TrackTime
t Selection
sel = Selection
sel { start_pos :: TrackTime
start_pos = Selection -> TrackTime
start_pos Selection
sel TrackTime -> TrackTime -> TrackTime
forall a. Num a => a -> a -> a
+ TrackTime
t, cur_pos :: TrackTime
cur_pos = Selection -> TrackTime
cur_pos Selection
sel TrackTime -> TrackTime -> TrackTime
forall a. Num a => a -> a -> a
+ TrackTime
t }