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

-- | Tools for interactively tweaking Symbol parameters.
--
-- TODO using this module on linux will break the REPL.  Apparently
-- ghci on linux has a problem when it has to link in a FFI-using module.
module Cmd.Repl.LSymbol where
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Sel as Sel
import qualified Ui.Ui as Ui
import qualified Ui.Symbol as Symbol
import qualified Ui.SymbolC as SymbolC
import qualified Ui.Track as Track

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Create as Create
import qualified Cmd.Selection as Selection

import Global


-- | Make a test block with a dummy track and event that will display the
-- symbol under test.
make :: Cmd.CmdL ()
make :: CmdL ()
make = do
    Id
ident <- forall a (m :: * -> *). (Stack, Ident a, M m) => Text -> m a
Ui.read_id Text
"symbol-test"
    BlockId
bid <- forall (m :: * -> *). M m => Id -> RulerId -> m BlockId
Create.named_block Id
ident RulerId
Ui.no_ruler
    forall (m :: * -> *).
M m =>
BlockId -> RulerId -> TrackNum -> TrackNum -> Track -> m TrackId
Create.track_events BlockId
bid RulerId
Ui.no_ruler TrackNum
1 TrackNum
100 forall a b. (a -> b) -> a -> b
$
        Text -> Events -> Track
Track.track Text
"" (Event -> Events
Events.singleton (ScoreTime -> ScoreTime -> Text -> Event
Event.event ScoreTime
0 ScoreTime
5 Text
"symbol"))
    forall (m :: * -> *).
M m =>
BlockId -> TrackNum -> TrackNum -> m ()
Ui.set_track_width BlockId
bid TrackNum
0 TrackNum
0
    ViewId
vid <- forall (m :: * -> *). M m => BlockId -> m ViewId
Create.view BlockId
bid
    forall (m :: * -> *). M m => ViewId -> Maybe Selection -> m ()
Selection.set ViewId
vid (forall a. a -> Maybe a
Just (TrackNum -> ScoreTime -> Orientation -> Selection
Sel.point TrackNum
1 ScoreTime
0 Orientation
Sel.Positive))

-- | Put the given Symbol into the test block.
set :: Symbol.Symbol -> Cmd.CmdL ()
set :: Symbol -> CmdL ()
set Symbol
sym = do
    [Font]
fonts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Symbol -> IO [Font]
SymbolC.insert Symbol
sym
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Font]
fonts) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. (Stack, M m) => Text -> m a
Cmd.throw forall a b. (a -> b) -> a -> b
$ Text
"Missing fonts: " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty [Font]
fonts
    (BlockId
_, TrackNum
_, TrackId
tid, ScoreTime
_) <- forall (m :: * -> *).
M m =>
m (BlockId, TrackNum, TrackId, ScoreTime)
Selection.get_insert
    forall (m :: * -> *). M m => TrackId -> Event -> m ()
Ui.insert_event TrackId
tid forall a b. (a -> b) -> a -> b
$ ScoreTime -> ScoreTime -> Text -> Event
Event.event ScoreTime
0 ScoreTime
5 (Text
"`" forall a. Semigroup a => a -> a -> a
<> Symbol -> Text
Symbol.name Symbol
sym forall a. Semigroup a => a -> a -> a
<> Text
"`")

get_fonts :: Cmd.CmdL [Symbol.Font]
get_fonts :: CmdT IO [Font]
get_fonts = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Font]
SymbolC.get_fonts

glyph_at :: Int -> (Double, Double) -> Symbol.Glyph -> Symbol.Glyph
glyph_at :: TrackNum -> (Double, Double) -> Glyph -> Glyph
glyph_at TrackNum
size (Double, Double)
align Glyph
glyph =
    Glyph
glyph { glyph_size :: TrackNum
Symbol.glyph_size = TrackNum
size, glyph_align :: (Double, Double)
Symbol.glyph_align = (Double, Double)
align }

font :: String -> Symbol.Glyph -> Symbol.Glyph
font :: Font -> Glyph -> Glyph
font Font
name Glyph
glyph = Glyph
glyph { glyph_font :: Maybe Font
Symbol.glyph_font = forall a. a -> Maybe a
Just Font
name }

rotate :: Int -> Symbol.Glyph -> Symbol.Glyph
rotate :: TrackNum -> Glyph -> Glyph
rotate TrackNum
degrees Glyph
glyph = Glyph
glyph { glyph_rotate :: TrackNum
Symbol.glyph_rotate = TrackNum
degrees }

arp_up :: Symbol
arp_up = Text -> [Glyph] -> Symbol
Symbol.symbol Text
"arp-up" [Glyph
arp, TrackNum -> (Double, Double) -> Glyph -> Glyph
glyph_at TrackNum
8 (-Double
0.14, -Double
0.62) Glyph
arp_arrow_up]
arp_arrow_up :: Glyph
arp_arrow_up = Text -> Glyph
Symbol.glyph Text
"\xe18a"
arp :: Glyph
arp = (Text -> Glyph
Symbol.glyph Text
"\xe18e") { glyph_rotate :: TrackNum
Symbol.glyph_rotate = TrackNum
90 }