unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-11-14 16:28:34 +03:00
Code Issues Projects Releases Wiki Activity

WIP on navigation events

Browse Source
This commit is contained in:
Paul Chiusano 2015-09-10 15:41:44 -04:00
parent 36b530fc81
commit c84554db18
2 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
editor/src/HelloWorld.hs
View File

@ -33,10 +33,21 @@ main = mainWidget $ mdo
el "pre" $ do el "pre" $ do
text "region: " text "region: "
display region display region
(e,d,(w,h)) <- DocView.widget (Width 200) termDoc (body, (mouse,path,region)) <- el' "div" $ do
mouse <- mouseMove' e >>= holdDyn (X 0, Y 0) (e,d,(w,h)) <- DocView.widget (Width 200) termDoc
path <- mapDyn (concat . DocView.at d) mouse mouse <- mouseMove' e >>= holdDyn (X 0, Y 0)
region <- mapDyn (\p -> DocView.region d [p]) path path <- mapDyn (Doc.at d) mouse
sel <- mapDyn (DocView.selectionLayer h) region region <- mapDyn (Doc.region d) path
_ <- widgetHold (pure ()) (Dynamic.updated sel) sel <- mapDyn (DocView.selectionLayer h) region
_ <- widgetHold (pure ()) (Dynamic.updated sel)
return (mouse, path, region)
return () return ()
keypress :: Reflex t => El t -> Event t Int
keypress e = domEvent Keypress e
upKeypress, downKeypress, leftKeypress, rightKeypress :: Reflex t => El t -> Event t Int
leftKeypress e = ffilter (== 37) (keypress e)
upKeypress e = ffilter (== 38) (keypress e)
rightKeypress e = ffilter (== 39) (keypress e)
downKeypress e = ffilter (== 40) (keypress e)

19
editor/src/Unison/DocView.hs
View File

@ -11,7 +11,7 @@ import Data.Text (Text)
import Reflex.Dom import Reflex.Dom
import Unison.Doc (Doc) import Unison.Doc (Doc)
import Unison.Dom (Dom) import Unison.Dom (Dom)
import Unison.Dimensions (X(..), Y(..), Width(..), Height(..)) import Unison.Dimensions (X(..), Y(..), Width(..), Height(..), Region)
import Unison.Path (Path) import Unison.Path (Path)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
@ -22,13 +22,8 @@ import qualified Unison.Dom as Dom
import qualified Unison.HTML as HTML import qualified Unison.HTML as HTML
import qualified Unison.UI as UI import qualified Unison.UI as UI
data DocView p = DocView widget :: (Show p, Path p, Eq p, MonadWidget t m)
{ at :: (X,Y) -> [p] => Width -> Doc Text p -> m (El t, Doc.Box () (p, Region), (Width,Height))
, contains :: (X,Y,Width,Height) -> [p]
, intersects :: (X,Y,Width,Height) -> [p]
, region :: [p] -> (X,Y,Width,Height) }
widget :: (Show p, Path p, Eq p, MonadWidget t m) => Width -> Doc Text p -> m (El t, DocView p, (Width,Height))
widget available d = widget available d =
let let
leaf txt = Text.replace " " "&nbsp;" txt leaf txt = Text.replace " " "&nbsp;" txt
@ -41,15 +36,11 @@ widget available d =
-- http://stackoverflow.com/questions/118241/calculate-text-width-with-javascript/21015393#21015393 -- http://stackoverflow.com/questions/118241/calculate-text-width-with-javascript/21015393#21015393
(w,h) <- liftIO $ UI.preferredDimensions (Element.castToElement node) (w,h) <- liftIO $ UI.preferredDimensions (Element.castToElement node)
pure (txt, (w,h)) pure (txt, (w,h))
view box = DocView (Doc.at box)
(Doc.contains box)
(Doc.intersects box)
(Doc.region box)
interpret b = Dom.el "div" [("class","docwidget")] [dom] interpret b = Dom.el "div" [("class","docwidget")] [dom]
where where
dom = fromMaybe (HTML.hbox []) . Doc.einterpret go $ b' dom = fromMaybe (HTML.hbox []) . Doc.einterpret go $ b'
b' = Doc.emap (\(txt, (Width w, Height h)) -> Just $ Dom.el "div" (fixDims w h) [Dom.raw (leaf txt)]) b' = Doc.emap (\(txt, (Width w, Height h)) -> Just $ Dom.el "div" (fixDims w h) [Dom.raw (leaf txt)])
b -- (Doc.rewrite collapse b) b
fixDims w h = [( "style","width:" <> (Text.pack . show $ w) <> "px;height:" <> fixDims w h = [( "style","width:" <> (Text.pack . show $ w) <> "px;height:" <>
(Text.pack . show $ h) <> "px;")] (Text.pack . show $ h) <> "px;")]
go b = case b of go b = case b of
@ -66,7 +57,7 @@ widget available d =
let (_, (_,_,w,h)) = Doc.root b let (_, (_,_,w,h)) = Doc.root b
node <- runDom $ interpret (Doc.flatten b) node <- runDom $ interpret (Doc.flatten b)
e <- el "div" $ unsafePlaceElement (Dom.unsafeAsHTMLElement node) e <- el "div" $ unsafePlaceElement (Dom.unsafeAsHTMLElement node)
pure $ (e, view b, (w,h)) pure $ (e, Doc.emap (const ()) b, (w,h))
selectionLayer :: MonadWidget t m => Height -> (X,Y,Width,Height) -> m () selectionLayer :: MonadWidget t m => Height -> (X,Y,Width,Height) -> m ()
selectionLayer (Height h0) (X x, Y y, Width w, Height h) = selectionLayer (Height h0) (X x, Y y, Width w, Height h) =