From 544ef9dce537035ed0cf91c2762a31c10afc53aa Mon Sep 17 00:00:00 2001 From: Alejandro Date: Thu, 6 Jul 2023 16:08:01 -0400 Subject: [PATCH 1/4] added stack timer --- client/src/Estuary/Widgets/Reflex.hs | 19 -- client/src/Estuary/Widgets/Timer.hs | 297 +++++++++++++++------------ 2 files changed, 167 insertions(+), 149 deletions(-) diff --git a/client/src/Estuary/Widgets/Reflex.hs b/client/src/Estuary/Widgets/Reflex.hs index 1e1cb098..f4b487cc 100644 --- a/client/src/Estuary/Widgets/Reflex.hs +++ b/client/src/Estuary/Widgets/Reflex.hs @@ -240,25 +240,6 @@ clickableDivNoClass child = do -- clickEv <- wrapDomEvent (_element_raw element) (elementOnEventName Click) (mouseXY) -- return $ (() <$) clickEv ----- see this!!! !! !! !! -clickableDivAndTooltip :: (Monad m, DomBuilder t m, TriggerEvent t m, G.IsElement (RawElement (DomBuilderSpace m)), Reflex t, MonadIO m) - => Text -> m a -> m (Event t ()) -clickableDivAndTooltip cssclass child = do - (element,_) <- elAttr' "div" attr $ child - tooltip child $ text $ T.pack "pruebiringa" - clickEv <- wrapDomEvent (_element_raw element) (elementOnEventName Click) (mouseXY) - return $ (() <$) clickEv - where - attr = singleton "class" cssclass - -flipItemWithinClickableAndTooltip:: (Monad m, DomBuilder t m, TriggerEvent t m, G.IsElement (RawElement (DomBuilderSpace m)), Reflex t, MonadIO m) - => m a -> m (Event t ()) -flipItemWithinClickableAndTooltip popup = do - flipItem <- clickableDiv "segmentTimer" $ do - divClass "tooltipPosAbsolutetest" $ elClass "span" "tooltiptexttest code-font" popup - return () - return flipItem - -- clickableDiv with class clickableDiv :: (Monad m, DomBuilder t m, TriggerEvent t m, G.IsElement (RawElement (DomBuilderSpace m)), Reflex t, MonadIO m) diff --git a/client/src/Estuary/Widgets/Timer.hs b/client/src/Estuary/Widgets/Timer.hs index 893b09e2..9ec5ed6d 100644 --- a/client/src/Estuary/Widgets/Timer.hs +++ b/client/src/Estuary/Widgets/Timer.hs @@ -28,6 +28,7 @@ import Estuary.Types.EnsembleC import Estuary.Types.Ensemble import Estuary.Widgets.W import Estuary.Types.Definition +import Estuary.Types.Live timerWidget:: MonadWidget t m => Dynamic t Timer -> W t m (Variable t Timer) @@ -39,7 +40,9 @@ timerWidget delta = mdo x <- flippableWidget (timerControl delta) (timerDisplay delta) True newModeEv variable delta timerEv - +f:: Live String -> Bool +f (Live str _) = True +f (Edited str newstr) = False timerControl:: MonadWidget t m => Dynamic t Timer -> W t m (Event t Timer, Event t Bool) -- timerControl':: MonadWidget t m => Dynamic t Timer -> W t m () @@ -58,18 +61,16 @@ timerControl delta = divClass "timer-Visualiser" $ mdo return (flipEvent, programItem) -- small area :: (Event t Bool, Event t ()) bigAreaL <- divClass "big-areaControl" $ do inputWrapper <- divClass "input-wrapperControl" $ do - let iText = (formToText . form) <$> delta - (valTxBx,_) <- textWithLockWidget 3 ((lock . mode) <$> delta) iText + let iText = (formToText . form) <$> delta + (valTxBx,_,_) <- textWidget 3 (constDyn False) (T.pack "a=5,b=7,c=3") $ updated iText let boton = snd smallAreaL let txPressed = tag (current $ valTxBx) boton -- Event t Text return $ parseForm <$> txPressed -- Event t [(Text,Rat)] return $ textInputFunc <$> inputWrapper -- big area :: Event t (Form -> Timer Timer) return (bigAreaL, fst smallAreaL) -- columnLeft - - columnRight <- divClass "columnControl" $ do smallAreaR <- divClass "small-areaControl" $ do - peek mergedLocalDelta + timerChangeDisplay False mergedLocalDelta return () -- small area bigAreaR <- divClass "big-areaControl" $ do pure (loopIcon $ (loop <$> mergedLocalDelta)) >>= (divClass "rowControl") -- loop @@ -80,56 +81,13 @@ timerControl delta = divClass "timer-Visualiser" $ mdo let metreEvent = measureFunc <$ (metreItem) return $ leftmost [loopEvent, metreEvent] return bigAreaR -- columnR - let flippy = id <$ (tag (constant ()) $ snd columnLeft) let polyptychEvent = attachWith (\d x -> x d) (current mergedLocalDelta) $ leftmost [columnRight, fst columnLeft, flippy] let flipper = fmap (\x -> x False) $ snd columnLeft return (polyptychEvent, flipper) -- (Timer, Bool) -- return of topRowContainer - return topContainer -- mdo last return - -timerControl':: MonadWidget t m => Dynamic t Timer -> W t m (Event t Timer, Event t Bool) -timerControl' delta = divClass "timer-Visualiser" $ mdo - -- liftIO $ putStrLn "timerControl" - dInit <- sample $ current delta - let local = fst topContainer - mergedLocalDelta <- holdDyn dInit {- $ traceEvent "xC" -} $ leftmost [local, updated delta] - iconDisplay mergedLocalDelta - - topContainer <- divClass "flex-container-col" $ do - fstRowWrap <- divClass "flex-item-col" $ do - divClass "flex-container-row" $ do - - txInputArea <- divClass "flex-container-col" $ do - let iText = (formToText . form) <$> delta - txVal <- divClass "divForText" $ do - (valTxBx,_) <- textWithLockWidget 3 ((lock . mode) <$> delta) iText - return valTxBx -- Dynamic t Text - boton <- clickableDiv "flex-item-col" blank - let txPressed = tag (current $ txVal) boton -- Event t Text - return $ parseForm <$> txPressed -- Event t [(Text,Rat)] - let textInputEvent = textInputFunc <$> txInputArea -- Event t (Form -> Timer -> Timer) - loopItem <- clickableDiv "flex-item-row" blank - let loopEvent = loopFunc <$ (loopItem) - return $ leftmost [loopEvent,textInputEvent] -- Event t (Timer -> Timer) - sndRowWrap <- divClass "flex-item-col" $ do - divClass "flex-container-row" $ do - flipItem <- clickableDiv "flex-item-row" blank -- Event t () - let flipEvent = flipFunc <$ flipItem - measureItem <- clickableDiv "flex-item-row" blank -- :: Event t () - let measureEvent = measureFunc <$ (measureItem) - return (measureEvent,flipEvent) - - let flippy = id <$ (tag (constant ()) $ snd sndRowWrap) - let polyptychEvent = attachWith (\d x -> x d) (current mergedLocalDelta) $ leftmost [fstRowWrap, fst sndRowWrap, flippy] - let flipper = fmap (\x -> x False) $ snd sndRowWrap - return (polyptychEvent, flipper) -- (Timer, Bool) -- return of topRowContainer - return topContainer -- final return - - - timerDisplay:: MonadWidget t m => Dynamic t Timer -> W t m (Event t Timer, Event t Bool) -- timerDisplay':: MonadWidget t m => Dynamic t Timer -> W t m () timerDisplay delta = divClass "timer-Visualiser" $ mdo @@ -137,11 +95,8 @@ timerDisplay delta = divClass "timer-Visualiser" $ mdo dInit <- sample $ current delta let local = fst top mergedLocalDelta <- holdDyn dInit {- $ traceEvent "xD" -} $ leftmost [local,updated delta] - timerChangeDisplay mergedLocalDelta + timerChangeDisplay True mergedLocalDelta --- flip icon might be useful at some point - -- divClass "icon" $ do - -- pure (flipIcon' $ constDyn True) >>= (divClass "iconFlippedFlip") -- flip icon top <- do topContainer <- divClass "containerTimer" $ do flipItem <- clickableDiv "segmentLeftTimer" $ do @@ -168,47 +123,16 @@ timerDisplay delta = divClass "timer-Visualiser" $ mdo return (polyptychEvent, flipper) return top +timerChangeDisplay:: MonadWidget t m => Bool -> Dynamic t Timer -> W t m () +timerChangeDisplay False timer = do + defTimer <- sample $ current timer + let defN = n defTimer + dynN <- holdDyn 0 $ updated $ n <$> timer + let nEv = updated $ n <$> timer + widgetHold (visualDisplayPeek timer defN) $ visualDisplayPeek timer <$> nEv + pure () -timerDisplay':: MonadWidget t m => Dynamic t Timer -> W t m (Event t Timer, Event t Bool) -timerDisplay' delta = divClass "timer-Visualiser" $ mdo - --liftIO $ putStrLn "timerDisplay" - dInit <- sample $ current delta - let local = fst topContainer - mergedLocalDelta <- holdDyn dInit {- $ traceEvent "xD" -} $ leftmost [local,updated delta] - timerChangeDisplay mergedLocalDelta - --- flip icon might be useful at some point - -- divClass "icon" $ do - -- pure (flipIcon' $ constDyn True) >>= (divClass "iconFlippedFlip") -- flip icon - - topContainer <- divClass "flex-container-col" $ do - fstRowWrap <- divClass "flex-item-col" $ do - divClass "flex-container-row" $ do - -- let w = divClass "hola" $ text $ T.pack "moi" - -- tooltip w $ text $ T.pack "mui" - resetItem <- clickableDiv "flex-item-row" blank -- :: Event t () - aTimeReset <- performEvent $ fmap (\ _ -> liftIO $ getCurrentTime) resetItem - playPauseItem <- clickableDiv "flex-item-row" blank -- Event t () - aTimePlay <- performEvent $ fmap (\ _ -> liftIO $ getCurrentTime) playPauseItem - -- let aTime' = traceEvent "aTime with playPauseItem and resetItem" $ aTime - let playPauseEvent = playPauseFunc <$> aTimePlay - let resetEvent = resetFunc <$> aTimeReset - return $ leftmost [resetEvent,playPauseEvent] - sndRowWrap <- divClass "flex-item-col" $ do - divClass "flex-container-row" $ do - flipItem <- clickableDiv "flex-item-row" blank -- :: Event t () - let flipEvent = flipFunc <$ flipItem - visualisationItem <- clickableDiv "flex-item-row" blank - let visualisationEvent = visualiserFunc <$ visualisationItem - return (visualisationEvent, flipEvent) -- open path for playPause - let flippy = id <$ (tag (constant ()) $ snd sndRowWrap) - let polyptychEvent = attachWith (\d x -> x d) (current mergedLocalDelta) $ leftmost [fstRowWrap, fst sndRowWrap, flippy] -- mergeWith is the proper one to use, also here you can use attachWith reverse application &!!! - let flipper = fmap (\x -> x $ True) $ snd sndRowWrap - return (polyptychEvent, flipper) - return topContainer - -timerChangeDisplay:: MonadWidget t m => Dynamic t Timer -> W t m () -timerChangeDisplay timer = do +timerChangeDisplay True timer = do -- liftIO $ putStrLn "timerChangeDisplay" --timer' <- traceDynamic "timer'" timer defTimer <- sample $ current timer @@ -222,38 +146,40 @@ visualDisplay:: MonadWidget t m => Dynamic t Timer -> Int -> W t m () visualDisplay delta 0 = do visualiseProgressBarLabel delta return () - visualDisplay delta 1 = do visualiseProgressBar delta return () - visualDisplay delta 2 = do visualiseSandClockLabel delta return () - visualDisplay delta 3 = do visualiseSandClock delta return () - visualDisplay delta 4 = do visualiseTextLabel delta return () - visualDisplay delta 5 = do visualiseText delta return () - visualDisplay delta 6 = do visualiseOnlyLabel delta return () +visualDisplay delta 7 = do + visualiseStack delta + return () + +visualDisplayPeek:: MonadWidget t m => Dynamic t Timer -> Int -> W t m () +visualDisplayPeek delta _ = do + peek delta + return () -- think whether is better to pass UTC coming from the ticklossy rather than the Rational... calculateCountSorC:: Measure -> Bool -> Timer -> UTCTime -> Rational -> Tempo -> Rational -calculateCountSorC Cycles textOrGraph timer wBuildT elapsingCount t = - calculateCount textOrGraph timer wBuildT elapsingBeat t +calculateCountSorC Cycles graphOrText timer wBuildT elapsingCount t = + calculateCount graphOrText timer wBuildT elapsingBeat t where elapsingBeat = timeToCount t $ addUTCTime (realToFrac elapsingCount) wBuildT -calculateCountSorC Seconds textOrGraph timer wBuildT elapsingCount t = - calculateCount textOrGraph timer wBuildT elapsingCount t +calculateCountSorC Seconds graphOrText timer wBuildT elapsingCount t = + calculateCount graphOrText timer wBuildT elapsingCount t --- ---- @@ -285,38 +211,43 @@ holdingCalculation' markC (z:zs) = if z > markC then (z-markC) holdingCalculationP:: Bool -> Rational -> Timer -> Tempo -> Rational holdingCalculationP True mark timer t - | (measure timer) == Seconds = holdingCalculationLoopedP mark $ Prelude.map snd (form timer) - | otherwise = holdingCalculationLoopedP markAsBeat $ Prelude.map snd (form timer) + | (measure timer) == Seconds = holdingCalculationLoopedP (n timer) mark $ Prelude.map snd (form timer) + | otherwise = holdingCalculationLoopedP (n timer) markAsBeat $ Prelude.map snd (form timer) where markAsBeat = (freq t) * mark holdingCalculationP False mark timer t - | (measure timer) == Seconds = holdingCalculationUnloopedP mark $ Prelude.map snd (form timer) - | otherwise = holdingCalculationUnloopedP markAsBeat $ Prelude.map snd (form timer) + | (measure timer) == Seconds = holdingCalculationUnloopedP (n timer) mark $ Prelude.map snd (form timer) + | otherwise = holdingCalculationUnloopedP (n timer) markAsBeat $ Prelude.map snd (form timer) where markAsBeat = (freq t) * mark -holdingCalculationUnloopedP:: Rational -> [Rational] -> Rational -holdingCalculationUnloopedP mark (x:xs) = if mark > (sum (x:xs)) then 0 else holdingCalculationP' mark scannedForm (x:xs) +-- int is the N necessary for general or segmented timer (checkes which timer we are using) +holdingCalculationUnloopedP:: Int -> Rational -> [Rational] -> Rational +holdingCalculationUnloopedP display mark (x:xs) = if mark > (sum (x:xs)) then 0 else holdingCalculationP' display mark scannedForm (x:xs) where scannedForm = Prelude.scanl (+) x xs -holdingCalculationLoopedP:: Rational -> [Rational] -> Rational -holdingCalculationLoopedP mark (x:xs) = holdingCalculationP' markC scannedForm (x:xs) +holdingCalculationLoopedP:: Int -> Rational -> [Rational] -> Rational +holdingCalculationLoopedP display mark (x:xs) = holdingCalculationP' display markC scannedForm (x:xs) where markC = cycleForm mark (x:xs) scannedForm = Prelude.scanl (+) x xs -holdingCalculationP':: Rational -> [Rational] -> [Rational] -> Rational -holdingCalculationP' markC [] [] = 0 -holdingCalculationP' markC (z:zs) (x:xs) = if z > markC then percen - else holdingCalculationP' markC zs xs +holdingCalculationP':: Int -> Rational -> [Rational] -> [Rational] -> Rational +holdingCalculationP' display markC [] [] = 0 +holdingCalculationP' display markC (z:zs) (x:xs) = + if generalOrSegmentedHold display + then calculatedSegments + else 100 * ((generalForm - markC) / generalForm) -- 100 * ((generalForm - b) / generalForm) where percen = 100 * (z - markC) / x + calculatedSegments = if z > markC then percen else holdingCalculationP' display markC zs xs + generalForm = sum (x:xs) + +generalOrSegmentedHold:: Int -> Bool +generalOrSegmentedHold 7 = False +generalOrSegmentedHold _ = True cycleForm:: Rational -> [Rational] -> Rational cycleForm mark form = dur * (tr (mark/dur)) where dur = if (sum form == 0) then 1 else sum form tr n = n - (realToFrac (floor n) ::Rational) -cyclesOrSecs:: Measure -> Rational -> Tempo -> Rational -cyclesOrSecs Cycles n t = n / (freq t) -cyclesOrSecs Seconds n t = n * (freq t) - -- first bool is for calculating percentage (true) or count (false) calculateCount:: Bool -> Timer -> UTCTime -> Rational -> Tempo -> Rational calculateCount False delta wBuildT elapsingCount t = -- elapsed count is seconds @@ -343,7 +274,7 @@ calculateCount True delta wBuildT elapsingCount t = -- elapsed count is seconds countUp = elapsingCount - (realToFrac startMark :: Rational) countForm = Prelude.map snd (form delta) -- [Rat] loopedCountUp = loopCountUp (loop delta) countForm countUp - countDown = multiTimerPercent 0 countForm loopedCountUp + countDown = if generalOrSegmentedCount (n delta) then multiTimerPercent 0 countForm loopedCountUp else generalTimerPercent 0 countForm loopedCountUp in countDown -- label stuff below @@ -406,10 +337,112 @@ peek delta = do let count = formatTextDisplay (measure iDelta) <$> count' let label = calculateLabelSorC (measure iDelta) iDelta wBuildT <$> beat <*> currentTempo dynText label - text $ T.pack " " + text $ T.pack " " dynText count pure () +visualiseStack:: MonadWidget t m => Dynamic t Timer -> W t m () +visualiseStack delta = do + iDelta <- sample $ current delta + currentTempo <- Estuary.Widgets.W.tempo + beatPosition <- elapsedCounts -- :: Event t Rational -- tiempo desde origen + beat <- holdDyn 0 beatPosition + wBuildT <- liftIO getCurrentTime + let count = (calculateCountSorC (measure iDelta) True iDelta wBuildT) <$> beat <*> currentTempo + let program = (form iDelta) + drawStack count program + pure () + +drawStack:: MonadWidget t m => Dynamic t Rational -> [(Text,Rational)] -> W t m () +drawStack countdown' program = do + let countdown = (\z -> realToFrac ((z * (-1))+100) :: Double) <$> countdown' + + let class' = constDyn $ "class" =: "visualiser" + let width = constDyn $ "width" =: "100%" + let height = constDyn $ "height" =: "100%" + let vB = constDyn $ "viewBox" =: "0 0 150 100" + let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" + let attrs = mconcat [class',width,height, vB, par] -- svg + + let x1Line = constDyn $ "x1" =: "0" + let x2Line = constDyn $ "x2" =: "150" + let strokeLine = constDyn $ "stroke" =: "var(--primary-color)" + let y1Line = (\y1 -> "y1" =: showt y1) <$> countdown + let y2Line = (\y2 -> "y2" =: showt y2) <$> countdown + let lineAttrs = mconcat [x1Line, x2Line, strokeLine, y1Line, y2Line] + + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do + generateStackBlocks countdown program + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "line" lineAttrs $ pure () + + pure () + +generateStackBlocks:: MonadWidget t m => Dynamic t Double -> [(Text, Rational)] -> m () +generateStackBlocks count program = do + let heightsAndYs = constDyn <$> heightsAndY (percenForm $ Prelude.map snd program) $ Prelude.map fst program + x <- simpleList heightsAndYs (generateBlock count) + return () + +--simpleList :: MonadWidget t m => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a]) + +generateBlock:: MonadWidget t m => Dynamic t Double -> Dynamic t (Double,Double,Text) -> m () +generateBlock count segment = do + let height = (\x -> "height" =: (showt $ fst' x)) <$> segment + let y = (\x -> "y" =: (showt $ snd' x)) <$> segment + let label = (\x -> (trd' x)) <$> segment -- Dyn t Text + let width = constDyn $ "width" =: "150" + let x = constDyn $ "x" =: "0" + let stroke = constDyn $ "stroke" =: "var(--background-color)" + let fill = fill' <$> count <*> (fst' <$> segment) <*> (snd' <$> segment) + let op = opacity' <$> count <*> (fst' <$> segment) <*> (snd' <$> segment) + let attrsRect = mconcat [x,y,width,height,fill,op, stroke] + -- text attributes + let textX = constDyn $ "x" =: "70" + let textY = (\y -> "y" =: (showt $ (snd' y) + ((fst' y)*0.85))) <$> segment + let txAnchor = constDyn $ "text-anchor" =: "middle" + let fillTx = constDyn $ "fill" =: "var(--primary-color)" + + let txAttrs = mconcat [txAnchor,fillTx,textX,textY] + let tspanAttrs = mconcat [txAnchor,fillTx,textX,textY] + + -- span attributes + + + + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsRect $ return () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "text" txAttrs $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "tspan" tspanAttrs $ do + -- dynText $ fmap (\x -> showt (floor x)) countdown + dynText label + return () + +fill':: Double -> Double -> Double -> Map Text Text +fill' count height y = if (count > (y+height)) + then ("fill" =: "var(--primary-color)") + else ("fill" =: "var(--secondary-color)") + +opacity':: Double -> Double -> Double -> Map Text Text +opacity' count height y = if (count >= y) && (count < (y+height)) + then ("opacity" =: "0.5") + else ("opacity" =: "0.3") + +percenForm:: [Rational] -> [Double] +percenForm count + | count == [] = [0] + | otherwise = Prelude.map (\x -> (asD x/ dur)*100) count + where dur = realToFrac (Prelude.sum $ count) :: Double + asD x = realToFrac x :: Double + + -- (h,y) +heightsAndY:: [Double] -> [Text] -> [(Double,Double,Text)] +heightsAndY heights labels = Prelude.zip3 heights ys labels + where ys = Prelude.init $ Prelude.scanl (+) 0 heights + +fst' (x,_,_) = x +snd' (_,x,_) = x +trd' (_,_,x) = x + + visualiseProgressBarLabel:: MonadWidget t m => Dynamic t Timer -> W t m () visualiseProgressBarLabel delta = do iDelta <- sample $ current delta @@ -825,7 +858,7 @@ loopFunc timer -- this needs to change if other visualisers are added (either on the fly or permanently to estuary). numberOfVis:: Int -numberOfVis = 7 +numberOfVis = 8 ----- helpers for display @@ -917,10 +950,12 @@ extractTimeMark (Falling' u) = Right u extractTimeMark (Holding' mark) = Left mark extractTimeMark Halted = Left $ realToFrac 0 - +-- +generalOrSegmentedCount:: Int -> Bool +generalOrSegmentedCount 7 = False +generalOrSegmentedCount _ = True -- this generates only whole numbers (less precise, more economic??) --- needs to be changed to Maybes if wwe want to use it as the one below loopCountUp':: Bool -> [Rational] -> Rational -> Rational loopCountUp' True xs b = realToFrac (mod (floor b) $ floor $ sum xs) :: Rational loopCountUp' False _ b = b @@ -930,17 +965,12 @@ loopCountUp:: Bool -> [Rational] -> Rational -> Rational loopCountUp True xs b = (unfloored - floored) * (sum xs) where floored = realToFrac (floor (b /sum xs)) :: Rational unfloored = b / sum xs -loopCountUp False _ b = b -- correct: 2,1,0,3,2,1,0,1,0 of [3,4,2] to: 3,2,1,4,3,2,1,2,1,0 - -lock:: Mode -> Bool -lock (Falling' _) = True -lock _ = False +loopCountUp False _ b = b formToText:: [(T.Text,Rational)] -> T.Text formToText form = T.init $ T.init $ T.concat $ Prelude.map toText form where toText x = (fst x) <> " = " <> (showt $ (floor $ snd x :: Int)) <> ", " - parseForm:: T.Text -> [(T.Text,Rational)] -- parser needs to accept "my thingy" as left of = parseForm tx = let x = Prelude.map (\x -> (fst x,T.drop 1 $ snd x)) $ Prelude.map (T.breakOn $ T.pack "=") $ T.split (==',') $ T.strip tx @@ -954,6 +984,13 @@ invalidFormFilter form | form == [] = [("invalid form", 0)] | otherwise = form +-- general timer will create a countdown of the whole form ([2,3,5] will create a countdown from 10) while multiTimerPercent will create a countdown for each section of the program +generalTimerPercent:: Rational -> [Rational] -> Rational -> Rational +generalTimerPercent startPoint xs b + | (xs == []) = 0 + | otherwise = 100 * ((generalForm - b) / generalForm) + where generalForm = sum xs + multiTimerPercent:: Rational -> [Rational] -> Rational -> Rational -- output represents percentage multiTimerPercent startPoint xs b | (xs==[]) = 0 From a086347896984664ce628f7a9cc020487367e57b Mon Sep 17 00:00:00 2001 From: Alejandro Date: Wed, 12 Jul 2023 19:29:34 -0400 Subject: [PATCH 2/4] space issues solved in timer visions, bug fixed --- client/src/Estuary/Widgets/Timer.hs | 249 ++++++++++++++++++++-------- static/css-source/source.css | 6 + 2 files changed, 185 insertions(+), 70 deletions(-) diff --git a/client/src/Estuary/Widgets/Timer.hs b/client/src/Estuary/Widgets/Timer.hs index 9ec5ed6d..718371fd 100644 --- a/client/src/Estuary/Widgets/Timer.hs +++ b/client/src/Estuary/Widgets/Timer.hs @@ -30,6 +30,14 @@ import Estuary.Widgets.W import Estuary.Types.Definition import Estuary.Types.Live +-- data Timer = Timer { +-- n:: Int, +-- form:: Live [(Text,Rational)], +-- mode:: Mode, +-- loop:: Bool, +-- measure:: Measure +-- } deriving (Show,Eq,Ord,Generic) + timerWidget:: MonadWidget t m => Dynamic t Timer -> W t m (Variable t Timer) timerWidget delta = mdo @@ -40,9 +48,9 @@ timerWidget delta = mdo x <- flippableWidget (timerControl delta) (timerDisplay delta) True newModeEv variable delta timerEv -f:: Live String -> Bool -f (Live str _) = True -f (Edited str newstr) = False +-- f:: Live String -> Bool +-- f (Live str _) = True +-- f (Edited str newstr) = False timerControl:: MonadWidget t m => Dynamic t Timer -> W t m (Event t Timer, Event t Bool) -- timerControl':: MonadWidget t m => Dynamic t Timer -> W t m () @@ -61,8 +69,8 @@ timerControl delta = divClass "timer-Visualiser" $ mdo return (flipEvent, programItem) -- small area :: (Event t Bool, Event t ()) bigAreaL <- divClass "big-areaControl" $ do inputWrapper <- divClass "input-wrapperControl" $ do - let iText = (formToText . form) <$> delta - (valTxBx,_,_) <- textWidget 3 (constDyn False) (T.pack "a=5,b=7,c=3") $ updated iText + let iText = (formToText . form) <$> delta + (valTxBx,_) <- textWithLockWidget 3 (constDyn $ False) iText let boton = snd smallAreaL let txPressed = tag (current $ valTxBx) boton -- Event t Text return $ parseForm <$> txPressed -- Event t [(Text,Rat)] @@ -91,16 +99,24 @@ timerControl delta = divClass "timer-Visualiser" $ mdo timerDisplay:: MonadWidget t m => Dynamic t Timer -> W t m (Event t Timer, Event t Bool) -- timerDisplay':: MonadWidget t m => Dynamic t Timer -> W t m () timerDisplay delta = divClass "timer-Visualiser" $ mdo + -- liftIO $ putStrLn "timerDisplay" dInit <- sample $ current delta let local = fst top mergedLocalDelta <- holdDyn dInit {- $ traceEvent "xD" -} $ leftmost [local,updated delta] timerChangeDisplay True mergedLocalDelta + let mouseCoords = getMouseEventCoords + -- mouseCoordsDyn <- holdDyn (0,0) $ + -- elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a +-- elClass "div" (constDyn ("class" =: "row")) (return ()) + + top <- do topContainer <- divClass "containerTimer" $ do flipItem <- clickableDiv "segmentLeftTimer" $ do - divClass "flipTimer" $ text $ T.pack "edit" + -- divClass "flipTimer" $ text $ T.pack "edit" + elDynAttr "div" (constDyn ("class" =: "flipTimer")) $ text $ T.pack "edit" let flipEvent = flipFunc <$ flipItem timerStateEvents <- divClass "segmentTimer" $ do reset <- clickableDiv "rowTopTimer" $ do @@ -165,11 +181,14 @@ visualDisplay delta 6 = do visualiseOnlyLabel delta return () visualDisplay delta 7 = do + visualiseCircle delta + return () +visualDisplay delta 8 = do visualiseStack delta return () visualDisplayPeek:: MonadWidget t m => Dynamic t Timer -> Int -> W t m () -visualDisplayPeek delta _ = do +visualDisplayPeek delta _ = do peek delta return () @@ -239,8 +258,8 @@ holdingCalculationP' display markC (z:zs) (x:xs) = calculatedSegments = if z > markC then percen else holdingCalculationP' display markC zs xs generalForm = sum (x:xs) -generalOrSegmentedHold:: Int -> Bool -generalOrSegmentedHold 7 = False +generalOrSegmentedHold:: Int -> Bool -- if new visual representations added this number should correspond to the ones that have a general count. For the moment only 8 has a general count +generalOrSegmentedHold 8 = False generalOrSegmentedHold _ = True cycleForm:: Rational -> [Rational] -> Rational @@ -333,14 +352,61 @@ peek delta = do beatPosition <- elapsedCounts -- :: Event t Rational -- tiempo desde origen beat <- holdDyn 0 beatPosition wBuildT <- liftIO getCurrentTime + let countPercent = (calculateCountSorC (measure iDelta) True iDelta wBuildT) <$> beat <*> currentTempo let count' = (calculateCountSorC (measure iDelta) False iDelta wBuildT) <$> beat <*> currentTempo let count = formatTextDisplay (measure iDelta) <$> count' let label = calculateLabelSorC (measure iDelta) iDelta wBuildT <$> beat <*> currentTempo + divClass "spot" $ do + drawCircle countPercent + pure () dynText label text $ T.pack " " dynText count pure () +visualiseCircle:: MonadWidget t m => Dynamic t Timer -> W t m () +visualiseCircle delta = do + iDelta <- sample $ current delta + currentTempo <- Estuary.Widgets.W.tempo + beatPosition <- elapsedCounts -- :: Event t Rational -- tiempo desde origen + beat <- holdDyn 0 beatPosition + wBuildT <- liftIO getCurrentTime + let count = (calculateCountSorC (measure iDelta) True iDelta wBuildT) <$> beat <*> currentTempo + let label = calculateLabelSorC (measure iDelta) iDelta wBuildT <$> beat <*> currentTempo + drawCircle count + pure () + + +drawCircle:: MonadWidget t m => Dynamic t Rational -> W t m () +drawCircle delta = do + + let class' = constDyn $ "class" =: "visualiser" + let vB = constDyn $ "viewBox" =: "0 0 100 100" + let w' = constDyn $ "width" =: "100" + let h' = constDyn $ "height" =: "100" + let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" + let attrs = mconcat [class',w',h',vB,par] + + -- define circle attrs + let cx = constDyn $ "cx" =: "50" + let cy = constDyn $ "cy" =: "50" + let fill = constDyn $ "fill" =:"var(--primary-color)" + let size = (\x -> "r" =: showt (realToFrac (x*0.495) :: Double)) <$> delta + let circleAttrs = mconcat [cx,cy,size,fill] + + let size' = constDyn $ "r" =: "49.5" + let stroke = constDyn $ "stroke" =: "var(--secondary-color)" + let fill' = constDyn $ "fill" =: "transparent" + + let markAttrs = mconcat [cx, cy, size', stroke, fill'] + + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "circle" markAttrs $ return () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "circle" circleAttrs $ return () + + pure () + + visualiseStack:: MonadWidget t m => Dynamic t Timer -> W t m () visualiseStack delta = do iDelta <- sample $ current delta @@ -361,7 +427,8 @@ drawStack countdown' program = do let width = constDyn $ "width" =: "100%" let height = constDyn $ "height" =: "100%" let vB = constDyn $ "viewBox" =: "0 0 150 100" - let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" + let par = constDyn $ "preserveAspectRatio" =: "none" + let par' = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" let attrs = mconcat [class',width,height, vB, par] -- svg let x1Line = constDyn $ "x1" =: "0" @@ -371,6 +438,12 @@ drawStack countdown' program = do let y2Line = (\y2 -> "y2" =: showt y2) <$> countdown let lineAttrs = mconcat [x1Line, x2Line, strokeLine, y1Line, y2Line] + let attrs' = mconcat [class',width,height, vB, par'] + + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs' $ do + generateLabelForBlocks countdown program + + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do generateStackBlocks countdown program elDynAttrNS' (Just "http://www.w3.org/2000/svg") "line" lineAttrs $ pure () @@ -383,19 +456,15 @@ generateStackBlocks count program = do x <- simpleList heightsAndYs (generateBlock count) return () ---simpleList :: MonadWidget t m => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a]) +generateLabelForBlocks:: MonadWidget t m => Dynamic t Double -> [(Text, Rational)] -> m () +generateLabelForBlocks count program = do + let heightsAndYs = constDyn <$> heightsAndY (percenForm $ Prelude.map snd program) $ Prelude.map fst program + x <- simpleList heightsAndYs (generateLabelForBlock count) + return () -generateBlock:: MonadWidget t m => Dynamic t Double -> Dynamic t (Double,Double,Text) -> m () -generateBlock count segment = do - let height = (\x -> "height" =: (showt $ fst' x)) <$> segment - let y = (\x -> "y" =: (showt $ snd' x)) <$> segment +generateLabelForBlock:: MonadWidget t m => Dynamic t Double -> Dynamic t (Double,Double,Text) -> m () +generateLabelForBlock count segment = do let label = (\x -> (trd' x)) <$> segment -- Dyn t Text - let width = constDyn $ "width" =: "150" - let x = constDyn $ "x" =: "0" - let stroke = constDyn $ "stroke" =: "var(--background-color)" - let fill = fill' <$> count <*> (fst' <$> segment) <*> (snd' <$> segment) - let op = opacity' <$> count <*> (fst' <$> segment) <*> (snd' <$> segment) - let attrsRect = mconcat [x,y,width,height,fill,op, stroke] -- text attributes let textX = constDyn $ "x" =: "70" let textY = (\y -> "y" =: (showt $ (snd' y) + ((fst' y)*0.85))) <$> segment @@ -407,15 +476,30 @@ generateBlock count segment = do -- span attributes - - - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsRect $ return () elDynAttrNS' (Just "http://www.w3.org/2000/svg") "text" txAttrs $ do elDynAttrNS' (Just "http://www.w3.org/2000/svg") "tspan" tspanAttrs $ do -- dynText $ fmap (\x -> showt (floor x)) countdown dynText label return () + +--simpleList :: MonadWidget t m => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a]) + +generateBlock:: MonadWidget t m => Dynamic t Double -> Dynamic t (Double,Double,Text) -> m () +generateBlock count segment = do + let height = (\x -> "height" =: (showt $ fst' x)) <$> segment + let y = (\x -> "y" =: (showt $ snd' x)) <$> segment + let width = constDyn $ "width" =: "150" + let x = constDyn $ "x" =: "0" + let stroke = constDyn $ "stroke" =: "var(--background-color)" + let fill = fill' <$> count <*> (fst' <$> segment) <*> (snd' <$> segment) + let op = opacity' <$> count <*> (fst' <$> segment) <*> (snd' <$> segment) + let attrsRect = mconcat [x,y,width,height,fill,op, stroke] + + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsRect $ return () + + return () + fill':: Double -> Double -> Double -> Map Text Text fill' count height y = if (count > (y+height)) then ("fill" =: "var(--primary-color)") @@ -463,38 +547,52 @@ drawProgressBarLabel countdown tag = do let vB = constDyn $ "viewBox" =: "0 0 100 80" let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" let attrs = mconcat [class',width,height, vB, par] -- svg - -- rect1 - let x' = constDyn $ "x" =: "0" - let y' = constDyn $ "y" =: "12" - let width1 = constDyn $ "width" =: "100" - let height1 = constDyn $ "height" =: "30" - let stroke = constDyn $ "stroke" =: "var(--primary-color)" - let fill = constDyn $ "fill" =: "transparent" - let attrsRect = mconcat [x',y',width1, height1, stroke, fill] - -- progress rect - let x'' = constDyn $ "x" =: "100" - let y'' = constDyn $ "y" =: "0" - let height2 = constDyn $ "height" =: "30" - let opacity = constDyn $ "opacity" =: "0.5" - let transform = constDyn $ "transform" =: "rotate(180,100,21)" - let fill = constDyn $ "fill" =: "var(--primary-color)" - let dynWidth = (\x -> "width" =: showt (realToFrac x :: Double)) <$> countdown - let attrsDynRect = mconcat [x'', y'', height2, opacity, transform, fill, dynWidth] - -- tag text - let txFill = constDyn $ "fill" =: "var(--primary-color)" + + let id = constDyn $ "id" =: "solid" + let fltAttrs = mconcat [id] + + let floodColor = constDyn $ "flood-color" =: "var(--background-color)" + let floodOpacity = constDyn $ "flood-opacity" =: "0.35" + let result = constDyn $ "result" =: "bg" + let feFloodAttrs = mconcat [floodColor, floodOpacity, result] + + -- + -- + -- + -- + -- + -- + -- + -- + -- + + + -- defs + -- filter + + + let txFill = constDyn $ "fill" =: "var(--secondary-color)" let txX = constDyn $ "x" =: "50" - let txY = constDyn $ "y" =: "72" + let txY = constDyn $ "y" =: "60" let txAnchor = constDyn $ "text-anchor" =: "middle" let fontSize = constDyn $ "font-size" =: "2em" + let txFilter = constDyn $ "filter" =: "url(#solid)" -- let fontSz = a dynamic text size with... - let txAttrs = mconcat [txFill, txX, txY, txAnchor, fontSize] + let txAttrs = mconcat [txFill, txX, txY, txAnchor, fontSize, txFilter] + + + drawProgressBar countdown elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "defs" (constDyn Data.Map.empty) $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "filter" fltAttrs $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feFlood" feFloodAttrs $ pure () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feMerge" (constDyn Data.Map.empty) $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feMergeNode" (constDyn $ "in" =: "bg") $ pure () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feMergeNode" (constDyn $ "in" =: "SourceGraphic") $ pure () elDynAttrNS' (Just "http://www.w3.org/2000/svg") "text" txAttrs $ do dynText tag - return () - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsRect $ return () - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsDynRect $ return () + return () return () visualiseProgressBar:: MonadWidget t m => Dynamic t Timer -> W t m () @@ -513,23 +611,23 @@ drawProgressBar countdown = do let class' = constDyn $ "class" =: "visualiser" let width = constDyn $ "width" =: "100%" let height = constDyn $ "height" =: "100%" - let vB = constDyn $ "viewBox" =: "0 0 100 80" - let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" + let vB = constDyn $ "viewBox" =: "0 0 100 50" + let par = constDyn $ "preserveAspectRatio" =: "none" let attrs = mconcat [class',width,height, vB, par] -- svg -- rect1 let x' = constDyn $ "x" =: "0" - let y' = constDyn $ "y" =: "12" + let y' = constDyn $ "y" =: "1" let width1 = constDyn $ "width" =: "100" - let height1 = constDyn $ "height" =: "30" + let height1 = constDyn $ "height" =: "48" let stroke = constDyn $ "stroke" =: "var(--primary-color)" let fill = constDyn $ "fill" =: "transparent" let attrsRect = mconcat [x',y',width1, height1, stroke, fill] -- progress rect let x'' = constDyn $ "x" =: "100" - let y'' = constDyn $ "y" =: "0" - let height2 = constDyn $ "height" =: "30" + let y'' = constDyn $ "y" =: "1" + let height2 = constDyn $ "height" =: "48" let opacity = constDyn $ "opacity" =: "0.5" - let transform = constDyn $ "transform" =: "rotate(180,100,21)" + let transform = constDyn $ "transform" =: "rotate(180,100,24.75)" let fill = constDyn $ "fill" =: "var(--primary-color)" let dynWidth = (\x -> "width" =: showt (realToFrac x :: Double)) <$> countdown let attrsDynRect = mconcat [x'', y'', height2, opacity, transform, fill, dynWidth] @@ -647,17 +745,15 @@ drawSandClock countdown = do let fillHold = constDyn $ "fill" =: "var(--primary-color)" let attrsHold = mconcat [mask',fillHold,x',yHold,widthHold,heightHold] - let transform = constDyn $ "transform" =: "scale(0.67) translate(27)" - let layerAttrs = mconcat [transform] + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do -- creatMask first sandClockMask -- sand Falling - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "g" layerAttrs $ do - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsFall $ return () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsFall $ return () -- sand held - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsHold $ return () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsHold $ return () return () --------- @@ -745,8 +841,8 @@ drawText countdown = do -- tspan1 attrs let y' = constDyn $ "y" =: "95" -- tspan2 attrs - let font2 = constDyn $ "font-size" =: "2.8em" - let y'' = constDyn $ "y" =: "45" + let font2 = constDyn $ "font-size" =: "5em" + let y'' = constDyn $ "y" =: "75" let tspan2Attrs = mconcat [txAnchor,fill,x',y'',font2] let txAttrs = mconcat [txAnchor,fill,x',y'] @@ -779,7 +875,7 @@ visualiseOnlyLabel delta = do drawOnlyLabel :: MonadWidget t m => Dynamic t Text -> W t m () drawOnlyLabel tag = do -- scale tag - let fontScaled = (fontSize . T.length) <$> tag + let fontScaled = (fontSize' . T.length) <$> tag -- svg attrs let class' = constDyn $ "class" =: "visualiser code-font" @@ -796,7 +892,7 @@ drawOnlyLabel tag = do let x' = constDyn $ "x" =: "50" -- tspan1 attrs let font1 = fontScaled - let y' = constDyn $ "y" =: "50" + let y' = constDyn $ "y" =: "75" let tspan1Attrs = mconcat [txAnchor,fill,x',y',font1] let txAttrs = mconcat [txAnchor,fill,x',y'] @@ -858,12 +954,20 @@ loopFunc timer -- this needs to change if other visualisers are added (either on the fly or permanently to estuary). numberOfVis:: Int -numberOfVis = 8 +numberOfVis = 9 ----- helpers for display +fontSize':: Int -> Map Text Text +fontSize' len + | len <= 8 = "font-size" =: "4em" + | len <= 12 = "font-size" =: "3em" + | len <= 20 = "font-size" =: "2em" + | len <= 30 = "font-size" =: "1.5em" + | otherwise = "font-size" =: "1em" -fontSize:: Int -> Map Text Text -- this is not attach to anything yet... follow throu... + +fontSize:: Int -> Map Text Text fontSize len | len <= 8 = "font-size" =: "2.5em" | len <= 12 = "font-size" =: "2.0em" @@ -905,7 +1009,7 @@ sandClockMask = do let fill' = constDyn $ "fill" =: "black" let attrsRect = mconcat [x,y,width',height',fill'] -- clock shape attributes - let points' = constDyn $ points [(5,95),(95,95),(45,45),(5,5),(95,5)] + let points' = constDyn $ points [(0,100),(100,100),(50,50),(0,0),(100,0)] let stroke' = constDyn $ "stroke" =: "white" let fill'' = constDyn $ "fill" =: "white" let attrsClock = mconcat [stroke',points',fill''] @@ -932,9 +1036,7 @@ ptsToCoord (x,y) = T.pack (show x) <> (T.pack ",") <> T.pack (show y) ---- --- Elapsed seconds makes most sense. Basically pass the count of elapsed seconds from builtime and then make the conversions locally (to beats). You have to figure out where this operations makes the most sense, candidate: calculateCount ---- I might have to use only a tick and the UTC time of 'last tick' -- this creates ticks from the moment estuary is built, just that elapsedCounts:: MonadWidget t m => W t m (Event t Rational) elapsedCounts = do @@ -951,8 +1053,9 @@ extractTimeMark (Holding' mark) = Left mark extractTimeMark Halted = Left $ realToFrac 0 -- +-- this needs to be precisely mapped to the timers generalOrSegmentedCount:: Int -> Bool -generalOrSegmentedCount 7 = False +generalOrSegmentedCount 8 = False -- stack timer, the only one that shows the whole program generalOrSegmentedCount _ = True -- this generates only whole numbers (less precise, more economic??) @@ -1186,3 +1289,9 @@ refreshIcon bool = do boolOpacity:: Bool -> Map Text Text boolOpacity False = "style" =: "filter: opacity(50%)" boolOpacity True = "style" =: "filter: opacity(100%)" + + +-- getMouseEventCoords :: EventM e MouseEvent (Int, Int) + + + diff --git a/static/css-source/source.css b/static/css-source/source.css index 8c5a59ce..f239dedb 100644 --- a/static/css-source/source.css +++ b/static/css-source/source.css @@ -1109,6 +1109,12 @@ cursor: pointer; z-index: 3; } +.spot { + position: relative; + width: 10%; + height: 100%; +} + .visualiser { position: absolute; z-index: 0; From cabfcaefe98a328ec32c268c78b6b20652b37365 Mon Sep 17 00:00:00 2001 From: Alejandro Date: Tue, 1 Aug 2023 16:03:45 -0400 Subject: [PATCH 3/4] all ready to be deployed except spanish translation --- client/estuary.cabal | 2 + client/src/Estuary/Tutorials/Metre.hs | 56 +++ client/src/Estuary/Tutorials/Timer.hs | 105 +++++ client/src/Estuary/Types/View/Parser.hs | 62 +-- client/src/Estuary/Types/View/Presets.hs | 26 +- client/src/Estuary/Widgets/Navigation.hs | 16 +- .../Estuary/Widgets/StopWatchExplorations.hs | 386 +++++++++--------- client/src/Estuary/Widgets/Tempo.hs | 103 +++-- client/src/Estuary/Widgets/Timer.hs | 62 ++- client/src/Estuary/Widgets/View.hs | 12 +- common/src/Estuary/Types/Definition.hs | 33 +- common/src/Estuary/Types/View.hs | 7 +- static/css-source/source.css | 154 ++++++- 13 files changed, 689 insertions(+), 335 deletions(-) create mode 100644 client/src/Estuary/Tutorials/Metre.hs create mode 100644 client/src/Estuary/Tutorials/Timer.hs diff --git a/client/estuary.cabal b/client/estuary.cabal index 74b1aaa8..3d3e8e4c 100644 --- a/client/estuary.cabal +++ b/client/estuary.cabal @@ -57,6 +57,8 @@ library Estuary.Tutorials.CineCer0 Estuary.Tutorials.Punctual Estuary.Tutorials.TidalCyclesBasics + Estuary.Tutorials.Timer + Estuary.Tutorials.Metre Estuary.Types.AnimationState Estuary.Types.EnsembleC Estuary.Types.Hint diff --git a/client/src/Estuary/Tutorials/Metre.hs b/client/src/Estuary/Tutorials/Metre.hs new file mode 100644 index 00000000..d0054b01 --- /dev/null +++ b/client/src/Estuary/Tutorials/Metre.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Estuary.Tutorials.Metre (metreTutorial) where + +import Data.Text (Text) +import qualified Data.Map.Strict as Map +import qualified Data.IntMap.Strict as IntMap +import qualified Data.Sequence as Seq + +import Estuary.Types.Tutorial +import Estuary.Types.View +import Estuary.Types.TranslatableText +import Estuary.Types.Language +import Estuary.Types.Definition +import Estuary.Types.TextNotation + +metreTutorial :: Tutorial +metreTutorial = Tutorial { + tutorialTitle = Map.fromList [ + (English,"Metre tutorial"), + (Español,"Tutorial del Compás") + ], + tutorialPages = Seq.fromList [ + -- /////////////////////////////////////////////////////////////// + --page 1: tutorial + (TutorialPage { + tutorialPageTitle = Map.fromList [ + (English,"Metre Tutorial"), + (Español,"Tutorial del Compás") + ], + tutorialPageView = GridView 1 2 [ + Views [ + + Paragraph [ Text $ Map.fromList[ + (English,"The Metre (or Meter) widget will allow players to visualise Estuary’s tempo in contrast with metric/rhythmic subdivisions and Bjorklund patterns. This is useful for pedagogical purposes; for example, to show how a pattern relates with the elapsing cycles or to explain how Bjorklund patterns work, but it can also be used to facilitate synchronisation between instrumentalists and an Estuary ensemble."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English,"You can call the Metre/Meter with the command in the View system ‘metre Int’ or ‘meter Int’. For example, ‘metre 10’ will generate a metre widget that occupies the index 10 in the view system. The metre visualiser has an interface based on clickable areas; if you hoover over it you will get indications of what would happen if you click on that area. As you can see, the right will take you to the next visualiser, the left to the previous one, up in the middle will add a new subdivision, and the one down in the middle will substract a subdivision."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English, "To begin, activate the timer (by pressing the reset or resume/pause areas) and change the visualisation mode. Observe the different ways in which we are representing ellapsing time. Some have labels for each section, some are more visual, some display numbers and text. The visualisers are: progress bar with labels, progress bar, sand-clock with labels, sand-clock, numeric with label, numeric, only labels, circular, and stack."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English, "The visualisers are divided into 2 categories expensive (in terms of computational resources) and (relatively) cheap. The visualisers are: circular expensive, circular cheap, squared expensive, squared cheap, bead expensive and bead cheap. The bead visualisers present a special behaviour: the middle area is divided into three (up, centre, down) instead of two (up and down). The additional central area will add a ‘k’ value to form a Euclidean pattern on top of the subdivided metre, which will act as the ‘m’. To learn more about these musical patterns see Toussaint's paper: 'The Euclidean Algorithm Generates Traditional Musical Rhythms'" + ), + (Español,"") + ]] + ], + MetreView 0 + ] + }) + ] +} diff --git a/client/src/Estuary/Tutorials/Timer.hs b/client/src/Estuary/Tutorials/Timer.hs new file mode 100644 index 00000000..0c0fe1bb --- /dev/null +++ b/client/src/Estuary/Tutorials/Timer.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Estuary.Tutorials.Timer (timerTutorial) where + +import Data.Text (Text) +import qualified Data.Map.Strict as Map +import qualified Data.IntMap.Strict as IntMap +import qualified Data.Sequence as Seq + +import Estuary.Types.Tutorial +import Estuary.Types.View +import Estuary.Types.TranslatableText +import Estuary.Types.Language +import Estuary.Types.Definition +import Estuary.Types.TextNotation + +timerTutorial :: Tutorial +timerTutorial = Tutorial { + tutorialTitle = Map.fromList [ + (English,"Timer tutorial"), + (Español,"Tutorial del Timer (temporizador)") + ], + tutorialPages = Seq.fromList [ + -- /////////////////////////////////////////////////////////////// + --page 1: intro + (TutorialPage { + tutorialPageTitle = Map.fromList [ + (English,"Intro"), + (Español,"Intro") + ], + tutorialPageView = GridView 1 2 [ + Views [ + + Paragraph [ Text $ Map.fromList[ + (English,"The Timer widget will allow players to count arbitrary time intervals from specified points in time. This is useful for some common live coding practices like: marking a prescribed time for a live coding act; communicate with the audience or other players the different sections of a performance, where different intentions are explored; synchronise precise gestures in an ensemble; or any other use we have not imagined of a (set of) count-down(s)."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English,"You can call the timer with the command in the View system ‘timer Int’. For example, ‘timer 10’ will generate a timer that occupies the index 10 in the view system. The timer has an interface based on clickable areas. So, if you hoover over the timer you will get indications of what would happen if you click on that area. As you can see, the right area will change the visualisation mode, the centre up will reset/start the program, the centre down will pause or resume it and the left will flip the widget to editing mode."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English, "To begin, activate the timer (by pressing the reset or resume/pause areas) and change the visualisation mode. Observe the different ways in which we are representing ellapsing time. Some have labels for each section, some are more visual, some display numbers and text. The visualisers are: progress bar with labels, progress bar, sand-clock with labels, sand-clock, numeric with label, numeric, only labels, circular, and stack."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English, "The stack visualiser has a special behaviour; it will show you all segments of your program at the same time and a line elapsing throughout the layers."), + (Español,"") + ]] + ], + TimerView 0 + ] + }), + --page 2: editing mode + (TutorialPage { + tutorialPageTitle = Map.fromList [ + (English,"Edit Mode"), + (Español,"Modo de Edición") + ], + tutorialPageView = GridView 1 2 [ + Views [ + + Paragraph [ Text $ Map.fromList[ + (English,"If you click on the left side of the timer display you will flip the widget into its ‘edit’ mode. Take a moment to see how different it is from the ‘display’ mode. On the top right you will see a ‘peek’ to the state of the timer display. This is useful because the flipping between ‘edit’ and ‘display’ mode is not networked; this means that some players might be still seeing the timer's display while someone else edits. "), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English,"Under the ‘peek’ area you will see an icon for loop, click on it to unloop (icon is grey in classic theme) and loop (icon is green in classic theme) the program. Under that loop icon you will see an icon of a metronome; click on it to change the time units from BPM/CPS (when icon is metronome) to seconds (when icon is clock). On the top left side you will see a botton called ‘display’ and a botton to run programs. The ‘display’ button will flip the widget back to display mode. The ▶ button will update the program as written in the text area below."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English, "Compare the timer’s behaviour when modifying these different aspects: looped and unlooped as well as using BPMs as time units or seconds. Remember that, in order to start playing a program you need to flip into display mode and push the reset or pause/resume areas. There is no way to start a program in the ‘edit’ mode."), + (Español,"") + ]] + ], + TimerView 0 + ] + }), + --page 3: write programs + (TutorialPage { + tutorialPageTitle = Map.fromList [ + (English,"Write your own Timer program"), + (Español,"Escribe tu propio programa de temporizador") + ], + tutorialPageView = GridView 1 2 [ + Views [ + + Paragraph [ Text $ Map.fromList[ + (English,"In order to change a program of the timer we made a very simple text interface. The default program is: a=5, b=7, c=3. This can be broken down into: Section ‘a’ will have a duration of 5 time units; section ‘b’ will have a duration of 7 time units and section ‘c’ will have a duration of 3 time units. So, as you can see, the way to write a program is: nameOfSection1 = duration1, nameOfNextSection2 = duration2, etc..."), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English,"In order to update the program, the ▶ button needs to be pressed, only then the changes will be reflected in the widget’s state and behaviour. This widget was inspired by a performance of the Cybernetic Orchestra where a prescribed set of durations allow performers to change tempo (or rhythmic figures or metre) in a synchronised manner. The Cybernetic Orchestra, if in need to play a similar piece, could now use this timer program: triplets = 120, quintuplets = 150, eight notes = 100, free rhythms = 60"), + (Español,"") + ]], + Paragraph [ Text $ Map.fromList[ + (English, "Paste or re-write the program above into the timer text interface and run it as an example of how to make your own programs. Then, make your own program that responds to your own performance ideas. :) Happy coding! "), + (Español,"") + ]] + ], + TimerView 0 + ] + }) + ] +} diff --git a/client/src/Estuary/Types/View/Parser.hs b/client/src/Estuary/Types/View/Parser.hs index 57a61e8b..44227573 100644 --- a/client/src/Estuary/Types/View/Parser.hs +++ b/client/src/Estuary/Types/View/Parser.hs @@ -44,9 +44,10 @@ dumpView TempoView = "tempo" dumpView (RouletteView x rows) = "roulette " <> showInt x <> " " <> showInt rows dumpView AudioMapView = "audiomap" dumpView (StopWatchView z) = "stopwatch " <> showInt z -dumpView (CountDownView z) = "countDown " <> showInt z -dumpView (SandClockView z) = "sandClock " <> showInt z -dumpView (SeeTimeView z) = "timeVision " <> showInt z +-- dumpView (CountDownView z) = "countDown " <> showInt z +-- dumpView (SandClockView z) = "sandClock " <> showInt z +dumpView (MetreView z) = "metre " <> showInt z +dumpView (MeterView z) = "meter " <> showInt z dumpView (TimerView z) = "timer " <> showInt z dumpView (NotePadView z) = "notepad " <> showInt z dumpView (IFrame url) = "iFrame \"" <> url <> "\"" @@ -81,9 +82,10 @@ viewParser = EmptyView <$ reserved "empty" -- localview empty <|> rouletteViewView -- localview (grid 2 2 [roulette 0 0,roulette 1 0,roulette 2 0,roulette 3 0]) <|> audioMapView <|> stopwatchParser - <|> countDownParser - <|> sandClockParser - <|> seeTimeParser + -- <|> countDownParser + -- <|> sandClockParser + <|> metreParser + <|> meterParser <|> timerParser <|> notePadParser <|> iFrameParser @@ -143,14 +145,24 @@ snippetViewFunc z b tn sn = Snippet z b (textToNotation' tn) sn -- -seeTimeParser :: H View -seeTimeParser = seeTimeParser' <*> int +metreParser :: H View +metreParser = metreParser' <*> int -seeTimeParser' :: H (Int -> View) -seeTimeParser' = seeTimeFunc <$ reserved "timeVision" +metreParser' :: H (Int -> View) +metreParser' = metreFunc <$ reserved "metre" -seeTimeFunc :: Int -> View -seeTimeFunc z = SeeTimeView z +metreFunc :: Int -> View +metreFunc z = MetreView z + +-- +meterParser :: H View +meterParser = meterParser' <*> int + +meterParser' :: H (Int -> View) +meterParser' = meterFunc <$ reserved "metre" + +meterFunc :: Int -> View +meterFunc z = MeterView z -- @@ -164,24 +176,24 @@ timerFunc :: Int -> View timerFunc z = TimerView z -- -sandClockParser :: H View -sandClockParser = sandClockParser' <*> int +-- sandClockParser :: H View +-- sandClockParser = sandClockParser' <*> int -sandClockParser' :: H (Int -> View) -sandClockParser' = sandClockFunc <$ reserved "sandClock" +-- sandClockParser' :: H (Int -> View) +-- sandClockParser' = sandClockFunc <$ reserved "sandClock" -sandClockFunc :: Int -> View -sandClockFunc z = SandClockView z +-- sandClockFunc :: Int -> View +-- sandClockFunc z = SandClockView z --- -countDownParser :: H View -countDownParser = countDownParser' <*> int +-- -- +-- countDownParser :: H View +-- countDownParser = countDownParser' <*> int -countDownParser' :: H (Int -> View) -countDownParser' = countDownFunc <$ reserved "countDown" +-- countDownParser' :: H (Int -> View) +-- countDownParser' = countDownFunc <$ reserved "countDown" -countDownFunc :: Int -> View -countDownFunc z = CountDownView z +-- countDownFunc :: Int -> View +-- countDownFunc z = CountDownView z -- stopwatchParser :: H View diff --git a/client/src/Estuary/Types/View/Presets.hs b/client/src/Estuary/Types/View/Presets.hs index 8cabd674..a2750792 100644 --- a/client/src/Estuary/Types/View/Presets.hs +++ b/client/src/Estuary/Types/View/Presets.hs @@ -85,23 +85,23 @@ presetViews = fromList [ ("tempoAndCode", GridView 2 1 [ BorderDiv [LabelView 0,CodeView 1 0 []], - BorderDiv [SeeTimeView 2] + BorderDiv [MetreView 2] ]), - ("sandClockAndCode", GridView 2 1 [ - BorderDiv [LabelView 0,CodeView 1 0 []], - BorderDiv [SandClockView 2] - ]), + -- ("sandClockAndCode", GridView 2 1 [ + -- BorderDiv [LabelView 0,CodeView 1 0 []], + -- BorderDiv [SandClockView 2] + -- ]), - ("countDownAndCode", GridView 2 1 [ - BorderDiv [LabelView 0,CodeView 1 0 []], - BorderDiv [CountDownView 2] - ]), + -- ("countDownAndCode", GridView 2 1 [ + -- BorderDiv [LabelView 0,CodeView 1 0 []], + -- BorderDiv [CountDownView 2] + -- ]), - ("stopWatchDownAndCode", GridView 2 1 [ - BorderDiv [LabelView 0,CodeView 1 0 []], - BorderDiv [CountDownView 2] - ]), + -- ("stopWatchDownAndCode", GridView 2 1 [ + -- BorderDiv [LabelView 0,CodeView 1 0 []], + -- BorderDiv [CountDownView 2] + -- ]), ("notepad", GridView 1 1 [ BorderDiv [NotePadView 0] diff --git a/client/src/Estuary/Widgets/Navigation.hs b/client/src/Estuary/Widgets/Navigation.hs index 43daab95..1954646f 100644 --- a/client/src/Estuary/Widgets/Navigation.hs +++ b/client/src/Estuary/Widgets/Navigation.hs @@ -43,6 +43,8 @@ import Estuary.Widgets.CreateEnsemble import Estuary.Tutorials.TidalCyclesBasics import Estuary.Tutorials.Punctual import Estuary.Tutorials.CineCer0 +import Estuary.Tutorials.Timer +import Estuary.Tutorials.Metre import Estuary.Widgets.Announcements data Navigation = @@ -79,7 +81,9 @@ page TutorialList = splitPageWithAnnouncements $ do navTidalCyclesBasics <- liftM (TutorialNav "TidalCyclesBasics" <$) $ divClass "tutorialButton" $ button "TidalCycles" navPunctualTutorial <- liftM (TutorialNav "Punctual" <$) $ divClass "tutorialButton" $ button "Punctual" navCineCer0 <- liftM (TutorialNav "CineCer0" <$) $ divClass "tutorialButton" $ button "CineCer0" - return $ leftmost [navTidalCyclesBasics,navPunctualTutorial,navCineCer0] + navTimer <- liftM (TutorialNav "Timer" <$) $ divClass "tutorialButton" $ button "Timer" + navMetre <- liftM (TutorialNav "Metre" <$) $ divClass "tutorialButton" $ button "Metre" + return $ leftmost [navTidalCyclesBasics,navPunctualTutorial,navCineCer0,navTimer, navMetre] page (TutorialNav "TidalCyclesBasics") = do leaveEnsemble @@ -96,6 +100,16 @@ page (TutorialNav "CineCer0") = do runTutorial cineCer0Tutorial return never +page (TutorialNav "Timer") = do + leaveEnsemble + runTutorial timerTutorial + return never + +page (TutorialNav "Metre") = do + leaveEnsemble + runTutorial metreTutorial + return never + page (TutorialNav _) = do text "Oops... a software error has occurred and we can't bring you to the tutorial you wanted! If you have a chance, please report this as an 'issue' on Estuary's github site" return never diff --git a/client/src/Estuary/Widgets/StopWatchExplorations.hs b/client/src/Estuary/Widgets/StopWatchExplorations.hs index 8516ed1d..db8836e1 100644 --- a/client/src/Estuary/Widgets/StopWatchExplorations.hs +++ b/client/src/Estuary/Widgets/StopWatchExplorations.hs @@ -20,7 +20,7 @@ import Estuary.Widgets.Text -stopWatchWidget :: MonadWidget t m => Dynamic t TimerUpState -> W t m (Variable t TimerUpState) +stopWatchWidget :: MonadWidget t m => Dynamic t StopwatchState -> W t m (Variable t StopwatchState) stopWatchWidget deltasDown = divClass "stopwatch" $ mdo -- 1. Translate button presses into localChanges let bText = stopWatchToButtonText <$> currentValue v @@ -51,7 +51,7 @@ visualiseStopwatchWidget delta = do ------ State calculations ---- -stopWatchToNextState :: TimerUpState -> IO TimerUpState +stopWatchToNextState :: StopwatchState -> IO StopwatchState stopWatchToNextState Cleared = do now <- getCurrentTime return (Running now) @@ -63,12 +63,12 @@ stopWatchToNextState (Running startTime) = do stopWatchToNextState (Stopped _) = return (Cleared) -stopWatchToText :: TimerUpState -> UTCTime -> Text +stopWatchToText :: StopwatchState -> UTCTime -> Text stopWatchToText Cleared _ = diffTimeToText 0 stopWatchToText (Running startTime) now = diffTimeToText $ diffUTCTime now startTime stopWatchToText (Stopped ndt) _ = diffTimeToText ndt -stopWatchToButtonText:: TimerUpState -> Text +stopWatchToButtonText:: StopwatchState -> Text stopWatchToButtonText Cleared = "Start" stopWatchToButtonText (Running _) = "Stop" stopWatchToButtonText (Stopped _) = "Clear" @@ -76,225 +76,225 @@ stopWatchToButtonText (Stopped _) = "Clear" -------- Countdown widget -countDownWidget :: MonadWidget t m => Dynamic t TimerDownState -> W t m (Variable t TimerDownState) -countDownWidget delta = divClass "countDown" $ mdo +-- countDownWidget :: MonadWidget t m => Dynamic t TimerDownState -> W t m (Variable t TimerDownState) +-- countDownWidget delta = divClass "countDown" $ mdo - let initialText = "t-minus: 60" -- Text - let updatedText = fmap (showt) $ updated timeDyn -- Event t Text - let editable = editableText <$> currentValue v -- Bool --checks if holding or falling. If holding editable if falling not. - textos <- holdDyn initialText $ leftmost [updatedText,textUpdates] -- Dynamic t Text - (valTxBx,_) <- textWithLockWidget 1 editable textos -- (Dynamic t Text, Event t Text) +-- let initialText = "t-minus: 60" -- Text +-- let updatedText = fmap (showt) $ updated timeDyn -- Event t Text +-- let editable = editableText <$> currentValue v -- Bool --checks if holding or falling. If holding editable if falling not. +-- textos <- holdDyn initialText $ leftmost [updatedText,textUpdates] -- Dynamic t Text +-- (valTxBx,_) <- textWithLockWidget 1 editable textos -- (Dynamic t Text, Event t Text) - let bText = countDownToButtonText <$> currentValue v -- Dynamic t Text -- changes the text in button - butt <- dynButton $ bText -- Event t () -- when this button is pressed +-- let bText = countDownToButtonText <$> currentValue v -- Dynamic t Text -- changes the text in button +-- butt <- dynButton $ bText -- Event t () -- when this button is pressed ----- OJO two tags in a row, different kind of pattern - let buttonPressedEvent = tag (current valTxBx) $ butt -- Event t Text -- the val in the textbox is tagged +-- ---- OJO two tags in a row, different kind of pattern +-- let buttonPressedEvent = tag (current valTxBx) $ butt -- Event t Text -- the val in the textbox is tagged - let stateWhenButtonPressed = tag (current $ currentValue v) buttonPressedEvent -- Event t Downer -- the current value of v (not delta) is tagged to the button pressed, currentValue v is a Dynamic of Downer, current gets the behaviour +-- let stateWhenButtonPressed = tag (current $ currentValue v) buttonPressedEvent -- Event t Downer -- the current value of v (not delta) is tagged to the button pressed, currentValue v is a Dynamic of Downer, current gets the behaviour - localChanges <- performEvent $ attachWith countDownButtonStateChange (current $ timeDyn) stateWhenButtonPressed -- Event to Downer +-- localChanges <- performEvent $ attachWith countDownButtonStateChange (current $ timeDyn) stateWhenButtonPressed -- Event to Downer ------------------------------------------------------- - timeDyn <- holdDyn 60 $ fmapMaybe ((readMaybe :: String -> Maybe Int) . T.unpack) $ buttonPressedEvent -- Dynamic t Int +-- ------------------------------------------------------ +-- timeDyn <- holdDyn 60 $ fmapMaybe ((readMaybe :: String -> Maybe Int) . T.unpack) $ buttonPressedEvent -- Dynamic t Int - widgetBuildTime <- liftIO $ getCurrentTime - initialCount <- sample $ current delta -- current gets the Behaviour of the dyn and then gets the m Downer - let initialTime = countDownToDisplay initialCount widgetBuildTime - tick <- tickLossy 0.06666666666666667 widgetBuildTime - let textUpdates = attachWithMaybe countDownToDisplay (current $ currentValue v) $ fmap _tickInfo_lastUTC tick - v <- variable delta localChanges - return v +-- widgetBuildTime <- liftIO $ getCurrentTime +-- initialCount <- sample $ current delta -- current gets the Behaviour of the dyn and then gets the m Downer +-- let initialTime = countDownToDisplay initialCount widgetBuildTime +-- tick <- tickLossy 0.06666666666666667 widgetBuildTime +-- let textUpdates = attachWithMaybe countDownToDisplay (current $ currentValue v) $ fmap _tickInfo_lastUTC tick +-- v <- variable delta localChanges +-- return v --------- Sandclock widget +-- -------- Sandclock widget -sandClockWidget :: MonadWidget t m => Dynamic t TimerDownState -> W t m (Variable t TimerDownState) -sandClockWidget deltasDown = divClass "countDown" $ mdo +-- sandClockWidget :: MonadWidget t m => Dynamic t TimerDownState -> W t m (Variable t TimerDownState) +-- sandClockWidget deltasDown = divClass "countDown" $ mdo - let initialText = "initial count is 60, change it here" - let updatedText = fmap (showt) $ updated timeDyn -- Event t Text - let editable = editableText <$> currentValue v - textos <- holdDyn initialText $ leftmost [updatedText, textUpdates] - (valTxBx,_) <- textToInvisible 1 editable textos - let bText = countDownToButtonText <$> currentValue v - butt <- dynButton $ bText - let buttonPressedEvent = tagPromptlyDyn valTxBx $ butt - let stateWhenButtonPressed = tagPromptlyDyn (currentValue v) buttonPressedEvent - localChanges <- performEvent $ attachPromptlyDynWith countDownButtonStateChange timeDyn stateWhenButtonPressed - -- this needs to change to attachWith countDownButtonStateChange (current timeDyn) stateWhenButtonPressed, however I have to discover how to updateText in line 81 and keep an eye on the targetTime update issue, for the moment it is clear that buttonPressedEvent caqnnot be in line 81 without consequences in the proper functioning of the widget... +-- let initialText = "initial count is 60, change it here" +-- let updatedText = fmap (showt) $ updated timeDyn -- Event t Text +-- let editable = editableText <$> currentValue v +-- textos <- holdDyn initialText $ leftmost [updatedText, textUpdates] +-- (valTxBx,_) <- textToInvisible 1 editable textos +-- let bText = countDownToButtonText <$> currentValue v +-- butt <- dynButton $ bText +-- let buttonPressedEvent = tagPromptlyDyn valTxBx $ butt +-- let stateWhenButtonPressed = tagPromptlyDyn (currentValue v) buttonPressedEvent +-- localChanges <- performEvent $ attachPromptlyDynWith countDownButtonStateChange timeDyn stateWhenButtonPressed +-- -- this needs to change to attachWith countDownButtonStateChange (current timeDyn) stateWhenButtonPressed, however I have to discover how to updateText in line 81 and keep an eye on the targetTime update issue, for the moment it is clear that buttonPressedEvent caqnnot be in line 81 without consequences in the proper functioning of the widget... - timeDyn <- holdDyn 60 $ fmapMaybe ((readMaybe :: String -> Maybe Int) . T.unpack) buttonPressedEvent +-- timeDyn <- holdDyn 60 $ fmapMaybe ((readMaybe :: String -> Maybe Int) . T.unpack) buttonPressedEvent - widgetBuildTime <- liftIO $ getCurrentTime - initialCount <- sample $ current deltasDown - let initialTime = countDownToDisplay initialCount widgetBuildTime - tick <- tickLossy 0.06666666666666667 widgetBuildTime - let textUpdates = attachWithMaybe countDownToDisplay (current $ currentValue v) $ fmap _tickInfo_lastUTC tick +-- widgetBuildTime <- liftIO $ getCurrentTime +-- initialCount <- sample $ current deltasDown +-- let initialTime = countDownToDisplay initialCount widgetBuildTime +-- tick <- tickLossy 0.06666666666666667 widgetBuildTime +-- let textUpdates = attachWithMaybe countDownToDisplay (current $ currentValue v) $ fmap _tickInfo_lastUTC tick ----- here I have to open a pathway for different kind of visualisations, so far: text, sandclock, bar progress---- +-- ---- here I have to open a pathway for different kind of visualisations, so far: text, sandclock, bar progress---- ---- sandclock experiments - let sandUpdates = attachWithMaybe sandClock (current $ currentValue v) $ fmap _tickInfo_lastUTC tick - -- holdDyn initialTime textUpdates >>= dynText -- if state is falling then do this - -- coso <- holdDyn "" sandUpdates -- >>= dynText -- if state is falling then do this --- sandClockWidget coso +-- --- sandclock experiments +-- let sandUpdates = attachWithMaybe sandClock (current $ currentValue v) $ fmap _tickInfo_lastUTC tick +-- -- holdDyn initialTime textUpdates >>= dynText -- if state is falling then do this +-- -- coso <- holdDyn "" sandUpdates -- >>= dynText -- if state is falling then do this +-- -- sandClockWidget coso - let sandUpdates' = attachWithMaybe clockForSVGs (current $ currentValue v) $ fmap _tickInfo_lastUTC tick - coso' <- holdDyn 0 sandUpdates' +-- let sandUpdates' = attachWithMaybe clockForSVGs (current $ currentValue v) $ fmap _tickInfo_lastUTC tick +-- coso' <- holdDyn 0 sandUpdates' - visualiseSVGWidget coso' +-- visualiseSVGWidget coso' - v <- returnVariable deltasDown localChanges - return v +-- v <- returnVariable deltasDown localChanges +-- return v -editableText:: TimerDownState -> Bool -editableText (Holding _) = False -editableText (Falling _ _) = True - -countDownButtonStateChange :: MonadIO m => Int -> TimerDownState -> m TimerDownState -countDownButtonStateChange newTar (Holding tar) = do - now <- liftIO getCurrentTime - return (Falling newTar now) -countDownButtonStateChange newTar (Falling tar y) = do - return (Holding newTar) - -countDownToDisplay:: TimerDownState -> UTCTime -> Maybe Text -countDownToDisplay (Holding _) _ = Nothing -countDownToDisplay (Falling x y) now = if xx < 0 then Just $ diffTimeToText 0 else Just $ diffTimeToText xx - where xx = (diffUTCTime (addUTCTime (realToFrac x) y) now) - -countDownToButtonText:: TimerDownState -> Text -countDownToButtonText (Holding _) = "Start" -countDownToButtonText (Falling _ _) = "Stop" - -countDownToInitialVal:: TimerDownState -> Int -countDownToInitialVal (Holding x) = x -countDownToInitialVal (Falling x _) = x - - -clockForSVGs:: TimerDownState -> UTCTime -> Maybe Int -clockForSVGs (Holding _) _ = Nothing -clockForSVGs (Falling target startTime) now = if xx < 0 then Just $ 0 else Just $ countToPercent 100 target xx - where xx = (diffUTCTime (addUTCTime (realToFrac target) startTime) now) - - --- function to calculate in percentage the countdown - -sandClock :: TimerDownState -> UTCTime -> Maybe Text -sandClock (Holding _) _ = Nothing -sandClock (Falling target startTime) now = if xx < 0 then Just $ timeToDots 0 else Just $ timeToDots (countToPercent 100 target xx) - where xx = (diffUTCTime (addUTCTime (realToFrac target) startTime) now) - --- not in use -timeToDots :: Int -> Text -timeToDots grains = showt $ concat $ replicate grains "." - ------- ambitious sandclock widget ---- - -visualiseSVGWidget :: MonadWidget t m => Dynamic t Int -> W t m () -visualiseSVGWidget delta = do - -- dynamic stuff - let yFall = countToFallY 50 0 <$> delta - let heightFall = countToFallH 50 <$> delta - let yHold = countToHoldY 0 100 <$> delta - let heightHold = countToHoldH 0 <$> delta - - let class' = constDyn $ "class" =: "mySVG" - let width = constDyn $ "width" =: "100%" - let height = constDyn $ "height" =: "100%" - let style = constDyn $ "style" =: ("height: auto; color: white; z-index: 0") - let vB = constDyn $ "viewBox" =: "0 0 100 100" - let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" - let attrs = mconcat [class',width,height, style, vB, par] - -- sand falling - let x = constDyn $ "x" =: "0" - let width' = constDyn $ "width" =: "100" - let strokeFall = constDyn $ "fill" =: "var(--primary-color)" - let mask' = constDyn $ "mask" =: "url(#myMask)" - let attrsFall = mconcat [mask',class',strokeFall,x,yFall,width',heightFall] - - -- sand holder - let x = constDyn $ "x" =: "0" - let widthHold = constDyn $ "width" =: "100" - let strokeHold = constDyn $ "fill" =: "var(--primary-color)" - let attrsHold = mconcat [mask',class',strokeHold,x,yHold,widthHold,heightHold] - - - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do - -- creatMask first - sandClockMask - -- sand Falling - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsFall $ return () - -- sand held - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsHold $ return () - - return () +-- editableText:: TimerDownState -> Bool +-- editableText (Holding _) = False +-- editableText (Falling _ _) = True -countToFallY:: Rational -> Rational -> Int -> Map Text Text -countToFallY defH defY percent = - let y' = realToFrac (defY + (defH * (realToFrac percent)))/100 :: Double - y = (realToFrac defH :: Double) + (y'*(-1)) - in "y" =: (showt y) +-- countDownButtonStateChange :: MonadIO m => Int -> TimerDownState -> m TimerDownState +-- countDownButtonStateChange newTar (Holding tar) = do +-- now <- liftIO getCurrentTime +-- return (Falling newTar now) +-- countDownButtonStateChange newTar (Falling tar y) = do +-- return (Holding newTar) -countToFallH:: Rational -> Int -> Map Text Text -countToFallH defH percent = - let h = realToFrac (round $ defH * (realToFrac percent))/100 :: Double - in "height" =: (showt h) - -countToHoldY:: Rational -> Rational -> Int -> Map Text Text -countToHoldY defH defY percent = -- percent es una cuenta regresiva del 100 al 0 - let countUp = realToFrac (100 + (percent*(-1))) :: Double - halfClock = countUp/2 - result = (realToFrac defY :: Double) - halfClock - in "y" =: (showt result) - -countToHoldH:: Rational -> Int -> Map Text Text -countToHoldH defH percent = - let countUp = realToFrac (100 + (percent*(-1))) :: Double - halfClock = countUp/2 - in "height" =: showt halfClock - ----- SVG helpers - -sandClockMask:: MonadWidget t m => W t m () -sandClockMask = do - let class' = constDyn $ "class" =: "human-to-human-comm textInputToEndOfLine code-font" - -- rect mask - let x = constDyn $ "x" =: "0" - let y = constDyn $ "y" =: "0" - let width' = constDyn $ "width" =: "100" - let height' = constDyn $ "height" =: "100" - let fill' = constDyn $ "fill" =: "black" - let attrsRect = mconcat [class', x,y,width',height',fill'] - -- clock shape attributes - let points' = constDyn $ points [(5,95),(95,95),(45,45),(5,5),(95,5)] - let stroke' = constDyn $ "stroke" =: "white" - let fill'' = constDyn $ "fill" =: "white" - let attrsClock = mconcat [class',stroke',points',fill''] - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "mask" (constDyn $ "id" =: "myMask") $ do - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsRect $ return () - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "polygon" attrsClock $ return () - return () - return () +-- countDownToDisplay:: TimerDownState -> UTCTime -> Maybe Text +-- countDownToDisplay (Holding _) _ = Nothing +-- countDownToDisplay (Falling x y) now = if xx < 0 then Just $ diffTimeToText 0 else Just $ diffTimeToText xx +-- where xx = (diffUTCTime (addUTCTime (realToFrac x) y) now) --------- points to make polygons or paths +-- countDownToButtonText:: TimerDownState -> Text +-- countDownToButtonText (Holding _) = "Start" +-- countDownToButtonText (Falling _ _) = "Stop" -points :: [(Int,Int)] -> Map Text Text -points [] = Data.Map.empty -points x = "points" =: (coordToText x) +-- countDownToInitialVal:: TimerDownState -> Int +-- countDownToInitialVal (Holding x) = x +-- countDownToInitialVal (Falling x _) = x -coordToText:: [(Int,Int)] -> Text -coordToText p = Prelude.foldl (\ x y -> x <> " " <> (ptsToCoord y)) "" p -ptsToCoord:: (Int,Int) -> Text -ptsToCoord (x,y) = T.pack (show x) <> (T.pack ",") <> T.pack (show y) +-- clockForSVGs:: TimerDownState -> UTCTime -> Maybe Int +-- clockForSVGs (Holding _) _ = Nothing +-- clockForSVGs (Falling target startTime) now = if xx < 0 then Just $ 0 else Just $ countToPercent 100 target xx +-- where xx = (diffUTCTime (addUTCTime (realToFrac target) startTime) now) + +-- -- function to calculate in percentage the countdown --- general helpers +-- sandClock :: TimerDownState -> UTCTime -> Maybe Text +-- sandClock (Holding _) _ = Nothing +-- sandClock (Falling target startTime) now = if xx < 0 then Just $ timeToDots 0 else Just $ timeToDots (countToPercent 100 target xx) +-- where xx = (diffUTCTime (addUTCTime (realToFrac target) startTime) now) + +-- -- not in use +-- timeToDots :: Int -> Text +-- timeToDots grains = showt $ concat $ replicate grains "." + +-- ------ ambitious sandclock widget ---- + +-- visualiseSVGWidget :: MonadWidget t m => Dynamic t Int -> W t m () +-- visualiseSVGWidget delta = do +-- -- dynamic stuff +-- let yFall = countToFallY 50 0 <$> delta +-- let heightFall = countToFallH 50 <$> delta +-- let yHold = countToHoldY 0 100 <$> delta +-- let heightHold = countToHoldH 0 <$> delta + +-- let class' = constDyn $ "class" =: "mySVG" +-- let width = constDyn $ "width" =: "100%" +-- let height = constDyn $ "height" =: "100%" +-- let style = constDyn $ "style" =: ("height: auto; color: white; z-index: 0") +-- let vB = constDyn $ "viewBox" =: "0 0 100 100" +-- let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" +-- let attrs = mconcat [class',width,height, style, vB, par] +-- -- sand falling +-- let x = constDyn $ "x" =: "0" +-- let width' = constDyn $ "width" =: "100" +-- let strokeFall = constDyn $ "fill" =: "var(--primary-color)" +-- let mask' = constDyn $ "mask" =: "url(#myMask)" +-- let attrsFall = mconcat [mask',class',strokeFall,x,yFall,width',heightFall] + +-- -- sand holder +-- let x = constDyn $ "x" =: "0" +-- let widthHold = constDyn $ "width" =: "100" +-- let strokeHold = constDyn $ "fill" =: "var(--primary-color)" +-- let attrsHold = mconcat [mask',class',strokeHold,x,yHold,widthHold,heightHold] + + +-- elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do +-- -- creatMask first +-- sandClockMask +-- -- sand Falling +-- elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsFall $ return () +-- -- sand held +-- elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsHold $ return () + +-- return () + +-- countToFallY:: Rational -> Rational -> Int -> Map Text Text +-- countToFallY defH defY percent = +-- let y' = realToFrac (defY + (defH * (realToFrac percent)))/100 :: Double +-- y = (realToFrac defH :: Double) + (y'*(-1)) +-- in "y" =: (showt y) + +-- countToFallH:: Rational -> Int -> Map Text Text +-- countToFallH defH percent = +-- let h = realToFrac (round $ defH * (realToFrac percent))/100 :: Double +-- in "height" =: (showt h) + +-- countToHoldY:: Rational -> Rational -> Int -> Map Text Text +-- countToHoldY defH defY percent = -- percent es una cuenta regresiva del 100 al 0 +-- let countUp = realToFrac (100 + (percent*(-1))) :: Double +-- halfClock = countUp/2 +-- result = (realToFrac defY :: Double) - halfClock +-- in "y" =: (showt result) + +-- countToHoldH:: Rational -> Int -> Map Text Text +-- countToHoldH defH percent = +-- let countUp = realToFrac (100 + (percent*(-1))) :: Double +-- halfClock = countUp/2 +-- in "height" =: showt halfClock + +-- ---- SVG helpers + +-- sandClockMask:: MonadWidget t m => W t m () +-- sandClockMask = do +-- let class' = constDyn $ "class" =: "human-to-human-comm textInputToEndOfLine code-font" +-- -- rect mask +-- let x = constDyn $ "x" =: "0" +-- let y = constDyn $ "y" =: "0" +-- let width' = constDyn $ "width" =: "100" +-- let height' = constDyn $ "height" =: "100" +-- let fill' = constDyn $ "fill" =: "black" +-- let attrsRect = mconcat [class', x,y,width',height',fill'] +-- -- clock shape attributes +-- let points' = constDyn $ points [(5,95),(95,95),(45,45),(5,5),(95,5)] +-- let stroke' = constDyn $ "stroke" =: "white" +-- let fill'' = constDyn $ "fill" =: "white" +-- let attrsClock = mconcat [class',stroke',points',fill''] +-- elDynAttrNS' (Just "http://www.w3.org/2000/svg") "mask" (constDyn $ "id" =: "myMask") $ do +-- elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrsRect $ return () +-- elDynAttrNS' (Just "http://www.w3.org/2000/svg") "polygon" attrsClock $ return () +-- return () +-- return () + +-- -------- points to make polygons or paths + +-- points :: [(Int,Int)] -> Map Text Text +-- points [] = Data.Map.empty +-- points x = "points" =: (coordToText x) + +-- coordToText:: [(Int,Int)] -> Text +-- coordToText p = Prelude.foldl (\ x y -> x <> " " <> (ptsToCoord y)) "" p + +-- ptsToCoord:: (Int,Int) -> Text +-- ptsToCoord (x,y) = T.pack (show x) <> (T.pack ",") <> T.pack (show y) + + +-- -- general helpers diffTimeToText :: NominalDiffTime -> Text diffTimeToText x = showt (floor x `div` 60 :: Int) <> ":" <> (add0Mod x) diff --git a/client/src/Estuary/Widgets/Tempo.hs b/client/src/Estuary/Widgets/Tempo.hs index 5ba8abbd..965b0278 100644 --- a/client/src/Estuary/Widgets/Tempo.hs +++ b/client/src/Estuary/Widgets/Tempo.hs @@ -242,7 +242,7 @@ visualiseMetreCheap delta subDivisions = do let attrsRect = mconcat [barPos,y,width,height,f] elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do - markTheZero delta + -- markTheZero delta -- mark generateSegments 100 subDivisions -- segment @@ -252,21 +252,24 @@ visualiseMetreCheap delta subDivisions = do markTheZero:: MonadWidget t m => Dynamic t Rational -> m () markTheZero beat = do beat' <- holdUniqDyn beat - let x = constDyn $ "x" =: "1" - let y = constDyn $ "y" =: "1" - let width = constDyn $ "width" =: "98" - let height = constDyn $ "height" =: "98" - let opacity = constDyn $ "style" =: "opacity:0.75" - let dynStroke = markMetre <$> beat' - let attrs = mconcat [x,y,width,height,dynStroke,opacity] + let x = constDyn $ "cx" =: "50" + let y = constDyn $ "cy" =: "50" + let r = constDyn $ "r" =: "5" + let opacity = markOpacity <$> beat + let dynFill = markMetre <$> beat' + let attrs = mconcat [x,y,r,dynFill,opacity] -- rect for beat - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "rect" attrs $ return () + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "circle" attrs $ return () return () +markOpacity:: Rational -> Map Text Text +markOpacity x = "style" =: ("opacity:" <> showt fadeOut) + where fadeOut = realToFrac (0.45 - (0.45 * truncToDec x)) :: Double + markMetre:: Rational -> Map Text Text markMetre x - | ((truncToDec x) >= 0) && ((truncToDec x) < 0.02) = "stroke" =: "var(--primary-color)" - | otherwise = "stroke" =: "none" + | ((truncToDec x) >= 0) && ((truncToDec x) < 0.45) = "fill" =: "var(--primary-color)" + | otherwise = "fill" =: "none" safeDiv:: Rational -> Rational -> Rational safeDiv e 0 = 0 @@ -567,20 +570,24 @@ selectVisualiser (Tv 0 seg k) = divClass "tempo-visualiser" $ do cycleTracer seg x <- do y <- divClass "flex-container-for-timeVision" $ do - leftPanel <- clickableDiv "flex-item-for-timeVision" blank -- :: Event t () + leftPanel <- clickableDiv "flex-item-for-timeVision-left" $ do -- :: Event t () + divClass "left-panel-hoover" $ text $ T.pack "previous metre visualiser" let leftEvent = tvNextStateLeft <$ leftPanel-- Event t (TimeVision -> TimeVision) centreEvent <- do z <- elClass "div" "flex-container-for-timeVision-vertical" $ do - upPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + upPanel <- clickableDiv "flex-item-for-timeVision-vertical-up" $ do + divClass "up-panel-hoover" $ text $ T.pack "more subdivisions" infoDisplay upPanel seg 4 let upEvent = segmentUp <$ upPanel - downPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + downPanel <- clickableDiv "flex-item-for-timeVision-vertical-down" $ do + divClass "down-panel-hoover" $ text $ T.pack "less subdivisions" infoDisplay downPanel seg 4 let downEvent = segmentDown <$ downPanel let cPanelEvent = leftmost [upEvent,downEvent] return cPanelEvent return z - rightPanel <- clickableDiv "flex-item-for-timeVision" blank + rightPanel <- clickableDiv "flex-item-for-timeVision-right" $ do -- :: Event t () + divClass "right-panel-hoover" $ text $ T.pack "next metre visualiser" let rightEvent = tvNextStateRight <$ rightPanel let panelEvent = fmap (\x -> x $ Tv 0 seg k) $ leftmost [centreEvent,leftEvent,rightEvent] return panelEvent @@ -590,20 +597,24 @@ selectVisualiser (Tv 0 seg k) = divClass "tempo-visualiser" $ do selectVisualiser (Tv 1 seg k) = divClass "tempo-visualiser" $ do ringTracer seg x <- divClass "flex-container-for-timeVision" $ do - leftPanel <- clickableDiv "flex-item-for-timeVision" blank -- :: Event t () + leftPanel <- clickableDiv "flex-item-for-timeVision-left" $ do -- :: Event t () + divClass "left-panel-hoover" $ text $ T.pack "previous metre visualiser" let leftEvent = tvNextStateLeft <$ leftPanel -- Event t (TimeVision -> TimeVision) centreEvent <- do x <- elClass "div" "flex-container-for-timeVision-vertical" $ do - upPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + upPanel <- clickableDiv "flex-item-for-timeVision-vertical-up" $ do + divClass "up-panel-hoover" $ text $ T.pack "more subdivisions" infoDisplay upPanel seg 4 let upEvent = segmentUp <$ upPanel - downPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + downPanel <- clickableDiv "flex-item-for-timeVision-vertical-down" $ do + divClass "down-panel-hoover" $ text $ T.pack "less subdivisions" infoDisplay downPanel seg 4 let downEvent = segmentDown <$ downPanel let cPanelEvent = leftmost [upEvent,downEvent] return cPanelEvent return x - rightPanel <- clickableDiv "flex-item-for-timeVision" $ blank + rightPanel <- clickableDiv "flex-item-for-timeVision-right" $ do -- :: Event t () + divClass "right-panel-hoover" $ text $ T.pack "next metre visualiser" let rightEvent = tvNextStateRight <$ rightPanel let panelEvent = fmap (\x -> x $ Tv 1 seg k) $ leftmost [centreEvent,leftEvent,rightEvent] return panelEvent @@ -613,20 +624,24 @@ selectVisualiser (Tv 2 seg k) = divClass "tempo-visualiser" $ do metreTracerFancy seg x <- do x <- divClass "flex-container-for-timeVision" $ do - leftPanel <- clickableDiv "flex-item-for-timeVision" blank -- :: Event t () + leftPanel <- clickableDiv "flex-item-for-timeVision-left" $ do -- :: Event t () + divClass "left-panel-hoover" $ text $ T.pack "previous metre visualiser" let leftEvent = tvNextStateLeft <$ leftPanel -- Event t (TimeVision -> TimeVision) centreEvent <- do x <- elClass "div" "flex-container-for-timeVision-vertical" $ do - upPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + upPanel <- clickableDiv "flex-item-for-timeVision-vertical-up" $ do + divClass "up-panel-hoover" $ text $ T.pack "more subdivisions" infoDisplay upPanel seg 4 let upEvent = segmentUp <$ upPanel - downPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + downPanel <- clickableDiv "flex-item-for-timeVision-vertical-down" $ do + divClass "down-panel-hoover" $ text $ T.pack "less subdivisions" infoDisplay downPanel seg 4 let downEvent = segmentDown <$ downPanel let cPanelEvent = leftmost [upEvent,downEvent] return cPanelEvent return x - rightPanel <- clickableDiv "flex-item-for-timeVision" blank + rightPanel <- clickableDiv "flex-item-for-timeVision-right" $ do -- :: Event t () + divClass "right-panel-hoover" $ text $ T.pack "next metre visualiser" let rightEvent = tvNextStateRight <$ rightPanel let panelEvent = fmap (\x -> x $ Tv 2 seg k) $ leftmost [centreEvent,leftEvent,rightEvent] return panelEvent @@ -637,20 +652,24 @@ selectVisualiser (Tv 3 seg k) = divClass "tempo-visualiser" $ do metreTracerCheap seg x <- do x <- divClass "flex-container-for-timeVision" $ do - leftPanel <- clickableDiv "flex-item-for-timeVision" blank -- :: Event t () + leftPanel <- clickableDiv "flex-item-for-timeVision-left" $ do -- :: Event t () + divClass "left-panel-hoover" $ text $ T.pack "previous metre visualiser" let leftEvent = tvNextStateLeft <$ leftPanel -- Event t (TimeVision -> TimeVision) centreEvent <- do x <- elClass "div" "flex-container-for-timeVision-vertical" $ do - upPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + upPanel <- clickableDiv "flex-item-for-timeVision-vertical-up" $ do + divClass "up-panel-hoover" $ text $ T.pack "more subdivisions" infoDisplay upPanel seg 4 let upEvent = segmentUp <$ upPanel - downPanel <- clickableDiv "flex-item-for-timeVision-vertical" blank + downPanel <- clickableDiv "flex-item-for-timeVision-vertical-down" $ do + divClass "down-panel-hoover" $ text $ T.pack "less subdivisions" infoDisplay downPanel seg 4 let downEvent = segmentDown <$ downPanel let cPanelEvent = leftmost [upEvent,downEvent] return cPanelEvent return x - rightPanel <- clickableDiv "flex-item-for-timeVision" blank + rightPanel <- clickableDiv "flex-item-for-timeVision-right" $ do -- :: Event t () + divClass "right-panel-hoover" $ text $ T.pack "next metre visualiser" let rightEvent = tvNextStateRight <$ rightPanel let panelEvent = fmap (\x -> x $ Tv 3 seg k) $ leftmost [centreEvent,leftEvent,rightEvent] return panelEvent @@ -660,23 +679,28 @@ selectVisualiser (Tv 3 seg k) = divClass "tempo-visualiser" $ do selectVisualiser (Tv 4 seg k) = divClass "tempo-visualiser" $ do beadsTracerFancy k seg x <- divClass "flex-container-for-timeVision" $ do - leftPanel <- clickableDiv "flex-item-for-timeVision" blank -- :: Event t () + leftPanel <- clickableDiv "flex-item-for-timeVision-left" $ do -- :: Event t () + divClass "left-panel-hoover" $ text $ T.pack "previous metre visualiser" let leftEvent = tvNextStateLeft <$ leftPanel -- Event t (TimeVision -> TimeVision) centreEvent <- do x <- elClass "div" "flex-container-for-timeVision-vertical-2" $ do - upPanel <- clickableDiv "flex-item-for-timeVision-vertical-2" blank + upPanel <- clickableDiv "flex-item-for-timeVision-vertical-2-up" $ do + divClass "up-panel-hoover-2" $ text $ T.pack "more subdivisions" infoDisplay' upPanel k seg 4 let upEvent = segmentUp <$ upPanel - middlePanel <- clickableDiv "flex-item-for-timeVision-vertical-2" blank + middlePanel <- clickableDiv "flex-item-for-timeVision-vertical-2-middle" $ do + divClass "middle-panel-hoover" $ text $ T.pack "bjorklund pattern" infoDisplay' middlePanel k seg 4 let middleEvent = bjorklundUp <$ middlePanel - downPanel <- clickableDiv "flex-item-for-timeVision-vertical-2" blank + downPanel <- clickableDiv "flex-item-for-timeVision-vertical-2-down" $ do + divClass "down-panel-hoover-2" $ text $ T.pack "less subdivisions" infoDisplay' downPanel k seg 4 let downEvent = segmentDown <$ downPanel let cPanelEvent = leftmost [middleEvent,upEvent,downEvent] return cPanelEvent return x - rightPanel <- clickableDiv "flex-item-for-timeVision" $ blank + rightPanel <- clickableDiv "flex-item-for-timeVision-right" $ do -- :: Event t () + divClass "right-panel-hoover" $ text $ T.pack "next metre visualiser" let rightEvent = tvNextStateRight <$ rightPanel let panelEvent = fmap (\x -> x $ Tv 4 seg k) $ leftmost [centreEvent,leftEvent,rightEvent] return panelEvent @@ -685,23 +709,28 @@ selectVisualiser (Tv 4 seg k) = divClass "tempo-visualiser" $ do selectVisualiser (Tv 5 seg k) = divClass "tempo-visualiser" $ do beadsTracerCheap k seg x <- divClass "flex-container-for-timeVision" $ do - leftPanel <- clickableDiv "flex-item-for-timeVision" blank -- :: Event t () + leftPanel <- clickableDiv "flex-item-for-timeVision-left" $ do -- :: Event t () + divClass "left-panel-hoover" $ text $ T.pack "previous metre visualiser" let leftEvent = tvNextStateLeft <$ leftPanel -- Event t (TimeVision -> TimeVision) centreEvent <- do x <- elClass "div" "flex-container-for-timeVision-vertical-2" $ do - upPanel <- clickableDiv "flex-item-for-timeVision-vertical-2" blank + upPanel <- clickableDiv "flex-item-for-timeVision-vertical-2-up" $ do + divClass "up-panel-hoover-2" $ text $ T.pack "more subdivisions" infoDisplay' upPanel k seg 4 let upEvent = segmentUp <$ upPanel - middlePanel <- clickableDiv "flex-item-for-timeVision-vertical-2" blank + middlePanel <- clickableDiv "flex-item-for-timeVision-vertical-2-middle" $ do + divClass "middle-panel-hoover" $ text $ T.pack "bjorklund pattern" infoDisplay' middlePanel k seg 4 let middleEvent = bjorklundUp <$ middlePanel - downPanel <- clickableDiv "flex-item-for-timeVision-vertical-2" blank + downPanel <- clickableDiv "flex-item-for-timeVision-vertical-2-down" $ do + divClass "down-panel-hoover-2" $ text $ T.pack "less subdivisions" infoDisplay' downPanel k seg 4 let downEvent = segmentDown <$ downPanel let cPanelEvent = leftmost [middleEvent,upEvent,downEvent] return cPanelEvent return x - rightPanel <- clickableDiv "flex-item-for-timeVision" $ blank + rightPanel <- clickableDiv "flex-item-for-timeVision-right" $ do -- :: Event t () + divClass "right-panel-hoover" $ text $ T.pack "next metre visualiser" let rightEvent = tvNextStateRight <$ rightPanel let panelEvent = fmap (\x -> x $ Tv 5 seg k) $ leftmost [centreEvent,leftEvent,rightEvent] return panelEvent diff --git a/client/src/Estuary/Widgets/Timer.hs b/client/src/Estuary/Widgets/Timer.hs index 718371fd..22e2aaeb 100644 --- a/client/src/Estuary/Widgets/Timer.hs +++ b/client/src/Estuary/Widgets/Timer.hs @@ -69,11 +69,14 @@ timerControl delta = divClass "timer-Visualiser" $ mdo return (flipEvent, programItem) -- small area :: (Event t Bool, Event t ()) bigAreaL <- divClass "big-areaControl" $ do inputWrapper <- divClass "input-wrapperControl" $ do - let iText = (formToText . form) <$> delta - (valTxBx,_) <- textWithLockWidget 3 (constDyn $ False) iText - let boton = snd smallAreaL - let txPressed = tag (current $ valTxBx) boton -- Event t Text - return $ parseForm <$> txPressed -- Event t [(Text,Rat)] + let iText = (formToText . forRendering . form) <$> delta + (valTxBx,_) <- textWithLockWidget 3 (constDyn $ False) iText -- Dyn t Text + let boton = snd smallAreaL -- Event t () + let dynFormed = fmap parseForm valTxBx -- dyn t [(tx, rat)] + let forma = (current dynFormed) <@ boton -- Event t Live [(tx,rat)] + -- let txPressed = tag (current $ valTxBx) boton -- Event t Text + return forma + --return $ parseForm <$> txPressed -- Event t [(Text,Rat)] return $ textInputFunc <$> inputWrapper -- big area :: Event t (Form -> Timer Timer) return (bigAreaL, fst smallAreaL) -- columnLeft columnRight <- divClass "columnControl" $ do @@ -105,13 +108,6 @@ timerDisplay delta = divClass "timer-Visualiser" $ mdo let local = fst top mergedLocalDelta <- holdDyn dInit {- $ traceEvent "xD" -} $ leftmost [local,updated delta] timerChangeDisplay True mergedLocalDelta - - let mouseCoords = getMouseEventCoords - -- mouseCoordsDyn <- holdDyn (0,0) $ - -- elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a --- elClass "div" (constDyn ("class" =: "row")) (return ()) - - top <- do topContainer <- divClass "containerTimer" $ do flipItem <- clickableDiv "segmentLeftTimer" $ do @@ -122,14 +118,14 @@ timerDisplay delta = divClass "timer-Visualiser" $ mdo reset <- clickableDiv "rowTopTimer" $ do divClass "resetTimer" $ text $ T.pack "reset" pausePlay <- clickableDiv "rowBottomTimer" $ do - divClass "pauseTimer" $ text $ T.pack "pause/play" + divClass "pauseTimer" $ text $ T.pack "pause/resume" aTimeReset <- performEvent $ fmap (\ _ -> liftIO $ getCurrentTime) reset let resetEvent = resetFunc <$> aTimeReset aTimePlay <- performEvent $ fmap (\ _ -> liftIO $ getCurrentTime) pausePlay let playPauseEvent = playPauseFunc <$> aTimePlay return $ leftmost [resetEvent, playPauseEvent] modeChangeItem <- clickableDiv "segmentRightTimer" $ do - divClass "modeTimer" $ text $ T.pack "change mode" + divClass "modeTimer" $ text $ T.pack "change visualiser" let modeChangeEvent = visualiserFunc <$ modeChangeItem let networkedEvents = leftmost [timerStateEvents, modeChangeEvent] return (networkedEvents, flipEvent) @@ -206,12 +202,12 @@ calculateCountSorC Seconds graphOrText timer wBuildT elapsingCount t = holdingCalculation:: Bool -> Rational -> Timer -> Tempo -> Rational holdingCalculation True mark timer t - | (measure timer) == Seconds = holdingCalculationLooped mark $ Prelude.map snd (form timer) - | otherwise = holdingCalculationLooped markAsBeat $ Prelude.map snd (form timer) + | (measure timer) == Seconds = holdingCalculationLooped mark $ Prelude.map snd (forRendering $ form timer) + | otherwise = holdingCalculationLooped markAsBeat $ Prelude.map snd (forRendering $ form timer) where markAsBeat = (freq t) * mark holdingCalculation False mark timer t - | (measure timer) == Seconds = holdingCalculationUnlooped mark $ Prelude.map snd (form timer) - | otherwise = holdingCalculationUnlooped markAsBeat $ Prelude.map snd (form timer) + | (measure timer) == Seconds = holdingCalculationUnlooped mark $ Prelude.map snd (forRendering $ form timer) + | otherwise = holdingCalculationUnlooped markAsBeat $ Prelude.map snd (forRendering $ form timer) where markAsBeat = (freq t) * mark holdingCalculationUnlooped:: Rational -> [Rational] -> Rational @@ -230,12 +226,12 @@ holdingCalculation' markC (z:zs) = if z > markC then (z-markC) holdingCalculationP:: Bool -> Rational -> Timer -> Tempo -> Rational holdingCalculationP True mark timer t - | (measure timer) == Seconds = holdingCalculationLoopedP (n timer) mark $ Prelude.map snd (form timer) - | otherwise = holdingCalculationLoopedP (n timer) markAsBeat $ Prelude.map snd (form timer) + | (measure timer) == Seconds = holdingCalculationLoopedP (n timer) mark $ Prelude.map snd (forRendering $ form timer) + | otherwise = holdingCalculationLoopedP (n timer) markAsBeat $ Prelude.map snd (forRendering $ form timer) where markAsBeat = (freq t) * mark holdingCalculationP False mark timer t - | (measure timer) == Seconds = holdingCalculationUnloopedP (n timer) mark $ Prelude.map snd (form timer) - | otherwise = holdingCalculationUnloopedP (n timer) markAsBeat $ Prelude.map snd (form timer) + | (measure timer) == Seconds = holdingCalculationUnloopedP (n timer) mark $ Prelude.map snd (forRendering $ form timer) + | otherwise = holdingCalculationUnloopedP (n timer) markAsBeat $ Prelude.map snd (forRendering $ form timer) where markAsBeat = (freq t) * mark -- int is the N necessary for general or segmented timer (checkes which timer we are using) @@ -278,7 +274,7 @@ calculateCount False delta wBuildT elapsingCount t = -- elapsed count is seconds then realToFrac (diffUTCTime startMark' wBuildT) :: Rational else timeToCount t startMark' countUp = elapsingCount - startMark - countForm = Prelude.map snd (form delta) -- [Rat] + countForm = Prelude.map snd (forRendering $ form delta) -- [Rat] loopedCountUp = loopCountUp' (loop delta) countForm countUp countDown = multiTimer 0 countForm loopedCountUp in countDown @@ -291,7 +287,7 @@ calculateCount True delta wBuildT elapsingCount t = -- elapsed count is seconds then realToFrac (diffUTCTime startMark' wBuildT) :: Rational else timeToCount t startMark' countUp = elapsingCount - (realToFrac startMark :: Rational) - countForm = Prelude.map snd (form delta) -- [Rat] + countForm = Prelude.map snd (forRendering $ form delta) -- [Rat] loopedCountUp = loopCountUp (loop delta) countForm countUp countDown = if generalOrSegmentedCount (n delta) then multiTimerPercent 0 countForm loopedCountUp else generalTimerPercent 0 countForm loopedCountUp in countDown @@ -307,12 +303,12 @@ calculateLabelSorC Seconds timer wBuildT elapsingCount t = holdingLabel:: Bool -> Rational -> Timer -> Tempo -> Text holdingLabel True mark timer t - | (measure timer) == Seconds = holdingLabelLooped mark (Prelude.map snd (form timer)) $ Prelude.map fst (form timer) - | otherwise = holdingLabelLooped markAsBeat (Prelude.map snd (form timer)) $ Prelude.map fst (form timer) + | (measure timer) == Seconds = holdingLabelLooped mark (Prelude.map snd (forRendering $ form timer)) $ Prelude.map fst (forRendering $ form timer) + | otherwise = holdingLabelLooped markAsBeat (Prelude.map snd (forRendering $ form timer)) $ Prelude.map fst (forRendering $ form timer) where markAsBeat = (freq t) * mark holdingLabel False mark timer t - | (measure timer) == Seconds = holdingLabelUnlooped mark (Prelude.map snd (form timer)) $ Prelude.map fst (form timer) - | otherwise = holdingLabelUnlooped markAsBeat (Prelude.map snd (form timer)) $ Prelude.map fst (form timer) + | (measure timer) == Seconds = holdingLabelUnlooped mark (Prelude.map snd (forRendering $ form timer)) $ Prelude.map fst (forRendering $ form timer) + | otherwise = holdingLabelUnlooped markAsBeat (Prelude.map snd (forRendering $ form timer)) $ Prelude.map fst (forRendering $ form timer) where markAsBeat = (freq t) * mark holdingLabelUnlooped:: Rational -> [Rational] -> [Text] -> Text @@ -339,9 +335,9 @@ calculateLabel delta wBuildT elapsedCount t = then realToFrac (diffUTCTime startMark' wBuildT) :: Rational else timeToCount t startMark' countUp = elapsedCount - (realToFrac startMark :: Rational) - countForm = Prelude.map snd (form delta) -- [Rat] + countForm = Prelude.map snd (forRendering $ form delta) -- [Rat] loopedCountUp = loopCountUp' (loop delta) countForm countUp - label = genLabel 0 (form delta) loopedCountUp + label = genLabel 0 (forRendering $ form delta) loopedCountUp in label @@ -415,7 +411,7 @@ visualiseStack delta = do beat <- holdDyn 0 beatPosition wBuildT <- liftIO getCurrentTime let count = (calculateCountSorC (measure iDelta) True iDelta wBuildT) <$> beat <*> currentTempo - let program = (form iDelta) + let program = (forRendering $ form iDelta) drawStack count program pure () @@ -939,7 +935,8 @@ visualiserFunc timer = timer {n= (((n timer)+1)`mod`numberOfVis)} -- add the mod --- controller funcas textInputFunc:: [(T.Text,Rational)] -> Timer -> Timer -textInputFunc count timer = timer {form=count} +textInputFunc count timer = timer {form=cuenta} + where cuenta = evaluate $ edit (form timer) count -- Measure = Cycles | Seconds measureFunc:: Timer -> Timer @@ -1294,4 +1291,3 @@ boolOpacity True = "style" =: "filter: opacity(100%)" -- getMouseEventCoords :: EventM e MouseEvent (Int, Int) - diff --git a/client/src/Estuary/Widgets/View.hs b/client/src/Estuary/Widgets/View.hs index e0a1b37f..8e24b7fc 100644 --- a/client/src/Estuary/Widgets/View.hs +++ b/client/src/Estuary/Widgets/View.hs @@ -120,17 +120,17 @@ viewWidget (CalendarEventView z) = do let defaultValue = IntMap.singleton 0 (CalendarEvent "" (CalendarTime today (Recurrence Once today))) zoneWidget False z defaultValue maybeCalendarEvents CalendarEvs calendarEventWidget -viewWidget (CountDownView z) = zoneWidget False z (Holding 60) maybeTimerDownState CountDown countDownWidget +-- viewWidget (CountDownView z) = zoneWidget False z (Holding 60) maybeTimerDownState CountDown countDownWidget -viewWidget (SandClockView z) = zoneWidget False z (Holding 60) maybeTimerDownState CountDown sandClockWidget +-- viewWidget (SandClockView z) = zoneWidget False z (Holding 60) maybeTimerDownState CountDown sandClockWidget -viewWidget (StopWatchView z) = zoneWidget False z Cleared maybeTimerUpState StopWatch stopWatchWidget +viewWidget (StopWatchView z) = zoneWidget False z Cleared maybeStopwatchState StopWatch stopWatchWidget --- viewWidget er (SeeTimeView z) = zoneWidget z (Tv 0 4 0) maybeSeeTime SeeTime er visualiseTempoWidget +viewWidget (TimerView z) = zoneWidget False z (Timer 0 (Live [("a",5),("b",7),("c",3)] L3) Halted True Cycles) maybeTimer TimerDef timerWidget -viewWidget (TimerView z) = zoneWidget False z (Timer 0 [("a",5),("b",7),("c",3)] Halted True Cycles) maybeTimer TimerDef timerWidget +viewWidget (MetreView z) = zoneWidget False z (Tv 0 4 0) maybeSeeTime SeeTime visualiseTempoWidget -viewWidget (SeeTimeView z) = zoneWidget False z (Tv 0 4 0) maybeSeeTime SeeTime visualiseTempoWidget +viewWidget (MeterView z) = zoneWidget False z (Tv 0 4 0) maybeSeeTime SeeTime visualiseTempoWidget viewWidget (NotePadView z) = zoneWidget False z (0,Seq.fromList[("Title","Content")]) maybeNotePad NotePad notePadWidget diff --git a/common/src/Estuary/Types/Definition.hs b/common/src/Estuary/Types/Definition.hs index 94d61166..24b964cc 100644 --- a/common/src/Estuary/Types/Definition.hs +++ b/common/src/Estuary/Types/Definition.hs @@ -60,12 +60,15 @@ data TimerDownState = Falling Int UTCTime -- target and start time deriving (Eq,Show,Generic) -data TimerUpState = +data StopwatchState = Cleared | Running UTCTime | Stopped NominalDiffTime deriving (Eq, Show, Generic) +instance ToJSON StopwatchState where + toEncoding = genericToEncoding defaultOptions +instance FromJSON StopwatchState data Measure = Cycles | Seconds deriving (Show,Ord,Eq,Generic) instance ToJSON Measure where @@ -81,11 +84,11 @@ instance FromJSON Mode data Timer = Timer { n:: Int, - form:: [(Text,Rational)], + form:: Live [(Text,Rational)], mode:: Mode, loop:: Bool, measure:: Measure -} deriving (Show,Eq,Ord,Generic) +} deriving (Show,Eq,Generic) instance ToJSON Timer where toEncoding = genericToEncoding defaultOptions @@ -97,10 +100,6 @@ instance ToJSON TimeVision where toEncoding = genericToEncoding defaultOptions instance FromJSON TimeVision -instance ToJSON TimerUpState where - toEncoding = genericToEncoding defaultOptions -instance FromJSON TimerUpState - instance ToJSON TimerDownState where toEncoding = genericToEncoding defaultOptions instance FromJSON TimerDownState @@ -113,7 +112,7 @@ data Definition = Roulette Roulette | CountDown TimerDownState | SandClock TimerDownState | - StopWatch TimerUpState | + StopWatch StopwatchState | SeeTime TimeVision | TimerDef Timer | NotePad NotePad | @@ -138,8 +137,8 @@ definitionForRendering (TidalStructure x) = TidalStructure x definitionForRendering (LabelText x) = LabelText x definitionForRendering (Roulette x) = Roulette x definitionForRendering (CalendarEv x) = CalendarEv x -definitionForRendering (CountDown x) = CountDown x -definitionForRendering (SandClock x) = SandClock x +-- definitionForRendering (CountDown x) = CountDown x +-- definitionForRendering (SandClock x) = SandClock x definitionForRendering (StopWatch x) = StopWatch x definitionForRendering (SeeTime x) = SeeTime x definitionForRendering (TimerDef x) = TimerDef x @@ -196,14 +195,14 @@ maybeCalendarEvent _ = Nothing justCalendarEvent :: [Definition] -> [CalendarEvent] justCalendarEvent = mapMaybe maybeCalendarEvent -maybeTimerUpState:: Definition -> Maybe TimerUpState -maybeTimerUpState (StopWatch x) = Just x -maybeTimerUpState _ = Nothing +maybeStopwatchState:: Definition -> Maybe StopwatchState +maybeStopwatchState (StopWatch x) = Just x +maybeStopwatchState _ = Nothing -maybeTimerDownState:: Definition -> Maybe TimerDownState -maybeTimerDownState (CountDown x) = Just x -maybeTimerDownState (SandClock x) = Just x -maybeTimerDownState _ = Nothing +-- maybeTimerDownState:: Definition -> Maybe TimerDownState +-- maybeTimerDownState (CountDown x) = Just x +-- maybeTimerDownState (SandClock x) = Just x +-- maybeTimerDownState _ = Nothing maybeSeeTime:: Definition -> Maybe TimeVision maybeSeeTime (SeeTime x) = Just x diff --git a/common/src/Estuary/Types/View.hs b/common/src/Estuary/Types/View.hs index 626f2106..8e261d41 100644 --- a/common/src/Estuary/Types/View.hs +++ b/common/src/Estuary/Types/View.hs @@ -37,10 +37,11 @@ data View = TempoView | RouletteView Int Int | AudioMapView | - CountDownView Int | - SandClockView Int | + -- CountDownView Int | + -- SandClockView Int | StopWatchView Int | - SeeTimeView Int | + MetreView Int | -- brit/canadian spelling + MeterView Int | -- murikan spelling TimerView Int | NotePadView Int | IFrame Text | -- embedded web page diff --git a/static/css-source/source.css b/static/css-source/source.css index f239dedb..e5011a19 100644 --- a/static/css-source/source.css +++ b/static/css-source/source.css @@ -1057,13 +1057,52 @@ cursor: pointer; } -.flex-item-for-timeVision { +.flex-item-for-timeVision-left { width: 100%; z-index: 1; height: 100%; min-height: 100%; } +.flex-item-for-timeVision-left:hover .left-panel-hoover { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; + } + +.left-panel-hoover { + z-index: 1; + visibility: hidden; + position: absolute; + top: 50%; + left: 15%; + background-color: var(--secondary-color); + opacity: 75%; + } + +.flex-item-for-timeVision-right { + width: 100%; + z-index: 1; + height: 100%; + min-height: 100%; +} + +.flex-item-for-timeVision-right:hover .right-panel-hoover { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; + } + +.right-panel-hoover { + z-index: 1; + visibility: hidden; + position: absolute; + top: 50%; + left: 75%; + background-color: var(--secondary-color); + opacity: 75%; + } + .flex-container-for-timeVision-vertical { display: flex; flex-direction: column; @@ -1073,13 +1112,52 @@ cursor: pointer; min-height: 100%; } -.flex-item-for-timeVision-vertical { +.flex-item-for-timeVision-vertical-up { width: 100%; height: 100%; z-index: 1; min-height: 50%; } +.flex-item-for-timeVision-vertical-up:hover .up-panel-hoover { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; +} + +.up-panel-hoover { + z-index: 1; + visibility: hidden; + position: absolute; + top: 25%; + left: 45%; + background-color: var(--secondary-color); + opacity: 75%; +} + +.flex-item-for-timeVision-vertical-down { + width: 100%; + height: 100%; + z-index: 1; + min-height: 50%; +} + +.flex-item-for-timeVision-vertical-down:hover .down-panel-hoover { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; +} + +.down-panel-hoover { + z-index: 1; + visibility: hidden; + position: absolute; + top: 75%; + left: 45%; + background-color: var(--secondary-color); + opacity: 75%; +} + .flex-container-for-timeVision-vertical-2 { display: flex; flex-direction: column; @@ -1089,13 +1167,75 @@ cursor: pointer; min-height: 100%; } -.flex-item-for-timeVision-vertical-2 { +.flex-item-for-timeVision-vertical-2-up { width: 100%; height: 100%; z-index: 1; min-height: 33%; } +.flex-item-for-timeVision-vertical-2-up:hover .up-panel-hoover-2 { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; +} + +.up-panel-hoover-2 { + z-index: 1; + visibility: hidden; + position: absolute; + top: 25%; + left: 45%; + background-color: var(--secondary-color); + opacity: 75%; +} + +.flex-item-for-timeVision-vertical-2-down { + width: 100%; + height: 100%; + z-index: 1; + min-height: 33%; +} + +.flex-item-for-timeVision-vertical-2-down:hover .down-panel-hoover-2 { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; +} + +.down-panel-hoover-2 { + z-index: 1; + visibility: hidden; + position: absolute; + top: 75%; + left: 45%; + background-color: var(--secondary-color); + opacity: 75%; +} + +.flex-item-for-timeVision-vertical-2-middle { + width: 100%; + height: 100%; + z-index: 1; + min-height: 33%; +} + +.flex-item-for-timeVision-vertical-2-middle:hover .middle-panel-hoover { + visibility: visible; + opacity: 0%; + transition: opacity 5s linear; +} + +.middle-panel-hoover { + z-index: 1; + visibility: hidden; + position: absolute; + top: 50%; + left: 45%; + background-color: var(--secondary-color); + opacity: 75%; +} + .timer-Visualiser { width: 100%; height: 100%; @@ -2423,7 +2563,7 @@ box-shadow: inset 0 0 3px var(--primary-color); visibility: hidden; position: absolute; top: 50%; - left: 0%; + left: 40%; background-color: var(--secondary-color); opacity: 75%; } @@ -2450,7 +2590,7 @@ box-shadow: inset 0 0 3px var(--primary-color); visibility: hidden; position: absolute; top: 50%; - left: 0%; + left: 40%; background-color: var(--secondary-color); opacity: 75%; } @@ -2475,7 +2615,7 @@ box-shadow: inset 0 0 3px var(--primary-color); visibility: hidden; position: absolute; top: 50%; - left: 0%; + left: 40%; background-color: var(--secondary-color); opacity: 75%; } @@ -2500,7 +2640,7 @@ box-shadow: inset 0 0 3px var(--primary-color); visibility: hidden; position: absolute; top: 50%; - left: 0%; + left: 40%; background-color: var(--secondary-color); opacity: 75%; } \ No newline at end of file From d52c2fb947d43eaff04c3be3d94e945235cf547e Mon Sep 17 00:00:00 2001 From: Alejandro Date: Thu, 17 Aug 2023 19:06:40 -0400 Subject: [PATCH 4/4] last commit --- client/src/Estuary/Tutorials/Metre.hs | 12 ++++------- client/src/Estuary/Tutorials/Timer.hs | 26 +++++++++++------------ client/src/Estuary/Widgets/Timer.hs | 30 +++++++-------------------- 3 files changed, 25 insertions(+), 43 deletions(-) diff --git a/client/src/Estuary/Tutorials/Metre.hs b/client/src/Estuary/Tutorials/Metre.hs index d0054b01..3b0e795b 100644 --- a/client/src/Estuary/Tutorials/Metre.hs +++ b/client/src/Estuary/Tutorials/Metre.hs @@ -33,20 +33,16 @@ metreTutorial = Tutorial { Paragraph [ Text $ Map.fromList[ (English,"The Metre (or Meter) widget will allow players to visualise Estuary’s tempo in contrast with metric/rhythmic subdivisions and Bjorklund patterns. This is useful for pedagogical purposes; for example, to show how a pattern relates with the elapsing cycles or to explain how Bjorklund patterns work, but it can also be used to facilitate synchronisation between instrumentalists and an Estuary ensemble."), - (Español,"") + (Español,"El widget de compás (Metre widget) permitirá a lxs usuarixs visualizar el tempo de Estuary en contraste con subdivisiones métricas/rítmicas y patrones Bjorklund. Esto es útil para fines pedagógicos; por ejemplo, para mostrar cómo se relaciona un patrón con los ciclos que transcurren o para explicar cómo funcionan los patrones Bjorklund, pero también se puede utilizar para facilitar la sincronización entre instrumentistas y programadores tocando en Estuary.") ]], Paragraph [ Text $ Map.fromList[ (English,"You can call the Metre/Meter with the command in the View system ‘metre Int’ or ‘meter Int’. For example, ‘metre 10’ will generate a metre widget that occupies the index 10 in the view system. The metre visualiser has an interface based on clickable areas; if you hoover over it you will get indications of what would happen if you click on that area. As you can see, the right will take you to the next visualiser, the left to the previous one, up in the middle will add a new subdivision, and the one down in the middle will substract a subdivision."), - (Español,"") + (Español,"Puede llamar al Compás con el comando en el sistema View 'metre Int'. Por ejemplo, 'metre 10' generará un widget de compás que ocupa el índice 10 en el sistema de visualización. El visualizador tiene una interfaz basada en áreas en las que se puede hacer clic; si pasas el cursor sobre el widget, obtendrás indicaciones de lo que sucedería si haces clic en esa área. Como puedes ver, el área derecha te llevará al siguiente visualizador, la izquierda al anterior, el de arriba en medio agregará una nueva subdivisión, y el de abajo en medio restará una subdivisión.") ]], Paragraph [ Text $ Map.fromList[ - (English, "To begin, activate the timer (by pressing the reset or resume/pause areas) and change the visualisation mode. Observe the different ways in which we are representing ellapsing time. Some have labels for each section, some are more visual, some display numbers and text. The visualisers are: progress bar with labels, progress bar, sand-clock with labels, sand-clock, numeric with label, numeric, only labels, circular, and stack."), - (Español,"") - ]], - Paragraph [ Text $ Map.fromList[ - (English, "The visualisers are divided into 2 categories expensive (in terms of computational resources) and (relatively) cheap. The visualisers are: circular expensive, circular cheap, squared expensive, squared cheap, bead expensive and bead cheap. The bead visualisers present a special behaviour: the middle area is divided into three (up, centre, down) instead of two (up and down). The additional central area will add a ‘k’ value to form a Euclidean pattern on top of the subdivided metre, which will act as the ‘m’. To learn more about these musical patterns see Toussaint's paper: 'The Euclidean Algorithm Generates Traditional Musical Rhythms'" + (English, "The visualisers are divided into 2 categories expensive (in terms of computational resources) and (relatively) cheap. The visualisers are: circular expensive, circular cheap, rectangular expensive, rectangular cheap, bead expensive and bead cheap. The bead visualisers present a special behaviour: the middle area is divided into three (up, centre, down) instead of two (up and down). The additional central area will add a ‘k’ value to form a Euclidean pattern on top of the subdivided metre, which will act as the ‘m’. To learn more about these musical patterns see Toussaint's paper: 'The Euclidean Algorithm Generates Traditional Musical Rhythms'" ), - (Español,"") + (Español,"Los visualizadores se dividen en 2 categorías caros (en términos de recursos computacionales) y (relativamente) baratos. Los visualizadores son: circular caro, circular barato, rectangular caro, rectangular barato, perlado caro y perlado barato. Los visualizadores de perlas presentan un comportamiento especial: la zona central se divide en tres (arriba, centro, abajo) en lugar de dos (arriba y abajo). El área central adicional agregará un valor 'k' para formar un patrón euclidiano en la parte superior del metro subdividido, que actuará como la 'm'. Para obtener más información sobre estos patrones musicales, consulte el artículo de Toussaint: 'The Euclidean Algorithm Generates Traditional Musical Rhythms'") ]] ], MetreView 0 diff --git a/client/src/Estuary/Tutorials/Timer.hs b/client/src/Estuary/Tutorials/Timer.hs index 0c0fe1bb..e40f89fc 100644 --- a/client/src/Estuary/Tutorials/Timer.hs +++ b/client/src/Estuary/Tutorials/Timer.hs @@ -33,19 +33,19 @@ timerTutorial = Tutorial { Paragraph [ Text $ Map.fromList[ (English,"The Timer widget will allow players to count arbitrary time intervals from specified points in time. This is useful for some common live coding practices like: marking a prescribed time for a live coding act; communicate with the audience or other players the different sections of a performance, where different intentions are explored; synchronise precise gestures in an ensemble; or any other use we have not imagined of a (set of) count-down(s)."), - (Español,"") + (Español,"El widget de temporizador (timer widget) permitirá a lxs usuarixs contar intervalos de tiempo arbitrarios desde anclas temporales específicas. Esto es útil para algunas prácticas comunes de la programación al vuelo como: marcar un tiempo prescrito para un performance de programación al vuelo; comunicar con la audiencia, u otros actores, las diferentes secciones de un performance, donde se exploran diferentes intenciones; sincronizar gestos precisos en un ensamble; o cualquier otro uso que no hayamos imaginado de una (o varias) cuenta(s) regresiva(s).") ]], Paragraph [ Text $ Map.fromList[ (English,"You can call the timer with the command in the View system ‘timer Int’. For example, ‘timer 10’ will generate a timer that occupies the index 10 in the view system. The timer has an interface based on clickable areas. So, if you hoover over the timer you will get indications of what would happen if you click on that area. As you can see, the right area will change the visualisation mode, the centre up will reset/start the program, the centre down will pause or resume it and the left will flip the widget to editing mode."), - (Español,"") + (Español,"Es posible llamar al temporizador en el sistema View con el comando 'timer Int'. Por ejemplo, 'timer 10' generará un temporizador que ocupa el índice 10 en el sistema de visualización. El temporizador tiene una interfaz donde hay áreas en las que se puede hacer clic. Entonces, si pasas el cursor sobre el temporizador, obtendrás indicaciones de lo que sucedería si haces clic en esa área. Como puedes ver, el área de la derecha cambiará el modo de visualización, el centro hacia arriba reiniciará/iniciará el programa, el centro hacia abajo lo pausará o lo reanudará y el de la izquierda cambiará el widget al modo de edición.") ]], Paragraph [ Text $ Map.fromList[ (English, "To begin, activate the timer (by pressing the reset or resume/pause areas) and change the visualisation mode. Observe the different ways in which we are representing ellapsing time. Some have labels for each section, some are more visual, some display numbers and text. The visualisers are: progress bar with labels, progress bar, sand-clock with labels, sand-clock, numeric with label, numeric, only labels, circular, and stack."), - (Español,"") + (Español,"Para empezar, activa el temporizador (pulsando las zonas de reset o reanudar/pausar) y cambia el modo de visualización. Observa las diferentes formas en que estamos representando el tiempo transcurrido. Algunos tienen etiquetas para cada sección, algunos son más visuales, algunos muestran números y texto. Los visualizadores son: barra de progreso con etiquetas, barra de progreso, reloj de arena con etiquetas, reloj de arena, numérico con etiqueta, numérico, solo etiquetas, circular y apilado.") ]], Paragraph [ Text $ Map.fromList[ (English, "The stack visualiser has a special behaviour; it will show you all segments of your program at the same time and a line elapsing throughout the layers."), - (Español,"") + (Español,"El visualizador de 'apilado' tiene un comportamiento especial; este mostrará todos los segmentos del programa al mismo tiempo y, además, una línea que atraviesa todas las capas.") ]] ], TimerView 0 @@ -61,16 +61,16 @@ timerTutorial = Tutorial { Views [ Paragraph [ Text $ Map.fromList[ - (English,"If you click on the left side of the timer display you will flip the widget into its ‘edit’ mode. Take a moment to see how different it is from the ‘display’ mode. On the top right you will see a ‘peek’ to the state of the timer display. This is useful because the flipping between ‘edit’ and ‘display’ mode is not networked; this means that some players might be still seeing the timer's display while someone else edits. "), - (Español,"") + (English,"If you click on the left side of the timer display you will flip the widget into its ‘edit’ mode. Take a moment to see how different it is from the ‘display’ mode. On the top right you will see a ‘peek’ to the state of the timer display. This is useful because the flipping between ‘edit’ and ‘display’ mode is not networked; this means that some players might be still seeing the timer's display while someone else edits."), + (Español,"Si haces clic en el lado izquierdo de la pantalla del temporizador, cambiará el widget a su modo de 'edición'. Toma un momento para ver qué tan diferente es del modo de 'display'. En la parte superior derecha, verás un vistazo ('peek') al estado de la pantalla del temporizador. Esto es útil porque el cambio entre el modo 'edit' y 'display' no está conectado en red; esto significa que es posible que algunxs usuarixs sigan viendo la pantalla del temporizador mientras otra persona edita.") ]], Paragraph [ Text $ Map.fromList[ (English,"Under the ‘peek’ area you will see an icon for loop, click on it to unloop (icon is grey in classic theme) and loop (icon is green in classic theme) the program. Under that loop icon you will see an icon of a metronome; click on it to change the time units from BPM/CPS (when icon is metronome) to seconds (when icon is clock). On the top left side you will see a botton called ‘display’ and a botton to run programs. The ‘display’ button will flip the widget back to display mode. The ▶ button will update the program as written in the text area below."), - (Español,"") + (Español,"Debajo del área de ‘peek’ verás un icono para el loop, haz clic en él para desloopear (el ícono aparecerá gris en el tema clásico) y loopear (el ícono se verá verde en el tema clásico) el programa. Debajo de ese ícono de loop, verás un ícono de un metrónomo; haz clic en él para cambiar las unidades de tiempo de BPM/CPS (cuando el ícono es un metrónomo) a segundos (cuando el ícono es un reloj). En la parte superior izquierda verás un botón llamado 'display' y un botón para ejecutar programas. El botón 'display' hará que el widget vuelva al modo de visualización. El botón ▶ actualizará el programa como está escrito en el área de texto a continuación descrita.") ]], Paragraph [ Text $ Map.fromList[ (English, "Compare the timer’s behaviour when modifying these different aspects: looped and unlooped as well as using BPMs as time units or seconds. Remember that, in order to start playing a program you need to flip into display mode and push the reset or pause/resume areas. There is no way to start a program in the ‘edit’ mode."), - (Español,"") + (Español,"Compara el comportamiento del temporizador al modificar estos diferentes aspectos: en loop y sin loop, así como al usar BPM como unidades de tiempo o segundos. Recuerda que, para comenzar a reproducir un programa, debes pasar al modo de visualización y presionar las áreas de reinicio o pausa/reanudar. No hay forma de iniciar un programa en el modo 'editar'.") ]] ], TimerView 0 @@ -86,16 +86,16 @@ timerTutorial = Tutorial { Views [ Paragraph [ Text $ Map.fromList[ - (English,"In order to change a program of the timer we made a very simple text interface. The default program is: a=5, b=7, c=3. This can be broken down into: Section ‘a’ will have a duration of 5 time units; section ‘b’ will have a duration of 7 time units and section ‘c’ will have a duration of 3 time units. So, as you can see, the way to write a program is: nameOfSection1 = duration1, nameOfNextSection2 = duration2, etc..."), - (Español,"") + (English,"In order to change a program of the timer we made a very simple text interface. The default program is: a=5, b=7, c=3. This can be broken down into: Section ‘a’ will have a duration of 5 time units; section ‘b’ will have a duration of 7 time units and section ‘c’ will have a duration of 3 time units. So, as you can see, the way to write a program is: nameOfSection1 = duration1, nameOfSection2 = duration2, etc..."), + (Español,"Para cambiar un programa del temporizador, hemos creado una interfaz de texto muy simple. El programa predeterminado es: a=5, b=7, c=3. Este se puede desglosar en: La sección 'a' tendrá una duración de 5 unidades de tiempo; la sección ‘b’ tendrá una duración de 7 unidades de tiempo y la sección ‘c’ tendrá una duración de 3 unidades de tiempo. Entonces, la forma de escribir un programa es: nombreDeSección1 = duración1, nombreDeSección2 = duración2, etc...") ]], Paragraph [ Text $ Map.fromList[ - (English,"In order to update the program, the ▶ button needs to be pressed, only then the changes will be reflected in the widget’s state and behaviour. This widget was inspired by a performance of the Cybernetic Orchestra where a prescribed set of durations allow performers to change tempo (or rhythmic figures or metre) in a synchronised manner. The Cybernetic Orchestra, if in need to play a similar piece, could now use this timer program: triplets = 120, quintuplets = 150, eight notes = 100, free rhythms = 60"), - (Español,"") + (English,"In order to update the program, the ▶ button needs to be pressed, only then the changes will be reflected in the widget’s state and behaviour. This widget was inspired by a practice of the Cybernetic Orchestra where a prescribed set of durations (or rhythmic figures or metre) are changed in a synchronised manner by all performers. The Cybernetic Orchestra, if in need to play a similar piece, could now use this timer program: triplets = 120, quintuplets = 150, eight notes = 100, free rhythms = 60"), + (Español,"Para actualizar el programa, se debe presionar el botón ▶, solo entonces los cambios se verán reflejados en el estado y el comportamiento del widget. Este widget se inspiró en una práctica de la Cybernetic Orchestra en la que todos los participantes cambian un conjunto prescrito de duraciones (o figuras rítmicas o métricas) de manera sincronizada. La orquesta, si necesita tocar una pieza similar, ahora podría usar este programa del temporizador: tresillos = 120, quintillos = 150, corcheas = 100, ritmos libres = 60") ]], Paragraph [ Text $ Map.fromList[ (English, "Paste or re-write the program above into the timer text interface and run it as an example of how to make your own programs. Then, make your own program that responds to your own performance ideas. :) Happy coding! "), - (Español,"") + (Español,"Pega o vuelve a escribir el programa anterior en la interfaz de texto del temporizador y ejecútalo como un ejemplo de cómo crear tus propios programas. Luego, crea tus propios programas que respondan a tus propias ideas de interpretación. :) ¡Feliz codigueo!") ]] ], TimerView 0 diff --git a/client/src/Estuary/Widgets/Timer.hs b/client/src/Estuary/Widgets/Timer.hs index 22e2aaeb..543abd41 100644 --- a/client/src/Estuary/Widgets/Timer.hs +++ b/client/src/Estuary/Widgets/Timer.hs @@ -424,7 +424,7 @@ drawStack countdown' program = do let height = constDyn $ "height" =: "100%" let vB = constDyn $ "viewBox" =: "0 0 150 100" let par = constDyn $ "preserveAspectRatio" =: "none" - let par' = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" + let par' = constDyn $ "preserveAspectRatio" =: "none" let attrs = mconcat [class',width,height, vB, par] -- svg let x1Line = constDyn $ "x1" =: "0" @@ -541,7 +541,7 @@ drawProgressBarLabel countdown tag = do let width = constDyn $ "width" =: "100%" let height = constDyn $ "height" =: "100%" let vB = constDyn $ "viewBox" =: "0 0 100 80" - let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" + let par = constDyn $ "preserveAspectRatio" =: "xMidYMid meet" let attrs = mconcat [class',width,height, vB, par] -- svg let id = constDyn $ "id" =: "solid" @@ -552,21 +552,6 @@ drawProgressBarLabel countdown tag = do let result = constDyn $ "result" =: "bg" let feFloodAttrs = mconcat [floodColor, floodOpacity, result] - -- - -- - -- - -- - -- - -- - -- - -- - -- - - - -- defs - -- filter - - let txFill = constDyn $ "fill" =: "var(--secondary-color)" let txX = constDyn $ "x" =: "50" let txY = constDyn $ "y" =: "60" @@ -577,18 +562,19 @@ drawProgressBarLabel countdown tag = do let txAttrs = mconcat [txFill, txX, txY, txAnchor, fontSize, txFilter] - drawProgressBar countdown - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "svg" attrs $ do + elDynAttrNS' (Just "http://www.w3.org/2000/svg") "text" txAttrs $ do + dynText tag + return () elDynAttrNS' (Just "http://www.w3.org/2000/svg") "defs" (constDyn Data.Map.empty) $ do elDynAttrNS' (Just "http://www.w3.org/2000/svg") "filter" fltAttrs $ do elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feFlood" feFloodAttrs $ pure () elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feMerge" (constDyn Data.Map.empty) $ do elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feMergeNode" (constDyn $ "in" =: "bg") $ pure () elDynAttrNS' (Just "http://www.w3.org/2000/svg") "feMergeNode" (constDyn $ "in" =: "SourceGraphic") $ pure () - elDynAttrNS' (Just "http://www.w3.org/2000/svg") "text" txAttrs $ do - dynText tag - return () + + drawProgressBar countdown + return () visualiseProgressBar:: MonadWidget t m => Dynamic t Timer -> W t m ()