mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-15 14:35:01 +03:00
term rendering with dynamic reflow seems to be working
This commit is contained in:
parent
e3d1e9424a
commit
bae33579c2
@ -1,5 +1,9 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
|
import Array
|
||||||
|
import Set
|
||||||
|
import Unison.Path (Path)
|
||||||
|
import Unison.Hash (Hash)
|
||||||
import Unison.Styles as S
|
import Unison.Styles as S
|
||||||
import Unison.Layout as UL
|
import Unison.Layout as UL
|
||||||
import Unison.Term as L
|
import Unison.Term as L
|
||||||
@ -11,46 +15,25 @@ import Graphics.Input(..)
|
|||||||
import Graphics.Input.Field(..)
|
import Graphics.Input.Field(..)
|
||||||
import Window
|
import Window
|
||||||
|
|
||||||
-- each cell will consist of a single Element
|
entry : Input (Maybe (Hash,Path))
|
||||||
-- 'standard' input boxes not really
|
entry = input Nothing
|
||||||
-- flexible enough, since depending on
|
|
||||||
-- scope, are overwriting different region of
|
|
||||||
-- syntax tree
|
|
||||||
{-
|
|
||||||
source : Term -> Element
|
|
||||||
|
|
||||||
idea: have just one input box, at the top
|
nums : L.Term
|
||||||
alternately, place input box above selection,
|
nums = let f x = L.Lit (L.Number (toFloat x))
|
||||||
with a caret pointing down
|
in L.Lit (L.Vector (Array.fromList (map f [0..20])))
|
||||||
|
|
||||||
f x = [x + 1 + 2 + 3]
|
expr = L.App (L.App (L.Ref "foo") nums) (L.Ref "baz")
|
||||||
-------------------
|
|
||||||
| |
|
|
||||||
- ----------------
|
|
||||||
\/
|
|
||||||
f x = [x + 1 + 2 + 3]
|
|
||||||
need to create an input box
|
|
||||||
-}
|
|
||||||
|
|
||||||
entry : Input Content
|
scene : Int -> (Maybe (Hash,Path)) -> Element
|
||||||
entry = input noContent
|
scene w p =
|
||||||
|
flow down
|
||||||
midnightBlue = rgb 44 62 80
|
[ S.codeText ("path: " ++ show p)
|
||||||
turquoise = rgb 26 188 156
|
, L.render expr
|
||||||
greenSea = rgb 22 160 133
|
{ handle = entry.handle
|
||||||
|
, key = "bar"
|
||||||
fieldStyle =
|
, highlighted = []
|
||||||
{ padding = { left=8, right=8, top=11, bottom=12 }
|
, availableWidth = w
|
||||||
, outline = { color=midnightBlue, width=uniformly 3, radius=0 }
|
, metadata h = MD.anonymousTerm } ]
|
||||||
, highlight = noHighlight
|
|
||||||
, style = let t = Text.defaultStyle
|
|
||||||
in { t | typeface <- ["Lato", "latin"], height <- Just 16 } }
|
|
||||||
|
|
||||||
fld = field fieldStyle
|
|
||||||
|
|
||||||
main : Signal Element
|
main : Signal Element
|
||||||
main =
|
main = scene <~ Window.width ~ entry.signal
|
||||||
let scene (w,h) content = container w h middle (f content)
|
|
||||||
f content = width 100 (fld entry.handle id "" content)
|
|
||||||
in scene <~ Window.dimensions ~ entry.signal
|
|
||||||
|
|
||||||
|
@ -23,6 +23,9 @@ type Metadata = {
|
|||||||
annotation : H.Hash
|
annotation : H.Hash
|
||||||
}
|
}
|
||||||
|
|
||||||
|
anonymousTerm : Metadata
|
||||||
|
anonymousTerm = Metadata Term [] M.empty Nothing "unknown"
|
||||||
|
|
||||||
firstSymbol : String -> Metadata -> Symbol
|
firstSymbol : String -> Metadata -> Symbol
|
||||||
firstSymbol defaultName md = case md.names of
|
firstSymbol defaultName md = case md.names of
|
||||||
[] -> { name = defaultName, fixity = Prefix, precedence = 9 }
|
[] -> { name = defaultName, fixity = Prefix, precedence = 9 }
|
||||||
|
@ -32,27 +32,41 @@ outline2 : Color -> Element -> Element
|
|||||||
outline2 c e =
|
outline2 c e =
|
||||||
container (widthOf e + 6) (heightOf e + 6) (topLeftAt (absolute 3) (absolute 3)) e |> color c
|
container (widthOf e + 6) (heightOf e + 6) (topLeftAt (absolute 3) (absolute 3)) e |> color c
|
||||||
|
|
||||||
cell : String -> Element
|
pad : Int -> Int -> Element -> Element
|
||||||
cell x = codeText (" " ++ x ++ " ") |> color clouds
|
pad hpad vpad e =
|
||||||
|
container (widthOf e + hpad*2) (heightOf e + vpad*2) (topLeftAt (absolute hpad) (absolute vpad)) e
|
||||||
|
|
||||||
|
-- vertically center each cell in the row
|
||||||
|
row : [Element] -> [Element]
|
||||||
|
row es = case es of
|
||||||
|
[] -> [empty]
|
||||||
|
_ -> let maxh = maximum (map heightOf es)
|
||||||
|
cell e = if heightOf e == maxh then e else container (widthOf e) maxh middle e
|
||||||
|
in map cell es
|
||||||
|
|
||||||
|
cell : Element -> Element
|
||||||
|
cell = pad 10 2
|
||||||
|
|
||||||
cells : Element -> [Element] -> Element
|
cells : Element -> [Element] -> Element
|
||||||
cells ifEmpty xs =
|
cells ifEmpty xs =
|
||||||
let space = cell " "
|
let space = cell (codeText " ")
|
||||||
in if isEmpty xs
|
in if isEmpty xs
|
||||||
then ifEmpty
|
then ifEmpty
|
||||||
else intersperse (spacer 1 (heightOf space) |> color silver) xs
|
else intersperse (spacer 1 (heightOf space) |> color silver) (map cell (row xs))
|
||||||
|> flow right
|
|> flow right
|
||||||
|> outline2 silver
|
|> fill white
|
||||||
|
|> outline silver
|
||||||
|
|
||||||
verticalCells : Element -> [Element] -> Element
|
verticalCells : Element -> [Element] -> Element
|
||||||
verticalCells ifEmpty xs =
|
verticalCells ifEmpty xs =
|
||||||
if isEmpty xs
|
if isEmpty xs
|
||||||
then ifEmpty
|
then ifEmpty
|
||||||
else let maxw = maximum (map widthOf xs) + 1
|
else let cells = map cell xs
|
||||||
in intersperse (spacer maxw 1 |> color silver) xs
|
maxw = maximum (map widthOf cells) + 1
|
||||||
|
in intersperse (spacer maxw 1 |> color silver) (map cell xs)
|
||||||
|> flow down
|
|> flow down
|
||||||
|> fill clouds
|
|> fill white
|
||||||
|> outline2 silver
|
|> outline silver
|
||||||
|
|
||||||
-- http://flatuicolors.com/
|
-- http://flatuicolors.com/
|
||||||
turquoise = rgb 26 188 156
|
turquoise = rgb 26 188 156
|
||||||
|
@ -7,6 +7,7 @@ import Dict (Dict)
|
|||||||
import Json
|
import Json
|
||||||
import Set
|
import Set
|
||||||
import Set (Set)
|
import Set (Set)
|
||||||
|
import String
|
||||||
import Graphics.Element as Element
|
import Graphics.Element as Element
|
||||||
import Graphics.Input (Handle, hoverable)
|
import Graphics.Input (Handle, hoverable)
|
||||||
import Text(..)
|
import Text(..)
|
||||||
@ -27,7 +28,7 @@ import Unison.Type as T
|
|||||||
|
|
||||||
data Literal
|
data Literal
|
||||||
= Number Float
|
= Number Float
|
||||||
| String String
|
| Str String
|
||||||
| Vector (Array Term)
|
| Vector (Array Term)
|
||||||
|
|
||||||
data Term
|
data Term
|
||||||
@ -42,26 +43,28 @@ data Term
|
|||||||
render : Term -- term to render
|
render : Term -- term to render
|
||||||
-> { handle : Handle (Maybe (Hash, Path))
|
-> { handle : Handle (Maybe (Hash, Path))
|
||||||
, key : Hash
|
, key : Hash
|
||||||
, highlighted : Set Path
|
, highlighted : [Path]
|
||||||
, availableWidth : Int
|
, availableWidth : Int
|
||||||
, metadata : Hash -> Metadata }
|
, metadata : Hash -> Metadata }
|
||||||
-> Element
|
-> Element
|
||||||
render expr env =
|
render expr env =
|
||||||
let
|
let
|
||||||
md = env.metadata env.key
|
md = env.metadata env.key
|
||||||
|
msg path b = if b then Just (env.key, path) else Nothing
|
||||||
|
|
||||||
go : Bool -> Int -> Int -> { path : Path, term : Term } -> Element
|
go : Bool -> Int -> Int -> { path : Path, term : Term } -> Element
|
||||||
go allowBreak ambientPrec availableWidth cur =
|
go allowBreak ambientPrec availableWidth cur =
|
||||||
case cur.term of
|
case cur.term of
|
||||||
Var n -> hoverable env.handle (msg cur.path) (codeText (Metadata.resolveLocal md cur.path n).name)
|
Var n -> hoverable env.handle (msg cur.path) (codeText (Metadata.resolveLocal md cur.path n).name)
|
||||||
Ref h -> hoverable env.handle (msg cur.path) (codeText (Metadata.firstName h (env.metadata h)))
|
Ref h -> hoverable env.handle (msg cur.path) (codeText (Metadata.firstName h (env.metadata h)))
|
||||||
Con h -> hoverable env.handle (msg cur.path) (codeText (Metadata.firstName h (env.metadata h)))
|
Con h -> hoverable env.handle (msg cur.path) (codeText (Metadata.firstName h (env.metadata h)))
|
||||||
Lit (Number n) -> hoverable env.handle (msg cur.path) (codeText (show n))
|
Lit (Number n) -> hoverable env.handle (msg cur.path) (codeText (String.show n))
|
||||||
Lit (String s) -> hoverable env.handle (msg cur.path) (codeText s)
|
Lit (Str s) -> hoverable env.handle (msg cur.path) (codeText s)
|
||||||
_ -> case break env.key env.metadata cur.path cur.term of
|
_ -> case break env.key env.metadata cur.path cur.term of
|
||||||
Prefix f args ->
|
Prefix f args ->
|
||||||
let f' = go False 9 availableWidth f
|
let f' = go False 9 availableWidth f
|
||||||
lines = f' :: map (go False 10 0) args
|
lines = f' :: map (go False 10 0) args
|
||||||
unbroken = paren (ambientPrec > 9) cur.path (flow right (intersperse space lines))
|
unbroken = paren (ambientPrec > 9) cur.path (flow right (intersperse space lines |> Styles.row))
|
||||||
in if not allowBreak || widthOf unbroken < availableWidth
|
in if not allowBreak || widthOf unbroken < availableWidth
|
||||||
then unbroken
|
then unbroken
|
||||||
else let args' = map (go True 10 (availableWidth - indentWidth)) args |> flow down
|
else let args' = map (go True 10 (availableWidth - indentWidth)) args |> flow down
|
||||||
@ -97,8 +100,6 @@ render expr env =
|
|||||||
else flow down [argLayout, space2 `beside` go True 0 (availableWidth - indentWidth) body]
|
else flow down [argLayout, space2 `beside` go True 0 (availableWidth - indentWidth) body]
|
||||||
|> paren (ambientPrec > 0) cur.path
|
|> paren (ambientPrec > 0) cur.path
|
||||||
|
|
||||||
msg path b = if b then Just (env.key, path) else Nothing
|
|
||||||
|
|
||||||
paren : Bool -> Path -> Element -> Element
|
paren : Bool -> Path -> Element -> Element
|
||||||
paren parenthesize path e =
|
paren parenthesize path e =
|
||||||
if parenthesize
|
if parenthesize
|
||||||
@ -170,18 +171,15 @@ break hash md path expr =
|
|||||||
_ -> Lambda [{path = path, term = expr }] { path = path `push` Body, term = body }
|
_ -> Lambda [{path = path, term = expr }] { path = path `push` Body, term = body }
|
||||||
_ -> prefix expr [] path
|
_ -> prefix expr [] path
|
||||||
|
|
||||||
todo : a
|
|
||||||
todo = todo
|
|
||||||
|
|
||||||
parseLiteral : Parser Literal
|
parseLiteral : Parser Literal
|
||||||
parseLiteral = P.union' <| \t ->
|
parseLiteral = P.union' <| \t ->
|
||||||
if | t == "Number" -> P.map Number P.number
|
if | t == "Number" -> P.map Number P.number
|
||||||
| t == "String" -> P.map String P.string
|
| t == "String" -> P.map Str P.string
|
||||||
| t == "Vector" -> P.map (Vector . Array.fromList) (P.array parseTerm)
|
| t == "Vector" -> P.map (Vector . Array.fromList) (P.array parseTerm)
|
||||||
|
|
||||||
jsonifyLiteral l = case l of
|
jsonifyLiteral l = case l of
|
||||||
Number n -> J.tag' "Number" J.number n
|
Number n -> J.tag' "Number" J.number n
|
||||||
String s -> J.tag' "String" J.string s
|
Str s -> J.tag' "String" J.string s
|
||||||
Vector es -> J.tag' "Vector" (J.contramap Array.toList (J.array jsonifyTerm)) es
|
Vector es -> J.tag' "Vector" (J.contramap Array.toList (J.array jsonifyTerm)) es
|
||||||
|
|
||||||
parseTerm : Parser Term
|
parseTerm : Parser Term
|
||||||
|
Loading…
Reference in New Issue
Block a user