diff --git a/LICENSE b/LICENSE
index af4f4a8a5d2c902ed3c5bace0dd6fc40083a6dd2..9890b4e2019cb724826f5ac431871cc76877f1f8 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2017, Michael Hanus
+Copyright (c) 2020, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
diff --git a/examples/calc.curry b/examples/calc.curry
index abcb3b0391056e803a5b96034d29c16389991c10..ee22d4e6be53e7475c7038535cfddd9d6a51e3c6 100644
--- a/examples/calc.curry
+++ b/examples/calc.curry
@@ -1,8 +1,8 @@
-- A simple desk calculator GUI where the local state is stored in an IORef.
-import GUI
-import Char
-import IOExts -- use IORefs for the GUI state
+import Data.Char
+import Data.IORef -- use IORefs for the GUI state
+import Graphics.UI
-- the GUI needs a reference to the calculator state
calcGUI :: IORef (Int,Int->Int) -> Widget
@@ -35,6 +35,7 @@ processButton b (d,f)
| b=='=' = (f d, id)
| b=='C' = (0, id)
+main :: IO ()
main = do
stateref <- newIORef (0,id)
runGUI "Calculator" (calcGUI stateref)
diff --git a/examples/counter.curry b/examples/counter.curry
index 09ca5d4dd3fc6692d8738d20e6fb13434590c785..fd4e6f4dddfeb3924f92b257a81e9e42707ffecd 100644
--- a/examples/counter.curry
+++ b/examples/counter.curry
@@ -2,9 +2,9 @@
-- A simple counter demo for the GUI library
------------------------------------------------------------------------------
-import GUI
-import Read
+import Graphics.UI
+counterGUI :: Widget
counterGUI =
Col [] [
Label [Text "A simple counter:"],
@@ -14,7 +14,8 @@ counterGUI =
Button exitGUI [Text "Stop"]]]
where val free
- incrText s = show (readInt s + 1)
+ incrText s = show (read s + 1)
+main :: IO ()
main = runGUI "Counter Demo" counterGUI
diff --git a/examples/fractal.curry b/examples/fractal.curry
index 99cd3a7783dd20cce14b1867bbf5152d52679bc6..9ba2d5c3e5bbe83125d04b6b2b3b3e51de831388 100644
--- a/examples/fractal.curry
+++ b/examples/fractal.curry
@@ -3,8 +3,8 @@
-- with a "plotter" object which directly writes to a GUI canvas:
-import GUI
-import IOExts
+import Data.IORef
+import Graphics.UI
---------------------------------------------------------------------
-- An implementation of a plotter.
diff --git a/examples/hello.curry b/examples/hello.curry
index 5c57e73bbe68438f7eb8f3ca7af0187e82d98e48..daf9b7946d827025c55e04db9489565dfee99b47 100644
--- a/examples/hello.curry
+++ b/examples/hello.curry
@@ -1,6 +1,7 @@
-- "Hello World" demo for the GUI library
-import GUI
+import Graphics.UI
+main :: IO ()
main = runGUI "Hello" (Col [] [Label [Text "Hello world!"],
Button exitGUI [Text "Stop"]])
diff --git a/examples/sierpinski.curry b/examples/sierpinski.curry
index f83d7b62a69acb0d8380e9816759df3e5449ca85..5e15702e2619a5ea0a744a163ce6774787d5199a 100644
--- a/examples/sierpinski.curry
+++ b/examples/sierpinski.curry
@@ -1,7 +1,7 @@
-- Drawing Sierpinski curves in a canvas GUI
-import GUI
-import IOExts
+import Data.IORef
+import Graphics.UI
---------------------------------------------------------------------
-- An implementation of a plotter.
@@ -39,11 +39,11 @@ data FigureType stroketype = Figure (FigureType stroketype) stroketype
drawSierpinski p order (Figure f1 s1 f2 s2 f3 s3 f4) =
if order==0
- then done
- else drawSierpinski p (order -1) f1 >> s1 p >>
- drawSierpinski p (order -1) f2 >> s2 p >>
- drawSierpinski p (order -1) f3 >> s3 p >>
- drawSierpinski p (order -1) f4
+ then return ()
+ else drawSierpinski p (order -1) f1 >> s1 p >>
+ drawSierpinski p (order -1) f2 >> s2 p >>
+ drawSierpinski p (order -1) f3 >> s3 p >>
+ drawSierpinski p (order -1) f4
fa = Figure fa rightdown fb right2 fd rightup fa
diff --git a/examples/temperature.curry b/examples/temperature.curry
index 42e6f7fe7bf9235b706e3d2358fa44beab79cbd5..5b0e64198f09baef01385beca70c7dd78eccfd2e 100644
--- a/examples/temperature.curry
+++ b/examples/temperature.curry
@@ -1,10 +1,10 @@
-- temperature converter
-import GUI
-import Read
+import Graphics.UI
-- only a scale for Celsius:
-temp_widget =
+tempWidget :: Widget
+tempWidget =
Col [] [
Label [Text "Temperature in Celsius:"],
Scale 0 100 [WRef cels, Cmd convert],
@@ -18,16 +18,17 @@ temp_widget =
cels,fahr,kelv free
convert wp = do cs <- getValue cels wp
- let c = readInt cs
+ let c = read cs
setValue fahr (show (c * 9 `div` 5 + 32)) wp
setValue kelv (show (c + 273)) wp
-main = runGUI "Temperature Conversion" temp_widget
-
+main :: IO ()
+main = runGUI "Temperature Conversion" tempWidget
-- a scale for Celsius and a scale for Fahrenheit:
-temp_widget2 =
+tempWidget2 :: Widget
+tempWidget2 =
Col [] [
Label [Text "Temperature in Celsius:"],
Scale 0 100 [WRef cels, Cmd convertC],
@@ -43,16 +44,17 @@ temp_widget2 =
cels,fahr,kelv,fscl free
convertC wp = do cs <- getValue cels wp
- let c = readInt cs
+ let c = read cs
setValue fahr (show (c * 9 `div` 5 + 32)) wp
setValue kelv (show (c + 273)) wp
setValue fscl (show (c * 9 `div` 5 + 32)) wp
convertF wp = do fs <- getValue fscl wp
- let c = ((readInt fs)-32) * 5 `div` 9
+ let c = ((read fs)-32) * 5 `div` 9
setValue cels (show c) wp
setValue fahr (show (c * 9 `div` 5 + 32)) wp
setValue kelv (show (c + 273)) wp
-main2 = runGUI "Temperature Conversion" temp_widget2
+main2 :: IO ()
+main2 = runGUI "Temperature Conversion" tempWidget2
diff --git a/package.json b/package.json
index 3046c31afd999b222a3a458851102b1806cf56ac..e131574388c96be872bf3c3c5124993f4366c2dc 100644
--- a/package.json
+++ b/package.json
@@ -1,15 +1,15 @@
{
"name": "gui",
- "version": "2.0.0",
+ "version": "3.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Libraries for programming graphical user interfaces",
"category": [ "User Interface" ],
- "dependencies": { },
- "exportedModules": [ "GUI" ],
- "compilerCompatibility": {
- "pakcs": ">= 2.0.0, < 3.0.0",
- "kics2": ">= 2.0.0, < 3.0.0"
+ "dependencies": {
+ "base" : ">= 3.0.0, < 4.0.0",
+ "io-extra" : ">= 3.0.0, < 4.0.0",
+ "process" : ">= 3.0.0, < 4.0.0"
},
+ "exportedModules": [ "GUI" ],
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"source": {
diff --git a/src/GUI.curry b/src/Graphics/UI.curry
similarity index 96%
rename from src/GUI.curry
rename to src/Graphics/UI.curry
index bc4b01046e363a365394a2a3e5dda553e0f26c9c..55a346491bab6cf0cbaf6b8af99f570b47765dd8 100644
--- a/src/GUI.curry
+++ b/src/Graphics/UI.curry
@@ -5,33 +5,35 @@
--- [in this paper](http://www.informatik.uni-kiel.de/~mh/papers/PADL00.html)
---
--- @authors Michael Hanus, Bernd Brassel
---- @version January 2017
---- @category general
+--- @version November 2020
------------------------------------------------------------------------------
-module GUI(GuiPort,Widget(..),Button,ConfigButton,
- TextEditScroll,ListBoxScroll,CanvasScroll,EntryScroll,
- ConfItem(..),ReconfigureItem(..),
- Cmd,Command,Event(..),ConfCollection(..),MenuItem(..),
- CanvasItem(..),WidgetRef, Style(..), Color(..),
- col,row,matrix,
- runGUI,runGUIwithParams,runInitGUI,runInitGUIwithParams,
- runPassiveGUI,
- runControlledGUI,runConfigControlledGUI,runInitControlledGUI,
- runHandlesControlledGUI,runInitHandlesControlledGUI,
- exitGUI,getValue,setValue,updateValue,appendValue,
- appendStyledValue,addRegionStyle,removeRegionStyle,
- getCursorPosition,seeText,
- focusInput,addCanvas,setConfig,
- getOpenFile,getOpenFileWithTypes,getSaveFile,getSaveFileWithTypes,
- chooseColor,popupMessage,debugTcl) where
-
-import Char (isSpace, toUpper)
-import IO
-import IOExts (connectToCommand)
-import Read
-import System (system)
-import Unsafe (trace)
+module Graphics.UI
+ ( GuiPort, Widget(..), Button, ConfigButton
+ , TextEditScroll, ListBoxScroll, CanvasScroll, EntryScroll
+ , ConfItem(..), ReconfigureItem(..)
+ , Cmd, Command, Event(..), ConfCollection(..), MenuItem(..)
+ , CanvasItem(..), WidgetRef, Style(..), Color(..)
+ , col, row, matrix
+ , runGUI, runGUIwithParams, runInitGUI, runInitGUIwithParams
+ , runPassiveGUI
+ , runControlledGUI, runConfigControlledGUI, runInitControlledGUI
+ , runHandlesControlledGUI, runInitHandlesControlledGUI
+ , exitGUI, getValue, setValue, updateValue, appendValue
+ , appendStyledValue, addRegionStyle, removeRegionStyle
+ , getCursorPosition, seeText
+ , focusInput, addCanvas, setConfig
+ , getOpenFile, getOpenFileWithTypes, getSaveFile, getSaveFileWithTypes
+ , chooseColor, popupMessage, debugTcl
+ ) where
+
+import Control.Monad ( when )
+import Data.Char ( isSpace, toUpper )
+import Debug.Trace ( trace )
+import System.IO
+
+import System.IOExts ( connectToCommand )
+import System.Process ( system )
-- If showTclTkErrors is true, all synchronization errors occuring in the
-- Tcl/Tk communication are shown (such errors should only occur on
@@ -613,11 +615,11 @@ confCollection2tcl (BottomAlign : confs) = "-sticky s " ++ confCollection2tcl co
gridInfo2tcl :: Int -> String -> String -> [ConfItem] -> String
gridInfo2tcl n label "col" confs
| any isFill confs || (any isFillX confs && any isFillY confs)
- = "-sticky nsew \ngrid columnconfigure "++lab++" "++show n++
- " -weight 1\ngrid rowconfigure "++lab++" 1 -weight 1"
- | any isFillX confs = "-sticky we \ngrid columnconfigure "++lab++
- " "++show n++" -weight 1"
- | any isFillY confs = "-sticky ns \ngrid rowconfigure "++lab++
+ = "-sticky nsew \ngrid columnconfigure " ++ lab ++ " " ++ show n ++
+ " -weight 1\ngrid rowconfigure " ++ lab ++ " 1 -weight 1"
+ | any isFillX confs = "-sticky we \ngrid columnconfigure " ++ lab ++
+ " " ++ show n ++ " -weight 1"
+ | any isFillY confs = "-sticky ns \ngrid rowconfigure " ++ lab ++
" 1 -weight 1"
| otherwise = ""
where
@@ -625,12 +627,12 @@ gridInfo2tcl n label "col" confs
gridInfo2tcl n label "row" confs
| any isFill confs || (any isFillX confs && any isFillY confs)
- = "-sticky nsew \ngrid columnconfigure "++lab++
- " 1 -weight 1\ngrid rowconfigure "++lab++" "++show n++" -weight 1"
- | any isFillX confs = "-sticky we \ngrid columnconfigure "++lab++
+ = "-sticky nsew \ngrid columnconfigure " ++ lab ++
+ " 1 -weight 1\ngrid rowconfigure " ++ lab ++ " " ++ show n ++ " -weight 1"
+ | any isFillX confs = "-sticky we \ngrid columnconfigure " ++ lab ++
" 1 -weight 1"
- | any isFillY confs = "-sticky ns \ngrid rowconfigure "++lab++
- " "++show n++" -weight 1"
+ | any isFillY confs = "-sticky ns \ngrid rowconfigure " ++ lab ++
+ " " ++ show n ++ " -weight 1"
| otherwise = ""
where
lab = if label=="" then "." else label
@@ -649,26 +651,28 @@ config2tcl :: String -> String -> ConfItem -> String
config2tcl wtype label (Active active) =
if wtype=="button" || wtype=="checkbutton" || wtype=="entry" ||
wtype=="menubutton" || wtype=="scale" || wtype=="textedit"
- then if active
- then label++" configure -state normal\n"
- else label++" configure -state disabled\n"
- else trace ("WARNING: GUI.Active ignored for widget type \""++wtype++"\"\n") ""
+ then if active
+ then label ++ " configure -state normal\n"
+ else label ++ " configure -state disabled\n"
+ else trace ("WARNING: GUI.Active ignored for widget type \"" ++
+ wtype ++ "\"\n") ""
-- alignment of information inside a widget
-- argument must be: n, ne, e, se, s, sw, w, nw, or center
config2tcl wtype label (Anchor align) =
if wtype=="button" || wtype=="checkbutton" || wtype=="label" ||
wtype=="menubutton" || wtype=="message"
- then label++" configure -anchor "++align++"\n"
- else trace ("WARNING: GUI.Anchor ignored for widget type \""++wtype++"\"\n") ""
+ then label ++ " configure -anchor " ++ align ++ "\n"
+ else trace ("WARNING: GUI.Anchor ignored for widget type \"" ++
+ wtype ++ "\"\n") ""
-- background color:
config2tcl _ label (Background color)
- = label++" configure -background \""++color++"\"\n"
+ = label ++ " configure -background \"" ++ color ++ "\"\n"
-- foreground color:
config2tcl _ label (Foreground color)
- = label++" configure -foreground \""++color++"\"\n"
+ = label ++ " configure -foreground \"" ++ color ++ "\"\n"
-- command associated to various widgets:
config2tcl wtype label (Handler evtype _)
@@ -1172,7 +1176,7 @@ configAndProceedScheduler :: [(String,Event,GuiPort -> IO [ReconfigureItem])]
-> GuiPort -> [ExternalHandler] -> Maybe [ReconfigureItem] -> IO ()
configAndProceedScheduler _ gport _ Nothing = closeGuiPort gport
configAndProceedScheduler evs gport exths (Just configs) = do
- mapIO_ reconfigureGUI configs
+ mapM_ reconfigureGUI configs
scheduleTkEvents (configEventHandlers evs configs) gport
(configStreamHandlers exths configs)
where
@@ -1254,7 +1258,7 @@ getWidgetVarMsg var gport =
receiveFromTk gport >>= \varmsg ->
if takeWhile (/='%') varmsg == ":VAR"++var
then let (len,value) = break (=='*') (tail (dropWhile (/='%') varmsg))
- in getWidgetVarValue (readNat len) (tail value) gport
+ in getWidgetVarValue (read len) (tail value) gport
else do reportTclTkError ("ERROR in getWidgetVar \""++var++"\": Received: "
++varmsg++"\n")
getWidgetVarMsg var gport -- ignore other messages and try again
@@ -1381,7 +1385,7 @@ getCursorPosition (WRefLabel var wtype) gport =
else do send2tk ("puts [ "++wRefname2Label var++" index insert ]") gport
line <- receiveFromTk gport
let (ls,ps) = break (=='.') line
- return (if null ps then (0,0) else (readNat ls, readNat (tail ps)))
+ return (if null ps then (0,0) else (read ls, read (tail ps)))
--- Adjust the view of a TextEdit widget so that the specified line/column
@@ -1544,5 +1548,9 @@ chooseColor = do
exitGUI gport
return color
+----------------------------------------------------------------------------
+-- Auxiliaries:
+done :: IO ()
+done = return ()
-- end of GUI library