mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-27 02:07:14 +03:00
Factored out non-explorer stuff into Unison.Panel
This commit is contained in:
parent
38d8812c60
commit
8e1b0d5fa4
@ -1,49 +1,25 @@
|
||||
module Unison.Editor (Model) where
|
||||
|
||||
import Dict
|
||||
import Dict (Dict)
|
||||
import Elmz.Layout (Containment,Layout,Pt,Region)
|
||||
import Elmz.Layout as Layout
|
||||
import Elmz.Selection1D as Selection1D
|
||||
import Elmz.Trie (Trie)
|
||||
import Elmz.Trie as Trie
|
||||
import Graphics.Input.Field as Field
|
||||
import Graphics.Element as Element
|
||||
import Graphics.Element (Element)
|
||||
import Result
|
||||
import Graphics.Element as Element
|
||||
import Graphics.Input.Field as Field
|
||||
import List
|
||||
import Elmz.Selection1D as Selection1D
|
||||
import Elmz.Layout as Layout
|
||||
import Elmz.Layout (Containment, Layout, Pt)
|
||||
import Unison.Explorer as Explorer
|
||||
import Unison.Hash (Hash)
|
||||
import Unison.Metadata as Metadata
|
||||
import Unison.Path (Path)
|
||||
import Unison.Path as Path
|
||||
import Unison.Scope (Scope)
|
||||
import Unison.Scope as Scope
|
||||
import Unison.Styles as Styles
|
||||
import Unison.Panel as Panel
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term as Term
|
||||
import Unison.Styles as Styles
|
||||
import Unison.View as View
|
||||
import Signal
|
||||
|
||||
type alias Model =
|
||||
{ overall : Term
|
||||
, scope : Maybe Scope
|
||||
{ panel : Panel.Model
|
||||
, explorer : Explorer.Model
|
||||
, explorerValues : List Term
|
||||
, explorerSelection : Selection1D.Model
|
||||
, dependents : Trie Path.E (List Path)
|
||||
, overrides : Trie Path.E (Layout View.L)
|
||||
, hashes : Trie Path.E Hash }
|
||||
|
||||
type alias Action = Model -> Model
|
||||
|
||||
|
||||
|
||||
viewTerm : Int -> Term -> Layout View.L
|
||||
viewTerm availableWidth term =
|
||||
View.layout term { rootMetadata = Metadata.anonymousTerm
|
||||
, availableWidth = availableWidth
|
||||
, metadata h = Metadata.anonymousTerm
|
||||
, overrides x = Nothing }
|
||||
, explorerSelection : Selection1D.Model }
|
||||
|
||||
type alias Sink a = a -> Signal.Message
|
||||
|
||||
@ -52,27 +28,17 @@ type alias Context =
|
||||
, searchbox : Sink Field.Content
|
||||
, explorerActive : Sink Bool }
|
||||
|
||||
-- view : Context ->
|
||||
-- clicks : Signal () -> Signal (Int,Int) -> Signal Action
|
||||
-- clicks click pos =
|
||||
-- let f click xy pos
|
||||
|
||||
view : Context -> Model -> (Layout View.L, Layout (Result Containment Int))
|
||||
view ctx model =
|
||||
let termLayout = viewTerm ctx.availableWidth model.overall
|
||||
|
||||
highlighted : Maybe Region
|
||||
highlighted = case model.scope of
|
||||
Nothing -> Nothing
|
||||
Just scope -> Layout.region Path.startsWith .path termLayout scope.focus
|
||||
|> Layout.selectableLub .selectable
|
||||
|
||||
highlightLayer : Element
|
||||
highlightLayer = case highlighted of
|
||||
Nothing -> Element.empty
|
||||
Just region -> Styles.selection region
|
||||
|
||||
highlightedTermLayout : Layout View.L
|
||||
highlightedTermLayout =
|
||||
Layout.transform (\e -> Element.layers [e, highlightLayer]) termLayout
|
||||
let (panelLayout, selected) = Panel.view ctx.availableWidth model.panel
|
||||
|
||||
explorerTopLeft : Pt
|
||||
explorerTopLeft = case highlighted of
|
||||
explorerTopLeft = case selected of
|
||||
Nothing -> Pt 0 0
|
||||
Just region -> { x = region.topLeft.x, y = region.topLeft.y + region.height }
|
||||
|
||||
@ -91,7 +57,7 @@ view ctx model =
|
||||
highlightedExplorerLayout =
|
||||
Layout.transform (\e -> Element.layers [e, explorerHighlight]) explorerLayout
|
||||
|
||||
in (highlightedTermLayout, highlightedExplorerLayout)
|
||||
in (panelLayout, highlightedExplorerLayout)
|
||||
--
|
||||
-- viewExplorer : Model -> Layout
|
||||
-- view : Int -> Term -> Layout View.L
|
||||
|
@ -14,27 +14,30 @@ import Unison.Path as Path
|
||||
import Unison.Styles as Styles
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term as Term
|
||||
import Unison.View as View
|
||||
|
||||
type alias E = Path.E
|
||||
type alias Path = Path.Path
|
||||
|
||||
type alias Scope = { focus : Path, ups : List Path, downs : List Path }
|
||||
type alias Model = Maybe Scope
|
||||
|
||||
type alias Action = Scope -> Scope
|
||||
type alias Action = Model -> Model
|
||||
|
||||
scope : Path -> Scope
|
||||
scope focus = Scope focus [] []
|
||||
|
||||
view : Term -> (Path -> Maybe Region) -> Scope -> Element
|
||||
view e region scope = case region scope.focus of
|
||||
Nothing -> Element.empty
|
||||
Just r ->
|
||||
let bounds = Layout.bounds r
|
||||
in Element.container bounds.width
|
||||
bounds.height
|
||||
(Element.topLeftAt (Element.absolute (r.topLeft.x))
|
||||
(Element.absolute (r.topLeft.y)))
|
||||
(Styles.highlight r.width r.height)
|
||||
view : { tl | term : Term, layout : Layout View.L } -> Scope -> (Layout View.L, Maybe Region)
|
||||
view ctx scope =
|
||||
let highlighted : Maybe Region
|
||||
highlighted = Layout.region Path.startsWith .path ctx.layout scope.focus
|
||||
|> Layout.selectableLub .selectable
|
||||
in case highlighted of
|
||||
Nothing -> (ctx.layout, highlighted)
|
||||
Just region ->
|
||||
let l = Layout.transform (\e -> Element.layers [e, Styles.selection region])
|
||||
ctx.layout
|
||||
in (l, highlighted)
|
||||
|
||||
actions : Signal Term
|
||||
-> Signal (Layout { a | path : Path })
|
||||
@ -51,8 +54,8 @@ resets mouse layout =
|
||||
let go (x,y) layout =
|
||||
let paths = Layout.atRanked (List.length << .path) layout (Region { x = x, y = y } 2 2)
|
||||
in case paths of
|
||||
(h :: _) :: _ -> always (scope h.path)
|
||||
_ -> identity
|
||||
(h :: _) :: _ -> always (Just (scope h.path))
|
||||
_ -> always Nothing
|
||||
in Signal.sampleOn mouse (Signal.map2 go mouse layout)
|
||||
|
||||
movements : Signal Term -> Signal Movement.D2 -> Signal Action
|
||||
@ -65,27 +68,39 @@ movements e d2s =
|
||||
in Signal.sampleOn d2s (Signal.map2 go e d2s)
|
||||
|
||||
up : Action
|
||||
up {focus,ups,downs} = case ups of
|
||||
h :: ups -> Scope h ups (focus :: downs)
|
||||
[] -> let f = Term.up focus
|
||||
in if f == focus then Scope focus ups downs
|
||||
else Scope f [] (focus :: downs)
|
||||
up m = case m of
|
||||
Nothing -> Nothing
|
||||
Just {focus,ups,downs} -> Just (case ups of
|
||||
h :: ups -> Scope h ups (focus :: downs)
|
||||
[] -> let f = Term.up focus
|
||||
in if f == focus then Scope focus ups downs
|
||||
else Scope f [] (focus :: downs)
|
||||
)
|
||||
|
||||
down : Term -> Action
|
||||
down e {focus,ups,downs} = case downs of
|
||||
h :: downs -> Scope h (focus :: ups) downs
|
||||
[] -> let f = Term.down e focus
|
||||
in if f == focus then Scope focus ups downs
|
||||
else Scope f (focus :: ups) []
|
||||
down e m = case m of
|
||||
Nothing -> Nothing
|
||||
Just {focus,ups,downs} -> Just (case downs of
|
||||
h :: downs -> Scope h (focus :: ups) downs
|
||||
[] -> let f = Term.down e focus
|
||||
in if f == focus then Scope focus ups downs
|
||||
else Scope f (focus :: ups) []
|
||||
)
|
||||
|
||||
left : Term -> Action
|
||||
left e {focus,ups,downs} =
|
||||
let p = Term.siblingL e focus
|
||||
in if p == focus then Scope focus ups downs
|
||||
else Scope p [] []
|
||||
left e m = case m of
|
||||
Nothing -> Nothing
|
||||
Just {focus,ups,downs} -> Just (
|
||||
let p = Term.siblingL e focus
|
||||
in if p == focus then Scope focus ups downs
|
||||
else Scope p [] []
|
||||
)
|
||||
|
||||
right : Term -> Action
|
||||
right e {focus,ups,downs} =
|
||||
let p = Term.siblingR e focus
|
||||
in if p == focus then Scope focus ups downs
|
||||
else Scope p [] []
|
||||
right e m = case m of
|
||||
Nothing -> Nothing
|
||||
Just {focus,ups,downs} -> Just (
|
||||
let p = Term.siblingR e focus
|
||||
in if p == focus then Scope focus ups downs
|
||||
else Scope p [] []
|
||||
)
|
||||
|
37
editor/Unison/Terms.elm
Normal file
37
editor/Unison/Terms.elm
Normal file
@ -0,0 +1,37 @@
|
||||
module Unison.Terms where
|
||||
|
||||
import Unison.Term as E
|
||||
|
||||
-- helper functions for building terms
|
||||
|
||||
ap = E.App
|
||||
builtin s = E.Ref (R.Builtin s)
|
||||
derived s = E.Ref (R.Derived s)
|
||||
int n = E.Lit (E.Number (toFloat n))
|
||||
vec es = E.Vector (Array.fromList es)
|
||||
|
||||
nums : E.Term
|
||||
nums = vec (List.map int [0..20])
|
||||
|
||||
rgbTerm : Int -> Int -> Int -> E.Term
|
||||
rgbTerm r g b =
|
||||
builtin "Color.rgba" `ap` int r `ap` int g `ap` int b `ap` int 1
|
||||
|
||||
-- expr = E.App (E.App (E.Ref "foo") nums) (E.App (E.Ref "baz") (E.Builtin "View.cell" `ap` E.Builtin "View.swatch" `ap` rgbTerm 230 126 34))
|
||||
expr0 = derived "foo" `ap` nums `ap` (derived "baz" `ap` rgbTerm 230 126 34)
|
||||
expr = derived "foo" `ap` nums `ap` (derived "baz" `ap` (builtin "View.cell" `ap` builtin "View.swatch" `ap` rgbTerm 230 126 34))
|
||||
-- this bombs
|
||||
-- expr = E.Ref "uno" `ap` E.Ref "dos" `ap` E.Ref "tres" `ap` E.Ref "quatro" `ap` E.Ref "cinco" `ap` E.Ref "seis" `ap` E.Ref "siete" `ap` E.Ref "ocho"
|
||||
-- expr = E.App (E.App (E.Ref "foo") nums) (E.App (E.Ref "baz") (rgbTerm 230 126 34))
|
||||
|
||||
cell f x = builtin "View.cell" `ap` f `ap` x
|
||||
panel v e = builtin "View.panel" `ap` v `ap` e
|
||||
function1 f = builtin "View.function1" `ap` f
|
||||
source e = builtin "View.source" `ap` e
|
||||
verticalPanel es = panel (builtin "View.vertical") (vec es)
|
||||
string s = E.Lit (E.Str s)
|
||||
text s = builtin "View.text" `ap` s
|
||||
centered s = builtin "View.textbox" `ap` builtin "Text.center" `ap` full `ap` s
|
||||
h1 s = cell (text E.Blank) (E.Lit (E.Str s))
|
||||
body s = cell (text E.Blank) (E.Lit (E.Str s))
|
||||
full = E.Lit (E.Distance (Distance.Fraction 1.0))
|
Loading…
Reference in New Issue
Block a user