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