agrega ejemplos

Obligatorio/ejemplosWXHAskell/BouncingBalls.hs

+{--------------------------------------------------------------------------------
+  Bouncing Balls demo
+--------------------------------------------------------------------------------}
+module Main where
+
+import Graphics.UI.WXCore
+
+main
+  = run ballsFrame
+
+ballsFrame
+  = do -- a list of balls, where each ball is represented by a list of all future Y positions.
+       vballs <- varCreate []
+
+       -- create a non-user-resizable top-level (orphan) frame.
+       f <- frameCreate objectNull idAny "Bouncing balls" rectNull
+                         ( wxMINIMIZE_BOX + wxSYSTEM_MENU + wxCAPTION + wxNO_FULL_REPAINT_ON_RESIZE
+                         + wxCLIP_CHILDREN + wxCLOSE_BOX)
+
+       -- add a panel to draw on, nice grey color.
+       p <- panelCreate f idAny rectNull 0 -- (wxNO_FULL_REPAINT_ON_RESIZE)
+       let instructions = init . unlines $
+                                  [ "Click to create more bouncing balls"
+                                  , "Right-click to for a new window"
+                                  , "<+/-> to change the speed" ]
+       windowSetBackgroundColour f $ colorSystem Color3DFace
+       windowSetLayout f (column 1 [ minsize (sz maxX maxY) (widget p)
+                                   , label instructions ])
+
+       -- create a timer, on each tick it advances all the balls to their next position
+       t <- windowTimerCreate f
+       timerOnCommand t (nextBalls p vballs)
+
+       -- paint the balls unbuffered
+       windowOnPaintRaw p (paintBalls vballs)
+
+       -- left-click: new ball, right-click: new window
+       windowOnMouse p False {- no motion events -} (onMouse p vballs)
+
+       -- '-': decrease interval, '+': increase interval.
+       windowOnKeyChar p (onKey t)
+
+       -- show the frame
+       windowShow f
+       windowRaise f
+
+       -- and start the timer (25 msec).
+       timerStart t 25 False {- one-shot timer? -}
+       return ()
+  where
+    -- react on mouse events
+    onMouse w vballs mouse
+      = case mouse of
+          MouseLeftDown pt mods  -> dropBall w vballs pt  -- new ball
+          MouseRightDown pt mods -> ballsFrame            -- new window with bouncing balls
+          other                  -> skipCurrentEvent      -- unprocessed event: send up the window chain
+
+    -- react on the keyboard
+    onKey t keyboard
+      = case keyKey keyboard of
+          KeyChar '-'   -> updateInterval t (\i -> i+5)
+          KeyChar '+'   -> updateInterval t (\i -> max 1 (i-5))
+          other         -> skipCurrentEvent
+
+    updateInterval t f
+      = do i <- timerGetInterval t
+           timerStop t
+           timerStart t (f i) False
+           return ()
+
+    -- advance all the balls to their next position
+    nextBalls w vballs
+      = do varUpdate vballs (filter (not.null) . map (drop 1))
+           windowRefresh w False
+
+    -- add a new ball
+    dropBall w vballs pt
+      = do varUpdate vballs (bouncing pt:)
+           windowRefresh w False
+
+    -- calculate all future positions
+    bouncing (Point x y)
+      = map (\h -> Point x (maxH-h)) (bounce (maxH-y) 0)
+
+    bounce h v
+      | h <= 0 && v == 0     = []
+      | h <= 0 && v  < 0     = bounce 0 ((-v)-2)
+      | otherwise            = h : bounce (h+v) (v-1)
+
+
+    -- paint the balls
+    paintBalls vballs dc viewRect updateAreas
+      = do dcClear dc
+           balls <- varGet vballs
+           dcWithBrushStyle dc (BrushStyle BrushSolid red) $
+             mapM_ (drawBall dc) (map head (filter (not.null) balls))
+
+    drawBall dc pt
+      = dcDrawCircle dc pt radius
+
+
+-- radius the ball, and the maximal x and y coordinates
+radius, maxX, maxY :: Int
+maxY   = 300
+maxX   = 300
+radius = 10
+
+-- the max. height is at most max. y minus the radius of a ball.
+maxH :: Int
+maxH   = maxY - radius
\ No newline at end of file

Obligatorio/ejemplosWXHAskell/ByeDemo.hs

+{--------------------------------------------------------------------------------
+This program implements the "goodbye" demo as posted by John Meacham on
+the Haskell GUI mailing list. The program is specified as:
+
+I propose a simple program which pops up a window saying 'Hello World'
+with a button saying 'Bye' which you click and it changes the message
+to 'Goodbye'. If you click the button again the program exits.
+
+When the button is clicked the first time, it calls "onCommand1". This function
+changes the text of the label and installs another event handler on the button
+that closes the main frame. (by default, wxWidgets exits the gui when all
+windows are closed).
+--------------------------------------------------------------------------------}
+module Main where
+
+import Graphics.UI.WXCore
+
+main :: IO ()
+main
+  = run gui
+
+gui :: IO ()
+gui
+  = do -- create top frame
+       f <- frameCreateTopFrame "Bye demo"
+       windowSetBackgroundColour f white
+
+       -- panel for automatic tab management and the nice background
+       p <- panelCreate f idAny rectNull 0
+
+       -- create text and button control
+       t <- staticTextCreate p idAny "Hello World" rectNull 0
+       b <- buttonCreate p idAny "Bye" rectNull 0
+
+       -- press spacebar to invoke the button by default
+       topLevelWindowSetDefaultItem f b
+
+       -- set the layout
+       windowSetLayout f (fill (container p (margin 5 (column 5 [widget t, widget b]))))
+
+       -- set command handler on the button
+       buttonOnCommand b (onCommand1 f t b)
+
+       -- show the frame
+       windowShow f
+       windowRaise f
+       return ()
+  where
+    -- call on the first click
+    onCommand1 f t b
+      = do controlSetLabel t "Goodbye!"
+           buttonOnCommand b (onCommand2 f)
+           return ()
+
+    -- call on the second click
+    onCommand2 f
+      = do windowClose f False {- can veto -}
+           return ()

Obligatorio/ejemplosWXHAskell/HelloWorld.hs

+{--------------------------------------------------------------------------------
+  The 'hello world' demo from the wxWidgets site.
+--------------------------------------------------------------------------------}
+module Main where
+
+import Graphics.UI.WXCore
+
+main
+  = run helloWorld
+
+helloWorld
+  = do -- create file menu
+       fm <- menuCreate "" 0
+       menuAppend fm wxID_ABOUT "&About.." "About wxHaskell" False {- not checkable -}
+       menuAppendSeparator fm
+       menuAppend fm wxID_EXIT "&Quit\tCtrl-Q"    "Quit the demo"  False
+
+       -- create menu bar
+       m  <- menuBarCreate 0
+       menuBarAppend m fm "&File"
+
+       -- create top frame
+       f  <- frameCreate objectNull idAny "Hello world" rectZero frameDefaultStyle
+       windowSetBackgroundColour f white
+       windowSetClientSize f (sz 600 250)
+
+       -- set status bar with 1 field
+       frameCreateStatusBar f 1 0
+       frameSetStatusText f "Welcome to wxHaskell" 0
+
+       -- connect menu
+       frameSetMenuBar f m
+       evtHandlerOnMenuCommand f wxID_ABOUT (onAbout f)
+       evtHandlerOnMenuCommand f wxID_EXIT  (onQuit f)
+
+       -- show it
+       windowShow f
+       windowRaise f
+       return ()
+  where
+    onAbout f
+      = do version <- versionNumber
+           messageDialog f "About 'Hello World'" ("This is a wxHaskell " ++ show version ++ " sample") (wxOK + wxICON_INFORMATION)
+           return ()
+
+    onQuit f
+      = do windowClose f True {- force close -}
+           return ()

Obligatorio/ejemplosWXHAskell/ImageViewer.hs

+{--------------------------------------------------------------------------------
+  A utility to view images
+--------------------------------------------------------------------------------}
+module Main where
+
+import Control.Exception( onException )
+import Graphics.UI.WXCore
+
+defaultWidth,defaultHeight :: Int
+defaultWidth  = 300
+defaultHeight = 300
+
+main
+  = run imageViewer
+
+imageViewer
+  = do -- variable that holds the current bitmap
+       vbitmap <- varCreate Nothing
+
+       -- create file menu: we use standard Id's but could also use any other identifier, like 1 or 27.
+       fm <- menuCreate "" 0
+       menuAppend fm wxID_OPEN "&Open..\tCtrl+O"  "Open image" False
+       menuAppend fm wxID_CLOSE "&Close\tCtrl+C"  "Close image" False
+       menuAppendSeparator fm
+       menuAppend fm wxID_ABOUT "&About.." "About ImageViewer" False {- not checkable -}
+       menuAppend fm wxID_EXIT "&Quit\tCtrl+Q"    "Quit the viewer"  False
+
+       -- disable close
+       menuEnable fm wxID_CLOSE False
+
+       -- create menu bar
+       m  <- menuBarCreate 0
+       menuBarAppend m fm "&File"
+
+       -- create top frame
+       f  <- frameCreateTopFrame "Image Viewer"
+       windowSetClientSize f (sz defaultWidth defaultHeight)
+
+       -- coolness: set a custom icon
+       topLevelWindowSetIconFromFile f "../bitmaps/eye.ico"
+
+       -- put a scrolled window inside the frame to paint the image on
+       -- note that 'wxNO_FULL_REPAINT_ON_RESIZE'  is needed to prevent flicker on resize.
+       s <- scrolledWindowCreate f idAny rectNull (wxHSCROLL + wxVSCROLL + wxNO_FULL_REPAINT_ON_RESIZE + wxCLIP_CHILDREN)
+
+       -- set paint event handler:
+       windowOnPaint s (onPaint vbitmap)
+
+       -- connect menu
+       frameSetMenuBar f m
+       evtHandlerOnMenuCommand f wxID_OPEN  (onOpen f vbitmap fm s)
+       evtHandlerOnMenuCommand f wxID_CLOSE (onClose f vbitmap fm s)
+       evtHandlerOnMenuCommand f wxID_ABOUT (onAbout f)
+       evtHandlerOnMenuCommand f wxID_EXIT  (onQuit f)
+       windowAddOnDelete f (close f vbitmap)
+       -- show it
+       windowShow f
+       windowRaise f
+
+       return ()
+  where
+    onAbout f
+      = infoDialog f "About 'Image Viewer'" "This is a wxHaskell demo"
+
+    onQuit f
+      = do windowClose f True {- force close -}
+           return ()
+
+    onOpen f vbitmap fm s
+      = do mbfname <- fileOpenDialog f False True "Open image" imageFiles "" ""
+           case mbfname of
+             Nothing
+               -> return ()
+             Just fname
+               -> do bm <- bitmapCreateFromFile fname  -- can fail with exception
+                     close f vbitmap
+                     varSet vbitmap (Just bm)
+                     menuEnable fm wxID_CLOSE True
+                     -- and than reset the scrollbars and resize around the picture
+                     w <- bitmapGetWidth bm
+                     h <- bitmapGetHeight bm
+                     oldsz <- windowGetClientSize f
+                     let newsz = (sizeMin (sz w h) oldsz)
+                     windowSetClientSize f newsz
+                     scrolledWindowSetScrollbars s 1 1 w h 0 0 False
+                     -- and repaint explicitly (to delete previous stuff)
+                     view <- windowGetViewRect s
+                     withClientDC s (\dc -> onPaint vbitmap dc view)
+                  `onException` return ()
+      where
+        imageFiles
+           = [("Image files",["*.bmp","*.jpg","*.gif","*.png"])
+             ,("Portable Network Graphics (*.png)",["*.png"])
+             ,("BMP files (*.bmp)",["*.bmp"])
+             ,("JPG files (*.jpg)",["*.jpg"])
+             ,("GIF files (*.gif)",["*.gif"])
+             ]
+
+
+    onClose f vbitmap fm s
+      = do close f vbitmap
+           menuEnable fm wxID_CLOSE False
+           -- explicitly delete the old bitmap
+           withClientDC s dcClear
+           -- and than reset the scrollbars
+           scrolledWindowSetScrollbars s 1 1 0 0 0 0 False
+
+    close f vbitmap
+      = do mbBitmap <- varSwap vbitmap Nothing
+           case mbBitmap of
+             Nothing -> return ()
+             Just bm -> bitmapDelete bm
+
+    onPaint vbitmap dc viewArea
+      = do mbBitmap <- varGet vbitmap
+           case mbBitmap of
+             Nothing -> return ()
+             Just bm -> do dcDrawBitmap dc bm pointZero False {- use mask? -}
+                           return ()

Obligatorio/ejemplosWXHAskell/Minimal.hs

+module Main where
+
+import Graphics.UI.WXCore
+
+main :: IO ()
+main
+  = run gui
+
+gui :: IO ()
+gui
+  = do frame <- frameCreate objectNull idAny "Hello world" rectZero frameDefaultStyle
+       windowSetClientSize frame (sz 600 250)
+       windowShow frame
+       windowRaise frame
+       return ()

Obligatorio/ejemplosWXHAskell/Paint.hs

+{--------------------------------------------------------------------------------
+  Copyright 2003, Daan Leijen
+  Paint demo.
+--------------------------------------------------------------------------------}
+module Main where
+
+import Graphics.UI.WXCore
+
+main :: IO ()
+main
+  = run gui
+
+gui :: IO ()
+gui
+  = do -- create top frame
+       f <- frameCreateTopFrame "Paint demo"
+
+       -- for good measure: put a scrolled window inside the frame
+       -- note that 'wxNO_FULL_REPAINT_ON_RESIZE'  is needed to prevent flicker on resize.
+       s <- scrolledWindowCreate f idAny rectNull (wxHSCROLL + wxVSCROLL + wxNO_FULL_REPAINT_ON_RESIZE + wxCLIP_CHILDREN)
+
+       -- virtual size is 20*40 = 800 pixels
+       scrolledWindowSetScrollbars s 20 20 40 40 0 0 False
+       
+       -- to show the effect of double-buffering, we track the mouse with a small disc.
+       mouseXY <- varCreate (pt 0 0)
+       windowOnMouse s True {- get motion events -} (onMouse s mouseXY)
+
+       -- set paint event handler:
+       windowOnPaint s (\dc -> onPaint mouseXY dc)
+
+       -- show the frame
+       windowShow f
+       windowRaise f
+       return ()
+  where
+    -- update the mouse position and force a repaint
+    onMouse w mouseXY mouse
+      = do varSet mouseXY (mousePos mouse)
+           windowRefresh w False {- erase background -}
+
+    -- do some painting.
+    onPaint mouseXY dc view
+      = -- first create some brushes and pens.
+        withBrushStyle (BrushStyle (BrushHatch HatchCross) red) $ \brushRedHatch ->
+        withBrushStyle (BrushStyle BrushSolid red)  $ \brushRed ->
+        withBrushStyle (BrushStyle BrushSolid white)  $ \brushWhite ->
+        withPenStyle (penColored blue 5) $ \penMedBlue ->
+        do -- dcClearRect dc view
+           dcSetBrush dc brushWhite
+           dcDrawRectangle dc (rect (pt 20 20) (sz 500 500))
+
+           dcSetBrush dc brushRedHatch
+           dcDrawCircle dc (pt 100 100) 50
+
+           dcSetPen dc penMedBlue
+           dcDrawRectangle dc (rect (pt 200 200) (sz 50 50))
+
+           dcSetBrush dc brushRed
+           dcDrawEllipticArc dc (rect (pt 100 200) (sz 50 100)) 45 135
+
+           -- draw the mouse bullet
+           xy <- varGet mouseXY
+           dcDrawCircle dc xy 10
+
+           drawPolygon dc [(pt 200 400),(pt 300 300),(pt 400 400)]
+           dcDrawRotatedText dc "Polygon" (pt 200 370) 45
+
+           -- fonts
+           dcWithFontStyle dc fontSwiss{ _fontSize = 12, _fontWeight = WeightBold } $
+            do dcDrawText dc "Swiss 12pt bold" (pt 50 270)
+               dcWithFontStyle dc fontDefault{ _fontFamily = FontScript, _fontSize = 16} $
+                dcDrawText dc "Hand writing 16pt" (pt 50 290)
+               dcDrawText dc "Swiss 12pt bold" (pt 50 310)
+
+           (Size w h) <- getTextExtent dc "label"
+           dcDrawRectangle dc (rect (pt 450 350) (sz (w+10) (h+10)))
+           dcDrawText dc "label" (pt 455 355)
+
+           -- cap styles
+           dcWithPenStyle dc (penDefault{ _penWidth = 20, _penCap = CapRound }) $
+            dcDrawLine dc (pt 400 100) (pt 500 100)
+
+           dcWithPenStyle dc (penDefault{ _penWidth = 20, _penCap = CapProjecting }) $
+            dcDrawLine dc (pt 400 150) (pt 500 150)
+
+           dcWithPenStyle dc (penDefault{ _penWidth = 20, _penCap = CapButt }) $
+            dcDrawLine dc (pt 400 200) (pt 500 200)
+
+           dcSetBrush dc nullBrush
+           dcDrawEllipse dc (rect (pt 200 100) (sz 100 50))
\ No newline at end of file

Obligatorio/ejemplosWXHAskell/PaintGC.hs

+{--------------------------------------------------------------------------------
+  Copyright 2003, Daan Leijen
+  Paint demo, with antialiased drawing via GraphicsContext (wxGCDC).
+  Antialiased drawing added by Dmitriy Nikitinskiy (2010).
+--------------------------------------------------------------------------------}
+module Main where
+
+import Control.Monad
+import Graphics.UI.WXCore
+import Graphics.UI.WXCore.WxcTypes
+
+main :: IO ()
+main
+  = run gui
+
+gui :: IO ()
+gui
+  = do -- create top frame
+       f <- frameCreateTopFrame "Paint demo (with antialiasing)"
+
+       -- for good measure: put a scrolled window inside the frame
+       -- note that 'wxNO_FULL_REPAINT_ON_RESIZE'  is needed to prevent flicker on resize.
+       s <- scrolledWindowCreate f idAny rectNull (wxHSCROLL + wxVSCROLL + wxNO_FULL_REPAINT_ON_RESIZE + wxCLIP_CHILDREN)
+
+       -- virtual size is 20*40 = 800 pixels
+       scrolledWindowSetScrollbars s 20 20 40 40 0 0 False
+       
+       -- to show the effect of double-buffering, we track the mouse with a small disc.
+       mouseXY <- varCreate (pt 0 0)
+       windowOnMouse s True {- get motion events -} (onMouse s mouseXY)
+
+       -- set paint event handler:
+       windowOnPaint s (\dc -> onPaint mouseXY (objectCast dc))
+
+       -- show the frame
+       _ <- windowShow f
+       windowRaise f
+       return ()
+  where
+    -- update the mouse position and force a repaint
+    onMouse w mouseXY mouse
+      = do varSet mouseXY (mousePos mouse)
+           windowRefresh w False {- erase background -}
+
+    -- do some painting.
+    onPaint :: Var Point -> WindowDC a -> t -> IO ()
+    onPaint mouseXY dc_ view
+      = -- first create some brushes and pens.
+        withBrushStyle (BrushStyle (BrushHatch HatchCross) red) $ \brushRedHatch ->
+        withBrushStyle (BrushStyle BrushSolid red)  $ \brushRed ->
+        withBrushStyle (BrushStyle BrushSolid white)  $ \brushWhite ->
+        withPenStyle (penColored blue 5) $ \penMedBlue ->
+        do -- dcClearRect dc view
+           dc <- gcdcCreate dc_
+           dcSetBrush dc brushWhite
+           dcDrawRectangle dc (rect (pt 20 20) (sz 500 500))
+
+           dcSetBrush dc brushRedHatch
+           dcDrawCircle dc (pt 100 100) 50
+
+           dcSetPen dc penMedBlue
+           dcDrawRectangle dc (rect (pt 200 200) (sz 50 50))
+
+           dcSetBrush dc brushRed
+           dcDrawEllipticArc dc (rect (pt 100 200) (sz 50 100)) 45 135
+
+           -- draw the mouse bullet
+           xy <- varGet mouseXY
+           dcDrawCircle dc xy 10
+
+           drawPolygon dc [(pt 200 400),(pt 300 300),(pt 400 400)]
+           dcDrawRotatedText dc "Polygon" (pt 200 370) 45
+
+           -- fonts
+           dcWithFontStyle dc fontSwiss{ _fontSize = 12, _fontWeight = WeightBold } $
+            do dcDrawText dc "Swiss 12pt bold" (pt 50 270)
+               dcWithFontStyle dc fontDefault{ _fontFamily = FontScript, _fontSize = 16} $
+                dcDrawText dc "Hand writing 16pt" (pt 50 290)
+               dcDrawText dc "Swiss 12pt bold" (pt 50 310)
+
+           (Size w h) <- getTextExtent dc "label"
+           dcDrawRectangle dc (rect (pt 450 350) (sz (w+10) (h+10)))
+           dcDrawText dc "label" (pt 455 355)
+
+           -- cap styles
+           dcWithPenStyle dc (penDefault{ _penWidth = 20, _penCap = CapRound }) $
+            dcDrawLine dc (pt 400 100) (pt 500 100)
+
+           dcWithPenStyle dc (penDefault{ _penWidth = 20, _penCap = CapProjecting }) $
+            dcDrawLine dc (pt 400 150) (pt 500 150)
+
+           dcWithPenStyle dc (penDefault{ _penWidth = 20, _penCap = CapButt }) $
+            dcDrawLine dc (pt 400 200) (pt 500 200)
+
+           dcSetBrush dc nullBrush
+           dcDrawEllipse dc (rect (pt 200 100) (sz 100 50))
+
+           c <- gcdcGetGraphicsContext dc
+--         p <- graphicsPathCreate c
+           p <- graphicsContextCreatePath c
+           graphicsPathAddCircle p (point 0 0) 40
+           graphicsPathMoveToPoint p $ point 0 $ -40
+           graphicsPathAddLineToPoint p (Point 0 40)
+           graphicsPathMoveToPoint p (Point (-40) 0)
+           graphicsPathAddLineToPoint p (Point 40 0)
+           graphicsPathCloseSubpath p
+           graphicsPathAddRectangle p (Rect (-20) (-10) 40 20)
+           graphicsContextTranslate c 200 70
+           graphicsContextStrokePath c p
+           graphicsContextTranslate c 100 0
+           
+           graphicsContextDrawText c "Rotate" (Point 0 $ -40);
+           
+           graphicsContextTranslate c 0 75
+           
+           forM_ [0,30..360 :: Double] $ \angle -> do
+               graphicsContextPushState c
+               --wxImage::RGBValue val = wxImage::HSVtoRGB(wxImage::HSVValue(float(angle)/360, 1, 1));
+               let a = round $ angle * 255 / 360
+                   a1= round $ cos(angle*pi/360) * 255
+                   a2= round $ sin(angle*pi/360/2) * 64
+               
+               graphicsContextTranslate c (1.5 * 40 * cos ( angle * 2 * pi / 360 ) ) (1.5 * 40 * sin( angle * 2 *pi/360) )
+       
+               graphicsContextRotate c (angle * 2 * pi / 360)
+               
+               withBrushStyle (BrushStyle BrushSolid (colorRGBA a a1 a2 (64 :: Int))) $ \br -> do
+                 --dcSetBrush dc br
+                 graphicsContextSetBrush c br
+                 withPenStyle (penColored (colorRGBA a a1 a2 128) 1) $ \pn -> do
+                   --dcSetPen dc pn
+                   graphicsContextSetPen c pn
+                   graphicsContextDrawPath c p 1
+
+               graphicsContextPopState c
+
+           graphicsPathDelete p  
+           gcdcDelete dc