GUI mit GTK Haskell
> module Calculator where
> import Graphics.UI.Gtk
> import Control.Concurrent
> import Control.Monad.IO.Class
> import Data.Char
> import Data.List
> moin1 = do
> initGUI
> window <- windowNew
> widgetShowAll window
> mainGUI
> moin2 = do
> initGUI
> window <- windowNew
> set window [ containerBorderWidth := 10
> , windowTitle := "Hier könnte Ihre Werbung stehen"]
> window `on` deleteEvent $ do liftIO mainQuit
> return False
> widgetShowAll window
> mainGUI
> moin3 = do
> initGUI
> window <- windowNew
> set window [ containerBorderWidth := 10]
> box <- hBoxNew True 1
> b1 <- buttonNew
> set b1 [ buttonLabel := "Knopf 1" ]
> b2 <- buttonNew
> set b2 [ buttonLabel := "Knopf 2" ]
> display <- entryNew
> boxPackStart box b1 PackGrow 0
> boxPackStart box b2 PackGrow 0
> boxPackStart box display PackGrow 0
> set window [ containerChild := box]
> window `on` deleteEvent $ do liftIO mainQuit
> return False
> widgetShowAll window
> mainGUI
> moin4 = do
> initGUI
> window <- windowNew
> mv <- newMVar 0
> box <- hBoxNew True 1
> b1 <- buttonNew
> set b1 [ buttonLabel := "+" ]
> b2 <- buttonNew
> set b2 [ buttonLabel := "-" ]
> display <- entryNew
> boxPackStart box b1 PackGrow 0
> boxPackStart box b2 PackGrow 0
> boxPackStart box display PackGrow 0
> b1 `on`buttonActivated $
> do
> modifyMVar_ mv (\v->return (v+1))
> v <- readMVar mv
> set display [ entryText := show v ]
>
> b2 `on`buttonActivated $
> do
> modifyMVar_ mv (\v->return (v-1))
> v <- readMVar mv
> set display [ entryText := show v ]
>
> set window [ containerChild := box]
> window `on` deleteEvent $ do liftIO mainQuit
> return False
> widgetShowAll window
> mainGUI
> data State
> = State{i1::Integer, i2:: Integer, op:: (Integer->Integer->Integer)}
> addDigit d st@(State i1 i2 op)
> |d>=0 && d<10 = State (10*i1+d) i2 op
> |otherwise = st
> addOp op (State i1 i2 op1) = State 0 (op1 i2 i1) op
> initStat = State 0 0 (\x y -> y)
> ops = "+-*/%="
> readOP "+" = (+)
> readOP "-" = (-)
> readOP "*" = (*)
> readOP "/" = div
> readOP "%" = mod
> readOP "=" = \x y-> x
> readOP _ = \x y-> y
> moin5 s = do
> c<-getChar
> putStr "\n"
> let s'@(State r1 r2 op) =
> if isDigit c
> then addDigit (toInteger (ord c-ord '0')) s
> else if elem c ops
> then addOp (readOP [c]) s
> else s
> print (if elem c ops then r2 else r1)
> moin5 s'
> data GuiControls
> = GuiControls
> { digitButtons :: [Button]
> , display :: Entry
> , operatorButtons :: [Button]
> }
> digits = [1..9]++[0]
>
> mkGuiControls = do
> ds <- sequence (fmap (mkBtn.show) digits)
> display <- entryNew
> set display [ entryEditable := False
> , entryXalign := 1
> , entryText := "0" ]
> os <- sequence$fmap mkBtn$fmap (\x->[x]) ops
> return (GuiControls ds display os)
> mkBtn label = do
> btn <- buttonNew
> set btn [ buttonLabel := label ]
> return btn
> layoutGui gui = do
> grid <- gridNew
> gridSetRowHomogeneous grid True
> gridAttach grid (display gui) 0 0 4 1
> sequence $ fmap (\(p,b)->gridAttach grid b (p`mod`3) (1+p`div`3) 1 1)
> $ zip [0..]
> $ digitButtons gui
> let (op1,op2) = splitAt 3 $ operatorButtons gui
> sequence $ fmap (\(p,b)->gridAttach grid b 3 p 1 1 )
> $ zip [1..] op1
> sequence $ fmap (\(p,b)->gridAttach grid b p 4 1 1 )
> $ zip [1..] op2
> return grid
> addGuiEvents gui = do
> st <- newMVar initStat
> sequence
> [ on b buttonActivated$
> do
> modifyMVar_ st (return . addDigit i)
> s<-readMVar st
> set (display gui) [entryText := show (i1 s)]
> | (i,b) <- zip digits (digitButtons gui)]
> sequence
> [ on b buttonActivated$
> do
> modifyMVar_ st
> (\s->buttonGetLabel b>>= \l -> return$ addOp (readOP l) s)
> s <- readMVar st
> set (display gui) [ entryText := show (i2 s) ]
> | b<-operatorButtons gui]
>
> return gui
> calculatorNew = do
> gui <- mkGuiControls
> addGuiEvents gui
> grid <- layoutGui gui
> return grid
> moin = do
> initGUI
> window <- windowNew
> set window [ containerBorderWidth := 10]
> calculator <- calculatorNew
> set window [ containerChild := calculator]
> window `on` deleteEvent $ do liftIO mainQuit
> return False
> widgetShowAll window
> mainGUI
lhs
You are not logged in and therefore you cannot submit a solution.
Subato
