|
From: <kr_...@us...> - 2003-04-02 21:34:12
|
Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv16652
Modified Files:
Able.hs BouncingBalls.hs ByeDemo.hs Calculator.hs
ConfirmQuit.hs Progress.hs SimpleDrawing.hs SimpleHello.hs
SimpleMenu.hs SimpleQuitButton.hs
Log Message:
Update examples after last changes in the GIO
Index: Able.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/Able.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Able.hs 26 Mar 2003 18:35:42 -0000 1.3
--- Able.hs 2 Apr 2003 21:33:55 -0000 1.4
***************
*** 1,26 ****
! module Main where
!
! import Graphics.UI.GIO
!
! main = start "Able" SDI [] demo
!
! demo = do
! w1 <- window [title =: "Slave", view =: sz 200 100, domain =: sz 200 80]
! ent <- entry [text =: "Test!"] w1
! btn <- button [text =: "Button"] w1
! set w1 [layout =: (hfix 80 ent <<< btn)]
! w2 <- window [title =: "Master", view =: sz 200 80, domain =: sz 200 80]
! bctrl <- button [] w2
! bwnd <- button [] w2
! set w2 [layout =: (hfill bctrl ^^^ hfill bwnd)]
! enable "Control" bctrl ent
! enable "Window" bwnd w1
! return ()
! where
! enable title b w = do
! set w [enabled =: True]
! set b [text =: "Disable " ++ title, on command =: disable title b w]
!
! disable title b w = do
! set w [enabled =: False]
! set b [text =: "Enable " ++ title, on command =: enable title b w]
\ No newline at end of file
--- 1,26 ----
! module Main where
!
! import Graphics.UI.GIO
!
! main = start MDI [title =: "Able"] demo
!
! demo = do
! w1 <- window [title =: "Slave", view =: sz 200 100, domain =: sz 200 80]
! ent <- entry [text =: "Test!"] w1
! btn <- button [text =: "Button"] w1
! set w1 [layout =: (hfix 80 ent <<< btn)]
! w2 <- window [title =: "Master", view =: sz 200 80, domain =: sz 200 80]
! bctrl <- button [] w2
! bwnd <- button [] w2
! set w2 [layout =: (hfill bctrl ^^^ hfill bwnd)]
! enable "Control" bctrl ent
! enable "Window" bwnd w1
! return ()
! where
! enable title b w = do
! set w [enabled =: True]
! set b [text =: "Disable " ++ title, on command =: disable title b w]
!
! disable title b w = do
! set w [enabled =: False]
! set b [text =: "Enable " ++ title, on command =: enable title b w]
Index: BouncingBalls.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/BouncingBalls.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** BouncingBalls.hs 24 Mar 2003 17:19:51 -0000 1.2
--- BouncingBalls.hs 2 Apr 2003 21:33:55 -0000 1.3
***************
*** 4,13 ****
main
! = start SDI balls
balls
= do vballs <- newVar []
! w <- window [title =: "Bouncing balls", resizeable =: False, view =: sz maxX maxY]
set w [ on paint =: paintBalls vballs
, on click =: dropBall w vballs
--- 4,13 ----
main
! = start SDI [] balls
balls
= do vballs <- newVar []
! w <- window [title =: "Bouncing balls", resizeable =: True, view =: sz maxX maxY]
set w [ on paint =: paintBalls vballs
, on click =: dropBall w vballs
***************
*** 19,23 ****
, on (charKey '+') =: set t [interval ~: \i -> max 1 (i `div` 2)]
, on (charKey 'p') =: set t [enabled ~: not]
- , on clickRight =: \p -> balls
]
--- 19,22 ----
***************
*** 41,45 ****
paintBalls vballs can updframe updareas
! = do box updframe [color =: lightgrey] can
balls <- getVar vballs
mapM_ (drawBall can) (map head (filter (not.null) balls))
--- 40,44 ----
paintBalls vballs can updframe updareas
! = do box updframe [color =: lightgray] can
balls <- getVar vballs
mapM_ (drawBall can) (map head (filter (not.null) balls))
Index: ByeDemo.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/ByeDemo.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ByeDemo.hs 24 Mar 2003 17:19:51 -0000 1.3
--- ByeDemo.hs 2 Apr 2003 21:33:55 -0000 1.4
***************
*** 17,21 ****
import Graphics.UI.GIO
! main = start SDI demo -- "start" initializes the GUI.
demo :: IO ()
--- 17,21 ----
import Graphics.UI.GIO
! main = start SDI [] demo -- "start" initializes the GUI.
demo :: IO ()
***************
*** 24,31 ****
b <- button [text =: "Bye"] w
set w [layout =: pad 10 (center l ^^^^ center b)]
! set b [on command =: bye w l b]
where
-- called on the first click, with the window, label, and button as arguments.
! bye w l b
= do set l [text =: "Goodbye"]
! set b [on command =: close w]
\ No newline at end of file
--- 24,31 ----
b <- button [text =: "Bye"] w
set w [layout =: pad 10 (center l ^^^^ center b)]
! set b [on command =: bye l b]
where
-- called on the first click, with the window, label, and button as arguments.
! bye l b
= do set l [text =: "Goodbye"]
! set b [on command =: halt]
Index: Calculator.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/Calculator.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Calculator.hs 24 Mar 2003 17:19:51 -0000 1.3
--- Calculator.hs 2 Apr 2003 21:33:55 -0000 1.4
***************
*** 6,10 ****
main
! = start SDI calculator
calculator
--- 6,10 ----
main
! = start SDI [] calculator
calculator
Index: ConfirmQuit.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/ConfirmQuit.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ConfirmQuit.hs 24 Mar 2003 17:19:51 -0000 1.2
--- ConfirmQuit.hs 2 Apr 2003 21:33:55 -0000 1.3
***************
*** 2,8 ****
import Graphics.UI.GIO
main
! = start SDI $
do w <- window [title =: "hello world"
,view =: sz 200 200]
--- 2,9 ----
import Graphics.UI.GIO
+ import Control.Monad(when)
main
! = start SDI [] $
do w <- window [title =: "hello world"
,view =: sz 200 200]
***************
*** 10,27 ****
where
confirmQuit w
! = do yes <- confirmDialog ["Invoked dismiss!","Do you really want to quit?"] w
! if (yes) then close w else return ()
!
!
! confirmDialog :: [String] -> Window -> IO Bool
! confirmDialog msgs w
! = do vok <- newVar False
! modalDialog [title =: "Confirm"] w (configure vok)
! getVar vok
! where
! configure vok d
! = do ls <- mapM (\msg -> label [text =: msg] d) msgs
! ok <- button [text =: "Ok", on command =: do setVar vok True; close d] d
! can <- button [text =: "Cancel", on command =: do close d] d
! set d [layout =: pad 10 $ (vertical ls) ^^^^ hcenter (hfix 80 ok <<<< hfix 80 can)]
! -- rigid (hcenter ok ^^^ hfix 100 can)]
--- 11,14 ----
where
confirmQuit w
! = do yes <- messageQuestion "Invoked dismiss!\nDo you really want to quit?"
! when (yes) (destroyWidget w)
Index: Progress.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/Progress.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Progress.hs 27 Mar 2003 13:36:20 -0000 1.1
--- Progress.hs 2 Apr 2003 21:33:55 -0000 1.2
***************
*** 3,7 ****
import Graphics.UI.GIO
! main = start "Progress" SDI [] demo
maxSpeed = 200 :: Int
--- 3,7 ----
import Graphics.UI.GIO
! main = start SDI [] demo
maxSpeed = 200 :: Int
***************
*** 9,14 ****
demo = do
! myfont <- createFont defaultFontDef{fontSize=50}
! w <- window [view =: sz 800 100, domain =: sz 800 80]
tm <- timer [interval =: maxSpeed `div` 2]
prg <- hProgressBar True [progressRange =: (0,maxProgress)] w
--- 9,13 ----
demo = do
! w <- window [title =: "Progress", view =: sz 800 100, domain =: sz 800 80]
tm <- timer [interval =: maxSpeed `div` 2]
prg <- hProgressBar True [progressRange =: (0,maxProgress)] w
Index: SimpleDrawing.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/SimpleDrawing.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** SimpleDrawing.hs 24 Mar 2003 17:19:51 -0000 1.3
--- SimpleDrawing.hs 2 Apr 2003 21:33:55 -0000 1.4
***************
*** 4,8 ****
main
! = start SDI $
do w <- window [title =: "Hello world", width =: 600, height =: 600
,on paint =: mypaint
--- 4,8 ----
main
! = start SDI [] $
do w <- window [title =: "Hello world", width =: 600, height =: 600
,on paint =: mypaint
Index: SimpleHello.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/SimpleHello.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** SimpleHello.hs 24 Mar 2003 17:19:51 -0000 1.2
--- SimpleHello.hs 2 Apr 2003 21:33:55 -0000 1.3
***************
*** 4,7 ****
main
! = start SDI $
do window [title =: "hello world", view =: sz 200 200]
--- 4,7 ----
main
! = start SDI [] $
do window [title =: "hello world", view =: sz 200 200]
Index: SimpleMenu.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/SimpleMenu.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** SimpleMenu.hs 24 Mar 2003 17:19:51 -0000 1.2
--- SimpleMenu.hs 2 Apr 2003 21:33:55 -0000 1.3
***************
*** 4,17 ****
main
! = start SDI $
do w <- window [title =: "Hello world", view =: sz 200 200]
!
! bar <- menubar [] w
! fm <- submenu "&File" [] bar
! menuitem "&Open" [menukey =: KeyChar 'o', menumod =: justControl] fm
menuitem "&Close" [enabled =: False] fm
! menuline fm
! menuitem "&Exit" [on command =: close w] fm
!
! set w [layout =: bar]
--- 4,15 ----
main
! = start SDI [] $
do w <- window [title =: "Hello world", view =: sz 200 200]
!
! fm <- menu "&File" [] mainMenu
! menuitem "&Open" [menukey =: KeyChar 'o'] fm
menuitem "&Close" [enabled =: False] fm
! menuline mainMenu
! menuitem "&Exit" [on command =: halt] fm
!
Index: SimpleQuitButton.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/SimpleQuitButton.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** SimpleQuitButton.hs 24 Mar 2003 17:19:51 -0000 1.2
--- SimpleQuitButton.hs 2 Apr 2003 21:33:55 -0000 1.3
***************
*** 3,10 ****
import Graphics.UI.GIO
! main = start SDI demo
demo :: IO ()
demo = do w <- window [title =: "Quit demo"]
! q <- button [text =: "Quit", on command =: close w] w
set w [layout =: pad 10 (center q)]
--- 3,10 ----
import Graphics.UI.GIO
! main = start SDI [] demo
demo :: IO ()
demo = do w <- window [title =: "Quit demo"]
! q <- button [text =: "Quit", on command =: halt] w
set w [layout =: pad 10 (center q)]
|