term rendering with dynamic reflow seems to be working

This commit is contained in:
Paul Chiusano 2014-09-02 11:22:43 -04:00
parent e3d1e9424a
commit bae33579c2
4 changed files with 57 additions and 59 deletions

View File

@ -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

View File

@ -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 }

View File

@ -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

View File

@ -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