Commit eb33419f authored by Michael Hanus 's avatar Michael Hanus
Browse files

tools and libs updated

parent 2abfcf85
Subproject commit dc2f77c2993d7aad247fe2e51ff28ea757e1f356
Subproject commit 4f1ae1cfea09ec7875dbcb6dec781f02f1cc4cbe
Subproject commit 30f377a15d45a86c02203933662ca86300707a5e
Subproject commit 79e5be7bc6e4f02d8036bdf9cc68bc3ba25d452b
This diff is collapsed.
This diff is collapsed.
......@@ -17,6 +17,7 @@ data Json
| Int Int
| Bool Bool
| Null
deriving Show
--- Universal transformation for JSON values.
trJson :: ([(String, a)] -> a)
......@@ -70,7 +71,7 @@ readJson s | null sols = failed
spaceP :: Parser Char String
spaceP s = [span isSpace s]
listP :: Parser Char a -> Parser Char [a]
listP :: Show a => Parser Char a -> Parser Char [a]
listP p s
= case (p <.> spaceP) s of
[] -> [([],s)]
......
......@@ -4,9 +4,10 @@
CURRYEXEC=`pwd`/../../bin/curry
UILIBS = GUI.curry GUI2HTML.curry HTML.curry \
TypedUI2GUI.curry TypedUI2HTML.curry \
UI.curry UI2GUI.curry UI2HTML.curry \
Json.curry Parse.curry SpicyWeb.curry
# omitted since they require addition of type contexts:
#TypedUI2GUI.curry TypedUI2HTML.curry
LIB_PL = `echo $(UILIBS:%.curry=.curry/pakcs/%.pl)`
......
......@@ -41,7 +41,7 @@ satisfy _ [] = []
satisfy p (t:ts) = if p t then [(t,ts)] else []
--- A parser recognizing a particular terminal symbol.
terminal :: t -> Parser t t
terminal :: Eq t => t -> Parser t t
terminal s = satisfy (s==)
--- A star combinator for parsers. The returned parser
......
......@@ -52,6 +52,7 @@ data Command act1 act2
--- The data type of references to widgets in a UI window.
data Ref r = Ref r
deriving Eq
data Handler act1 act2
= Handler Event (Command act1 act2)
......@@ -103,7 +104,7 @@ defaultHandler cmd = Handler DefaultEvent (Cmd cmd)
-------------------------------------------------------------------------------
addStyle :: Widget r a1 a2 -> StyleClass -> Widget r a1 a2
addStyle widget class = addStyles widget [class]
addStyle widget cls = addStyles widget [cls]
addStyles :: Widget r a1 a2 -> [StyleClass] -> Widget r a1 a2
addStyles (Widget str mblabel mbref handlers styleClasses ws) classes
......@@ -149,8 +150,13 @@ data CanvasItem =
-------------------------------------------------------------------------------
data StyleClass = Class [Style]
deriving Show
data Position = Center | Left | Right | Top | Bottom
deriving Show
data Direction = X | Y | Both
deriving Show
--- The data type of possible styles.
data Style =
......@@ -167,16 +173,21 @@ data Style =
| Border BorderStyle
| Display Bool
| NameValue String String
deriving Show
data BorderStyle = Dotted | Dashed | Solid
deriving Show
data FontStyle = Bold | Italic | Underline
deriving Show
--- The data type of possible colors.
data Color
= Black | Blue | Brown | Cyan | Gold | Gray | Green
| Magenta | Navy | Orange | Pink | Purple | Red
| Tomato| Turquoise | Violet | White | Yellow | Default
deriving Show
-------------------------------------------------------------------------------
......
......@@ -133,8 +133,8 @@ widgetUI2GUI (UI.Widget name mblabel mbref handlers styleclasses widgets) =
UI.Scale min max -> GUI.Scale min max confitems
UI.TextEdit rows cols ->
GUI.TextEdit ([GUI.Height rows, GUI.Width cols] ++ confitems)
x -> GUI.Label
[GUI.Text (show x ++ " not implemented in UI2GUI.widgetUI2GUI")]
_ -> GUI.Label
[GUI.Text "Specific UIWidget not implemented in UI2GUI.widgetUI2GUI"]
where
collconfs = classes2guicollconfs styleclasses
......@@ -188,8 +188,9 @@ runUI title widget =
GUI.runInitGUI title (widgetUI2GUI widget) initcmd
where
d = getdisplayconf widget
initcmd gp =
initcmd gp = do
mapIO_ (\ (ref,confitem) -> GUI.setConfig ref confitem gp) d
return []
------------------------------------------------------------------------------
......
......@@ -100,7 +100,7 @@ data Reconfigure
| Style [StyleClass]
| Pos (Int,Int)
| ErrorBg Bool
deriving Show
conf2str :: Reconfigure -> (String,Json)
conf2str val = case val of
......@@ -650,14 +650,14 @@ seeText cref (line,column) env = do
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
findValue :: a -> ([(a,Maybe b,_)],_) -> Maybe b
findValue :: Eq a => a -> ([(a,Maybe b,_)],_) -> Maybe b
findValue _ ([],_) = Nothing
findValue ref ((r,mbval,_):xs,ps) =
if (ref == r)
then mbval
else findValue ref (xs,ps)
changeValue :: ([(a,Maybe b,[c])],d) -> a -> b -> ([(a,Maybe b,[c])],d)
changeValue :: Eq a => ([(a,Maybe b,[c])],d) -> a -> b -> ([(a,Maybe b,[c])],d)
changeValue (xs,ps) ref nvalue = (change xs,ps)
where
change [] = [(ref,Just nvalue,[])]
......@@ -666,8 +666,8 @@ changeValue (xs,ps) ref nvalue = (change xs,ps)
then ((r,Just nvalue,confs):xs1)
else ((r,mbval,confs):change xs1)
changeConfig :: ([(a,Maybe b,[Reconfigure])],c) -> a -> Reconfigure ->
([(a,Maybe b,[Reconfigure])],c)
changeConfig :: Eq a => ([(a,Maybe b,[Reconfigure])],c) -> a -> Reconfigure
-> ([(a,Maybe b,[Reconfigure])],c)
changeConfig (xs,ps) ref nconf = (change xs,ps)
where
change [] = [(ref,Nothing,[nconf])]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment