Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv4266/gio/src/examples/simple
Modified Files:
BitmapViewer.hs
Log Message:
The InputFileDialog, OutputFileDialog and SelectDirectory dialogs has extended functionality
Index: BitmapViewer.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/BitmapViewer.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** BitmapViewer.hs 25 Apr 2003 06:56:28 -0000 1.4
--- BitmapViewer.hs 26 Apr 2003 10:00:50 -0000 1.5
***************
*** 3,6 ****
--- 3,12 ----
import Graphics.UI.GIO
+ codecsToFilesFilter :: [Codec] -> [(String,[String])]
+ codecsToFilesFilter = map codeToFileFilter
+ where
+ codeToFileFilter :: Codec -> (String,[String])
+ codeToFileFilter codec = (codecDescr codec,map (\e->"*."++e) (codecExtensions codec))
+
main
= start MDI [title =: "Bitmap Viewer"] $
***************
*** 15,33 ****
where
cmdopen mclose
! = do mbfname <- runInputFileDialog
! case mbfname of
! Nothing -> return ()
! Just fname -> do bitmap <- readBitmap fname []
! bmpSize <- get bitmap size
! w <- window [ title =: fname
! , domain =: bmpSize
! , view =: sz 300 300
! , on paint =: paintImage bitmap
! ]
! set mclose [enabled =: True, on command =: cmdclose w mclose]
! set w [ on activate =: set mclose [enabled =: True, on command =: cmdclose w mclose]
! , on deactivate =: set mclose [enabled =: False, off command]
! ]
! return ()
cmdclose w mclose
--- 21,27 ----
where
cmdopen mclose
! = do codes <- getAvailableCodecs
! fnames <- runInputFilesDialog "Open" (codecsToFilesFilter codes)
! mapM_ (openBitmapWindow mclose) fnames
cmdclose w mclose
***************
*** 37,39 ****
paintImage image can updFrame updAreas
! = do bitmap (pt 0 0) image can
\ No newline at end of file
--- 31,46 ----
paintImage image can updFrame updAreas
! = do bitmap (pt 0 0) image can
!
! openBitmapWindow mclose fname = do
! bitmap <- readBitmap fname []
! bmpSize <- get bitmap size
! w <- window [ title =: fname
! , domain =: bmpSize
! , view =: sz 300 300
! , on paint =: paintImage bitmap
! ]
! set mclose [enabled =: True, on command =: cmdclose w mclose]
! set w [ on activate =: set mclose [enabled =: True, on command =: cmdclose w mclose]
! , on deactivate =: set mclose [enabled =: False, off command]
! ]
|
