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