unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-11-13 22:29:35 +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
text "region: "
display region
(e,d,(w,h)) <- DocView.widget (Width 200) termDoc
mouse <- mouseMove' e >>= holdDyn (X 0, Y 0)
path <- mapDyn (concat . DocView.at d) mouse
region <- mapDyn (\p -> DocView.region d [p]) path
sel <- mapDyn (DocView.selectionLayer h) region
_ <- widgetHold (pure ()) (Dynamic.updated sel)
(body, (mouse,path,region)) <- el' "div" $ do
(e,d,(w,h)) <- DocView.widget (Width 200) termDoc
mouse <- mouseMove' e >>= holdDyn (X 0, Y 0)
path <- mapDyn (Doc.at d) mouse
region <- mapDyn (Doc.region d) path
sel <- mapDyn (DocView.selectionLayer h) region
_ <- widgetHold (pure ()) (Dynamic.updated sel)
return (mouse, path, region)
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 Unison.Doc (Doc)
import Unison.Dom (Dom)
import Unison.Dimensions (X(..), Y(..), Width(..), Height(..))
import Unison.Dimensions (X(..), Y(..), Width(..), Height(..), Region)
import Unison.Path (Path)
import qualified Data.Map as Map
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.UI as UI
data DocView p = DocView
{ at :: (X,Y) -> [p]
, 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 :: (Show p, Path p, Eq p, MonadWidget t m)
=> Width -> Doc Text p -> m (El t, Doc.Box () (p, Region), (Width,Height))
widget available d =
let
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
(w,h) <- liftIO $ UI.preferredDimensions (Element.castToElement node)
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]
where
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.rewrite collapse b)
b
fixDims w h = [( "style","width:" <> (Text.pack . show $ w) <> "px;height:" <>
(Text.pack . show $ h) <> "px;")]
go b = case b of
@ -66,7 +57,7 @@ widget available d =
let (_, (_,_,w,h)) = Doc.root b
node <- runDom $ interpret (Doc.flatten b)
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 (Height h0) (X x, Y y, Width w, Height h) =