glade-0.12.1/0000755000000000000000000000000011633370304011035 5ustar0000000000000000glade-0.12.1/Setup.hs0000644000000000000000000000050411633370304012470 0ustar0000000000000000-- Standard setup file for a Gtk2Hs module. -- -- See also: -- * SetupMain.hs : the real Setup script for this package -- * Gtk2HsSetup.hs : Gtk2Hs-specific boilerplate -- * SetupWrapper.hs : wrapper for compat with various ghc/cabal versions import SetupWrapper ( setupWrapper ) main = setupWrapper "SetupMain.hs" glade-0.12.1/SetupWrapper.hs0000644000000000000000000001427711633370304014045 0ustar0000000000000000-- A wrapper script for Cabal Setup.hs scripts. Allows compiling the real Setup -- conditionally depending on the Cabal version. module SetupWrapper (setupWrapper) where import Distribution.Package import Distribution.Compiler import Distribution.Simple.Utils import Distribution.Simple.Program import Distribution.Simple.Compiler import Distribution.Simple.BuildPaths (exeExtension) import Distribution.Simple.Configure (configCompiler) import Distribution.Simple.GHC (getInstalledPackages) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Version import Distribution.Verbosity import Distribution.Text import System.Environment import System.Process import System.Exit import System.FilePath import System.Directory import qualified Control.Exception as Exception import System.IO.Error (isDoesNotExistError) import Data.List import Data.Char import Control.Monad setupWrapper :: FilePath -> IO () setupWrapper setupHsFile = do args <- getArgs createDirectoryIfMissingVerbose verbosity True setupDir compileSetupExecutable invokeSetupScript args where setupDir = "dist/setup-wrapper" setupVersionFile = setupDir "setup" <.> "version" setupProgFile = setupDir "setup" <.> exeExtension setupMacroFile = setupDir "wrapper-macros.h" useCabalVersion = Version [1,8] [] usePackageDB = [GlobalPackageDB, UserPackageDB] verbosity = normal cabalLibVersionToUse comp conf = do savedVersion <- savedCabalVersion case savedVersion of Just version -> return version _ -> do version <- installedCabalVersion comp conf writeFile setupVersionFile (show version ++ "\n") return version savedCabalVersion = do versionString <- readFile setupVersionFile `Exception.catch` \e -> if isDoesNotExistError e then return "" else Exception.throwIO e case reads versionString of [(version,s)] | all isSpace s -> return (Just version) _ -> return Nothing installedCabalVersion comp conf = do index <- getInstalledPackages verbosity usePackageDB conf let cabalDep = Dependency (PackageName "Cabal") (orLaterVersion useCabalVersion) case PackageIndex.lookupDependency index cabalDep of [] -> die $ "The package requires Cabal library version " ++ display useCabalVersion ++ " but no suitable version is installed." pkgs -> return $ bestVersion (map fst pkgs) where bestVersion = maximumBy (comparing preference) preference version = (sameVersion, sameMajorVersion ,stableVersion, latestVersion) where sameVersion = version == cabalVersion sameMajorVersion = majorVersion version == majorVersion cabalVersion majorVersion = take 2 . versionBranch stableVersion = case versionBranch version of (_:x:_) -> even x _ -> False latestVersion = version -- | If the Setup.hs is out of date wrt the executable then recompile it. -- Currently this is GHC only. It should really be generalised. -- compileSetupExecutable = do setupHsNewer <- setupHsFile `moreRecentFile` setupProgFile cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile let outOfDate = setupHsNewer || cabalVersionNewer when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." (comp, conf) <- configCompiler (Just GHC) Nothing Nothing defaultProgramConfiguration verbosity cabalLibVersion <- cabalLibVersionToUse comp conf let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion writeFile setupMacroFile (generateVersionMacro cabalLibVersion) rawSystemProgramConf verbosity ghcProgram conf $ ["--make", setupHsFile, "-o", setupProgFile] ++ ghcPackageDbOptions usePackageDB ++ ["-package", display cabalPkgid ,"-cpp", "-optP-include", "-optP" ++ setupMacroFile ,"-odir", setupDir, "-hidir", setupDir] where ghcPackageDbOptions dbstack = case dbstack of (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs (GlobalPackageDB:dbs) -> "-no-user-package-conf" : concatMap specific dbs _ -> ierror where specific (SpecificPackageDB db) = [ "-package-conf", db ] specific _ = ierror ierror = error "internal error: unexpected package db stack" generateVersionMacro :: Version -> String generateVersionMacro version = concat ["/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ,"#define CABAL_VERSION_CHECK(major1,major2,minor) (\\\n" ," (major1) < ",major1," || \\\n" ," (major1) == ",major1," && (major2) < ",major2," || \\\n" ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" ,"\n\n" ] where (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0) invokeSetupScript :: [String] -> IO () invokeSetupScript args = do info verbosity $ unwords (setupProgFile : args) process <- runProcess (currentDir setupProgFile) args Nothing Nothing Nothing Nothing Nothing exitCode <- waitForProcess process unless (exitCode == ExitSuccess) $ exitWith exitCode moreRecentFile :: FilePath -> FilePath -> IO Bool moreRecentFile a b = do exists <- doesFileExist b if not exists then return True else do tb <- getModificationTime b ta <- getModificationTime a return (ta > tb) glade-0.12.1/Gtk2HsSetup.hs0000644000000000000000000004545211633370304013526 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifndef CABAL_VERSION_CHECK #error This module has to be compiled via the Setup.hs program which generates the gtk2hs-macros.h file #endif -- | Build a Gtk2hs package. -- module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages, checkGtk2hsBuildtools ) where import Distribution.Simple import Distribution.Simple.PreProcess import Distribution.InstalledPackageInfo ( importDirs, showInstalledPackageInfo, libraryDirs, extraLibraries, extraGHCiLibraries ) import Distribution.Simple.PackageIndex ( lookupInstalledPackageId ) import Distribution.PackageDescription as PD ( PackageDescription(..), updatePackageDescription, BuildInfo(..), emptyBuildInfo, allBuildInfo, Library(..), libModules, hasLibs) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), InstallDirs(..), componentPackageDeps, absoluteInstallDirs) import Distribution.Simple.Compiler ( Compiler(..) ) import Distribution.Simple.Program ( Program(..), ConfiguredProgram(..), rawSystemProgramConf, rawSystemProgramStdoutConf, programName, programPath, c2hsProgram, pkgConfigProgram, gccProgram, requireProgram, ghcPkgProgram, simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg) import Distribution.ModuleName ( ModuleName, components, toFilePath ) import Distribution.Simple.Utils import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..), defaultCopyFlags, ConfigFlags(configVerbosity), fromFlag, toFlag, RegisterFlags(..), flagToMaybe, fromFlagOrDefault, defaultRegisterFlags) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Install ( install ) import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) import Distribution.Text ( simpleParse, display ) import System.FilePath import System.Exit (exitFailure) import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist ) import Distribution.Version (Version(..)) import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList ) import Data.List (isPrefixOf, isSuffixOf, nub) import Data.Char (isAlpha) import qualified Data.Map as M import qualified Data.Set as S import Control.Applicative ((<$>)) -- the name of the c2hs pre-compiled header file precompFile = "precompchs.bin" gtk2hsUserHooks = simpleUserHooks { hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal], hookedPreProcessors = [("chs", ourC2hs)], confHook = \pd cf -> (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)), postConf = \args cf pd lbi -> do genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi postConf simpleUserHooks args cf pd lbi, buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd -> buildHook simpleUserHooks pd lbi uh bf, copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >> installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)), instHook = \pd lbi uh flags -> #if defined(mingw32_HOST_OS) || defined(__MINGW32__) installHook pd lbi uh flags >> installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest, regHook = registerHook #else instHook simpleUserHooks pd lbi uh flags >> installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest #endif } ------------------------------------------------------------------------------ -- Lots of stuff for windows ghci support ------------------------------------------------------------------------------ getDlls :: [FilePath] -> IO [FilePath] getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$> mapM getDirectoryContents dirs fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> case filter (("lib" ++ lib) `isPrefixOf`) dlls of dll:_ -> [dropExtension dll] _ -> if lib == "z" then [] else [lib] -- The following code is a big copy-and-paste job from the sources of -- Cabal 1.8 just to be able to fix a field in the package file. Yuck. installHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO () installHook pkg_descr localbuildinfo _ flags = do let copyFlags = defaultCopyFlags { copyDistPref = installDistPref flags, copyDest = toFlag NoCopyDest, copyVerbosity = installVerbosity flags } install pkg_descr localbuildinfo copyFlags let registerFlags = defaultRegisterFlags { regDistPref = installDistPref flags, regInPlace = installInPlace flags, regPackageDB = installPackageDB flags, regVerbosity = installVerbosity flags } when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags registerHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> RegisterFlags -> IO () registerHook pkg_descr localbuildinfo _ flags = if hasLibs pkg_descr then register pkg_descr localbuildinfo flags else setupMessage verbosity "Package contains no library to register:" (packageId pkg_descr) where verbosity = fromFlag (regVerbosity flags) register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () register pkg@PackageDescription { library = Just lib } lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags = do installedPkgInfoRaw <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw) installedPkgInfo = installedPkgInfoRaw { extraGHCiLibraries = libs } -- Three different modes: case () of _ | modeGenerateRegFile -> die "Generate Reg File not supported" | modeGenerateRegScript -> die "Generate Reg Script not supported" | otherwise -> registerPackage verbosity installedPkgInfo pkg lbi inplace #if CABAL_VERSION_CHECK(1,10,0) packageDbs #else packageDb #endif where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags) packageDbs = nub $ withPackageDB lbi ++ maybeToList (flagToMaybe (regPackageDB regFlags)) packageDb = registrationPackageDB packageDbs distPref = fromFlag (regDistPref regFlags) verbosity = fromFlag (regVerbosity regFlags) register _ _ regFlags = notice verbosity "No package to register" where verbosity = fromFlag (regVerbosity regFlags) ------------------------------------------------------------------------------ -- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later ------------------------------------------------------------------------------ adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo adjustLocalBuildInfo lbi = let extra = (Just libBi, []) libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi , buildDir lbi ] } in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) } ------------------------------------------------------------------------------ -- Processing .chs files with our local c2hs. ------------------------------------------------------------------------------ ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor ourC2hs bi lbi = PreProcessor { platformIndependent = False, runPreProcessor = runC2HS bi lbi } runC2HS :: BuildInfo -> LocalBuildInfo -> (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO () runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do -- have the header file name if we don't have the precompiled header yet header <- case lookup "x-c2hs-header" (customFieldsBI bi) of Just h -> return h Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++ "that sets the C header file to process .chs.pp files.") -- c2hs will output files in out dir, removing any leading path of the input file. -- Thus, append the dir of the input file to the output dir. let (outFileDir, newOutFile) = splitFileName outFile let newOutDir = outDir outFileDir -- additional .chi files might be needed that other packages have installed; -- we assume that these are installed in the same place as .hi files let chiDirs = [ dir | ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi), dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ] (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $ map ("--include=" ++) (outDir:chiDirs) ++ [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ] ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi] ++ ["--output-dir=" ++ newOutDir, "--output=" ++ newOutFile, "--precomp=" ++ buildDir lbi precompFile, header, inDir inFile] getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] getCppOptions bi lbi = nub $ ["-I" ++ dir | dir <- PD.includeDirs bi] ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] installCHI :: PackageDescription -- ^information from the .cabal file -> LocalBuildInfo -- ^information from the configure step -> Verbosity -> CopyDest -- ^flags sent to copy or install -> IO () installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest -- cannot use the recommended 'findModuleFiles' since it fails if there exists -- a modules that does not have a .chi file mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath) (PD.libModules lib) let files = [ f | Just f <- mFiles ] installOrdinaryFiles verbosity libPref files installCHI _ _ _ _ = return () ------------------------------------------------------------------------------ -- Generating the type hierarchy and signal callback .hs files. ------------------------------------------------------------------------------ typeGenProgram :: Program typeGenProgram = simpleProgram "gtk2hsTypeGen" signalGenProgram :: Program signalGenProgram = simpleProgram "gtk2hsHookGenerator" c2hsLocal :: Program c2hsLocal = (simpleProgram "gtk2hsC2hs") { programFindVersion = findProgramVersion "--version" $ \str -> -- Invoking "gtk2hsC2hs --version" gives a string like: -- C->Haskell Compiler, version 0.13.4 (gtk2hs branch) "Bin IO", 13 Nov 2004 case words str of (_:_:_:ver:_) -> ver _ -> "" } genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () genSynthezisedFiles verb pd lbi = do cPkgs <- getPkgConfigPackages verb lbi pd let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd) ++customFieldsPD pd typeOpts :: String -> [ProgArg] typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content) | (field,content) <- xList, tag `isPrefixOf` field, field /= (tag++"file")] ++ [ "--tag=" ++ tag | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs , let name' = filter isAlpha (display name) , tag <- name' : [ name' ++ "-" ++ show major ++ "." ++ show digit | digit <- [0,2..minor] ] ] signalsOpts :: [ProgArg] signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content) | (field,content) <- xList, "x-signals-" `isPrefixOf` field, field /= "x-signals-file"] genFile :: Program -> [ProgArg] -> FilePath -> IO () genFile prog args outFile = do res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args rewriteFile outFile res forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $ \(fileTag, f) -> do let tag = reverse (drop 4 (reverse fileTag)) info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.") genFile typeGenProgram (typeOpts tag) f case lookup "x-signals-file" xList of Nothing -> return () Just f -> do info verb ("Ensuring that callback hooks in "++f++" are up-to-date.") genFile signalGenProgram signalsOpts f --FIXME: Cabal should tell us the selected pkg-config package versions in the -- LocalBuildInfo or equivalent. -- In the mean time, ask pkg-config again. getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId] getPkgConfigPackages verbosity lbi pkg = sequence [ do version <- pkgconfig ["--modversion", display pkgname] case simpleParse version of Nothing -> die "parsing output of pkg-config --modversion failed" Just v -> return (PackageIdentifier pkgname v) | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ] where pkgconfig = rawSystemProgramStdoutConf verbosity pkgConfigProgram (withPrograms lbi) ------------------------------------------------------------------------------ -- Dependency calculation amongst .chs files. ------------------------------------------------------------------------------ -- Given all files of the package, find those that end in .chs and extract the -- .chs files they depend upon. Then return the PackageDescription with these -- files rearranged so that they are built in a sequence that files that are -- needed by other files are built first. fixDeps :: PackageDescription -> IO PackageDescription fixDeps pd@PD.PackageDescription { PD.library = Just lib@PD.Library { PD.exposedModules = expMods, PD.libBuildInfo = bi@PD.BuildInfo { PD.hsSourceDirs = srcDirs, PD.otherModules = othMods }}} = do let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs (joinPath (components m)) mExpFiles <- mapM findModule expMods mOthFiles <- mapM findModule othMods -- tag all exposed files with True so we throw an error if we need to build -- an exposed module before an internal modules (we cannot express this) let modDeps = zipWith (ModDep True []) expMods mExpFiles++ zipWith (ModDep False []) othMods mOthFiles modDeps <- mapM extractDeps modDeps let (expMods, othMods) = span mdExposed $ sortTopological modDeps badOther = map (fromMaybe "" . mdLocation) $ filter (not . mdExposed) expMods unless (null badOther) $ die ("internal chs modules "++intercalate "," badOther++ " depend on exposed chs modules; cabal needs to build internal modules first") return pd { PD.library = Just lib { PD.exposedModules = map mdOriginal expMods, PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods } }} data ModDep = ModDep { mdExposed :: Bool, mdRequires :: [ModuleName], mdOriginal :: ModuleName, mdLocation :: Maybe FilePath } instance Show ModDep where show x = show (mdLocation x) instance Eq ModDep where ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2 instance Ord ModDep where compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2 -- Extract the dependencies of this file. This is intentionally rather naive as it -- ignores CPP conditionals. We just require everything which means that the -- existance of a .chs module may not depend on some CPP condition. extractDeps :: ModDep -> IO ModDep extractDeps md@ModDep { mdLocation = Nothing } = return md extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of ('i':'m':'p':'o':'r':'t':' ':ys) -> case simpleParse (takeWhile ('#' /=) ys) of Just m -> findImports (m:acc) xxs Nothing -> die ("cannot parse chs import in "++f++":\n"++ "offending line is {#"++xs) -- no more imports after the first non-import hook _ -> return acc findImports acc (_:xxs) = findImports acc xxs findImports acc [] = return acc mods <- findImports [] (lines con) return md { mdRequires = mods } -- Find a total order of the set of modules that are partially sorted by their -- dependencies on each other. The function returns the sorted list of modules -- together with a list of modules that are required but not supplied by this -- in the input set of modules. sortTopological :: [ModDep] -> [ModDep] sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms) where set = M.fromList (map (\m -> (mdOriginal m, m)) ms) visit (out,visited) m | m `S.member` visited = (out,visited) | otherwise = case m `M.lookup` set of Nothing -> (out, m `S.insert` visited) Just md -> (md:out', visited') where (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md) -- Check user whether install gtk2hs-buildtools correctly. checkGtk2hsBuildtools :: [String] -> IO () checkGtk2hsBuildtools programs = do programInfos <- mapM (\ name -> do location <- programFindLocation (simpleProgram name) normal return (name, location) ) programs let printError name = do putStrLn $ "Cannot find " ++ name ++ "\n" ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)." exitFailure forM_ programInfos $ \ (name, location) -> when (isNothing location) (printError name) glade-0.12.1/hierarchy.list0000644000000000000000000004023111633370304013710 0ustar0000000000000000# This list is the result of a copy-and-paste from the GtkObject hierarchy # html documentation. Deprecated widgets are uncommented. Some additional # object have been defined at the end of the copied list. # The Gtk prefix of every object is removed, the other prefixes are # kept. The indentation implies the object hierarchy. In case the # type query function cannot be derived from the name or the type name # is different, an alternative name and type query function can be # specified by appending 'as typename, '. In case this # function is not specified, the is converted to # gtk__get_type where is where each upperscore # letter is converted to an underscore and lowerletter. The underscore # is omitted if an upperscore letter preceeded: GtkHButtonBox -> # gtk_hbutton_box_get_type. The generation of a type can be # conditional by appending 'if '. Such types are only produces if # --tag= is given on the command line of TypeGenerator. GObject GdkDrawable GdkWindow as DrawWindow, gdk_window_object_get_type # GdkDrawableImplX11 # GdkWindowImplX11 GdkPixmap GdkGLPixmap if gtkglext GdkGLWindow if gtkglext GdkColormap GdkScreen if gtk-2.2 GdkDisplay if gtk-2.2 GdkVisual GdkDevice GtkSettings GtkTextBuffer GtkSourceBuffer if sourceview GtkSourceBuffer if gtksourceview2 GtkTextTag GtkSourceTag if sourceview GtkTextTagTable GtkSourceTagTable if sourceview GtkStyle GtkRcStyle GdkDragContext GdkPixbuf GdkPixbufAnimation GdkPixbufSimpleAnim GdkPixbufAnimationIter GtkTextChildAnchor GtkTextMark GtkSourceMarker if sourceview GtkSourceMark if gtksourceview2 GtkObject GtkWidget GtkMisc GtkLabel GtkAccelLabel GtkTipsQuery if deprecated GtkArrow GtkImage GtkContainer WebKitWebView as WebView, webkit_web_view_get_type if webkit GtkBin GtkAlignment GtkFrame GtkAspectFrame GtkButton GtkToggleButton GtkCheckButton GtkRadioButton GtkColorButton if gtk-2.4 GtkFontButton if gtk-2.4 GtkOptionMenu if deprecated GtkItem GtkMenuItem GtkCheckMenuItem GtkRadioMenuItem GtkTearoffMenuItem GtkImageMenuItem GtkSeparatorMenuItem GtkListItem if deprecated # GtkTreeItem GtkWindow GtkDialog GtkAboutDialog if gtk-2.6 GtkColorSelectionDialog GtkFileSelection GtkFileChooserDialog if gtk-2.4 GtkFontSelectionDialog GtkInputDialog GtkMessageDialog GtkPlug if plugNsocket GtkEventBox GtkHandleBox GtkScrolledWindow GtkViewport GtkExpander if gtk-2.4 GtkComboBox if gtk-2.4 GtkComboBoxEntry if gtk-2.4 GtkToolItem if gtk-2.4 GtkToolButton if gtk-2.4 GtkMenuToolButton if gtk-2.6 GtkToggleToolButton if gtk-2.4 GtkRadioToolButton if gtk-2.4 GtkSeparatorToolItem if gtk-2.4 GtkMozEmbed if mozembed VteTerminal as Terminal if vte GtkBox GtkButtonBox GtkHButtonBox GtkVButtonBox GtkVBox GtkColorSelection GtkFontSelection GtkFileChooserWidget if gtk-2.4 GtkHBox GtkCombo if deprecated GtkFileChooserButton if gtk-2.6 GtkStatusbar GtkCList if deprecated GtkCTree if deprecated GtkFixed GtkPaned GtkHPaned GtkVPaned GtkIconView if gtk-2.6 GtkLayout GtkList if deprecated GtkMenuShell GtkMenu GtkMenuBar GtkNotebook # GtkPacker GtkSocket if plugNsocket GtkTable GtkTextView GtkSourceView if sourceview GtkSourceView if gtksourceview2 GtkToolbar GtkTreeView GtkCalendar GtkCellView if gtk-2.6 GtkDrawingArea GtkEntry GtkSpinButton GtkRuler GtkHRuler GtkVRuler GtkRange GtkScale GtkHScale GtkVScale GtkScrollbar GtkHScrollbar GtkVScrollbar GtkSeparator GtkHSeparator GtkVSeparator GtkInvisible # GtkOldEditable # GtkText GtkPreview if deprecated # Progress is deprecated, ProgressBar contains everything necessary # GtkProgress GtkProgressBar GtkAdjustment GtkIMContext GtkIMMulticontext GtkItemFactory if deprecated GtkTooltips # These object were added by hand because they do not show up in the hierarchy # chart. # These are derived from GtkObject: GtkTreeViewColumn GtkCellRenderer GtkCellRendererPixbuf GtkCellRendererText GtkCellRendererCombo if gtk-2.6 GtkCellRendererToggle GtkCellRendererProgress if gtk-2.6 GtkFileFilter if gtk-2.4 GtkBuilder if gtk-2.12 # These are actually interfaces, but all objects that implement it are at # least GObjects. GtkCellLayout if gtk-2.4 GtkTreeSortable if gtk-2.4 GtkTooltip if gtk-2.12 # These are derived from GObject: GtkStatusIcon if gtk-2.10 GtkTreeSelection GtkTreeModel GtkTreeStore GtkListStore GtkTreeModelSort GtkTreeModelFilter if gtk-2.4 GtkIconFactory GtkIconTheme GtkSizeGroup GtkClipboard if gtk-2.2 GtkAccelGroup GtkAccelMap if gtk-2.4 GtkEntryCompletion if gtk-2.4 GtkAction if gtk-2.4 GtkToggleAction if gtk-2.4 GtkRadioAction if gtk-2.4 GtkActionGroup if gtk-2.4 GtkUIManager if gtk-2.4 GtkWindowGroup GtkSourceLanguage if sourceview GtkSourceLanguage if gtksourceview2 GtkSourceLanguagesManager if sourceview GtkSourceLanguageManager if gtksourceview2 GladeXML as GladeXML, glade_xml_get_type if libglade GConfClient as GConf if gconf # These ones are actualy interfaces, but interface implementations are GObjects GtkEditable GtkSourceStyle as SourceStyleObject if gtksourceview2 GtkSourceStyleScheme if sourceview GtkSourceStyleScheme if gtksourceview2 GtkSourceStyleSchemeManager if gtksourceview2 GtkFileChooser if gtk-2.4 ## This now became a GObject in version 2: GdkGC as GC, gdk_gc_get_type ## These are Pango structures PangoContext as PangoContext, pango_context_get_type if pango PangoLayout as PangoLayoutRaw, pango_layout_get_type if pango PangoFont as Font, pango_font_get_type if pango PangoFontFamily as FontFamily, pango_font_family_get_type if pango PangoFontFace as FontFace, pango_font_face_get_type if pango PangoFontMap as FontMap, pango_font_face_get_type if pango PangoFontset as FontSet, pango_fontset_get_type if pango ## This type is only available for PANGO_ENABLE_BACKEND compiled source ## PangoFontsetSimple as FontSetSimple, pango_fontset_simple_get_type ## GtkGlExt classes GdkGLContext if gtkglext GdkGLConfig if gtkglext GdkGLDrawable if gtkglext ## GnomeVFS classes GnomeVFSVolume as Volume, gnome_vfs_volume_get_type if gnomevfs GnomeVFSDrive as Drive, gnome_vfs_drive_get_type if gnomevfs GnomeVFSVolumeMonitor as VolumeMonitor, gnome_vfs_volume_monitor_get_type if gnomevfs ## GIO classes # Note on all the "as" clauses: the prefix G is unfortunate since it leads # to two consecutive upper case letters which are not translated with an # underscore each (e.g. GConf -> gconf, GtkHButtonBox -> gtk_hbutton_box). # GUnixMountMonitor as UnixMountMonitor, g_unix_mount_monitor_get_type if gio GOutputStream as OutputStream, g_output_stream_get_type if gio GFilterOutputStream as FilterOutputStream, g_filter_output_stream_get_type if gio GDataOutputStream as DataOutputStream, g_data_output_stream_get_type if gio GBufferedOutputStream as BufferedOutputStream, g_buffered_output_stream_get_type if gio # GUnixOutputStream as UnixOutputStream, g_unix_output_stream_get_type if gio GFileOutputStream as FileOutputStream, g_file_output_stream_get_type if gio GMemoryOutputStream as MemoryOutputStream, g_memory_output_stream_get_type if gio GInputStream as InputStream, g_input_stream_get_type if gio # GUnixInputStream as UnixInputStream, g_unix_input_stream_get_type if gio GMemoryInputStream as MemoryInputStream, g_memory_input_stream_get_type if gio GFilterInputStream as FilterInputStream, g_filter_input_stream_get_type if gio GBufferedInputStream as BufferedInputStream, g_buffered_input_stream_get_type if gio GDataInputStream as DataInputStream, g_data_input_stream_get_type if gio GFileInputStream as FileInputStream, g_file_input_stream_get_type if gio # GDesktopAppInfo as DesktopAppInfo, g_desktop_app_info_get_type if gio GFileMonitor as FileMonitor, g_file_monitor_get_type if gio GVfs as Vfs, g_vfs_get_type if gio GMountOperation as MountOperation, g_mount_operation_get_type if gio GThemedIcon as ThemedIcon, g_themed_icon_get_type if gio GEmblem as Emblem, g_emblem_get_type if gio GEmblemedIcon as EmblemedIcon, g_emblemed_icon_get_type if gio GFileEnumerator as FileEnumerator, g_file_enumerator_get_type if gio GFilenameCompleter as FilenameCompleter, g_filename_completer_get_type if gio GFileIcon as FileIcon, g_file_icon_get_type if gio GVolumeMonitor as VolumeMonitor, g_volume_monitor_get_type if gio GCancellable as Cancellable, g_cancellable_get_type if gio GSimpleAsyncResult as SimpleAsyncResult, g_async_result_get_type if gio GFileInfo as FileInfo, g_file_info_get_type if gio GAppLaunchContext as AppLaunchContext, g_app_launch_context_get_type if gio ## these are actually GInterfaces GIcon as Icon, g_icon_get_type if gio GSeekable as Seekable, g_seekable_get_type if gio GAppInfo as AppInfo, g_app_info_get_type if gio GVolume as Volume, g_volume_get_type if gio GAsyncResult as AsyncResult, g_async_result_get_type if gio GLoadableIcon as LoadableIcon, g_loadable_icon_get_type if gio GDrive as Drive, g_drive_get_type if gio GFile noEq as File, g_file_get_type if gio GMount as Mount, g_mount_get_type if gio ## GStreamer classes GstObject as Object, gst_object_get_type if gstreamer GstPad as Pad, gst_pad_get_type if gstreamer GstGhostPad as GhostPad, gst_ghost_pad_get_type if gstreamer GstPluginFeature as PluginFeature, gst_plugin_feature_get_type if gstreamer GstElementFactory as ElementFactory, gst_element_factory_get_type if gstreamer GstTypeFindFactory as TypeFindFactory, gst_type_find_factory_get_type if gstreamer GstIndexFactory as IndexFactory, gst_index_factory_get_type if gstreamer GstElement as Element, gst_element_get_type if gstreamer GstBin as Bin, gst_bin_get_type if gstreamer GstPipeline as Pipeline, gst_pipeline_get_type if gstreamer GstImplementsInterface as ImplementsInterface, gst_implements_interface_get_type if gstreamer GstTagSetter as TagSetter, gst_tag_setter_get_type if gstreamer GstBaseSrc as BaseSrc, gst_base_src_get_type if gstreamer GstPushSrc as PushSrc, gst_push_src_get_type if gstreamer GstBaseSink as BaseSink, gst_base_sink_get_type if gstreamer GstBaseTransform as BaseTransform, gst_base_transform_get_type if gstreamer GstPlugin as Plugin, gst_plugin_get_type if gstreamer GstRegistry as Registry, gst_registry_get_type if gstreamer GstBus as Bus, gst_bus_get_type if gstreamer GstClock as Clock, gst_clock_get_type if gstreamer GstAudioClock as AudioClock, gst_audio_clock_get_type if gstreamer GstSystemClock as SystemClock, gst_system_clock_get_type if gstreamer GstNetClientClock as NetClientClock, gst_net_client_clock_get_type if gstreamer GstIndex as Index, gst_index_get_type if gstreamer GstPadTemplate as PadTemplate, gst_pad_template_get_type if gstreamer GstTask as Task, gst_task_get_type if gstreamer GstXML as XML, gst_xml_get_type if gstreamer GstChildProxy as ChildProxy, gst_child_proxy_get_type if gstreamer GstCollectPads as CollectPads, gst_collect_pads_get_type if gstreamer ## these are actually GInterfaces GstURIHandler as URIHandler, gst_uri_handler_get_type if gstreamer GstAdapter as Adapter, gst_adapter_get_type if gstreamer GstController as Controller, gst_controller_get_type if gstreamer WebKitWebFrame as WebFrame, webkit_web_frame_get_type if webkit WebKitWebSettings as WebSettings, webkit_web_settings_get_type if webkit WebKitNetworkRequest as NetworkRequest, webkit_network_request_get_type if webkit WebKitNetworkResponse as NetworkResponse, webkit_network_response_get_type if webkit WebKitDownload as Download, webkit_download_get_type if webkit WebKitWebBackForwardList as WebBackForwardList, webkit_web_back_forward_list_get_type if webkit WebKitWebHistoryItem as WebHistoryItem, webkit_web_history_item_get_type if webkit WebKitWebInspector as WebInspector, webkit_web_inspector_get_type if webkit WebKitHitTestResult as HitTestResult, webkit_hit_test_result_get_type if webkit WebKitSecurityOrigin as SecurityOrigin, webkit_security_origin_get_type if webkit WebKitSoupAuthDialog as SoupAuthDialog, webkit_soup_auth_dialog_get_type if webkit WebKitWebDatabase as WebDatabase, webkit_web_database_get_type if webkit WebKitWebDataSource as WebDataSource, webkit_web_data_source_get_type if webkit WebKitWebNavigationAction as WebNavigationAction, webkit_web_navigation_action_get_type if webkit WebKitWebPolicyDecision as WebPolicyDecision, webkit_web_policy_decision_get_type if webkit WebKitWebResource as WebResource, webkit_web_resource_get_type if webkit WebKitWebWindowFeatures as WebWindowFeatures, webkit_web_window_features_get_type if webkit glade-0.12.1/glade.cabal0000644000000000000000000000557411633370304013110 0ustar0000000000000000Name: glade Version: 0.12.1 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team Author: Manuel M T Chakravarty, Duncan Coutts Maintainer: gtk2hs-users@sourceforge.net Build-Type: Custom Cabal-Version: >= 1.8 Stability: provisional homepage: http://projects.haskell.org/gtk2hs/ bug-reports: http://hackage.haskell.org/trac/gtk2hs/ Synopsis: Binding to the glade library. Description: This library allows to load externally stored user interfaces into programs. This allows alteration of the interface without recompilation of the program. . Note that this functionality is now provided in gtk directly (as of version 2.12 of the gtk+ C lib) by the Graphics.UI.Gtk.Builder module. Category: Graphics Tested-With: GHC == 6.10.4, GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1 Extra-Source-Files: SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs hierarchy.list x-Types-File: Graphics/UI/Gtk/Glade/Types.chs x-Types-ModName: Graphics.UI.Gtk.Glade.Types x-Types-Forward: *Graphics.UI.GtkInternals x-Types-Destructor: objectUnrefFromMainloop x-Types-Hierarchy: hierarchy.list Data-Dir: demo Data-Files: calc/calc.glade calc/Calc.hs calc/CalcModel.hs calc/Makefile glade/GladeTest.hs glade/Makefile glade/simple.glade noughty/Cross.png noughty/License noughty/Makefile noughty/Nought.png noughty/noughty.glade noughty/NoughtyGlade.hs noughty/Noughty.hs profileviewer/Makefile profileviewer/ParseProfile.hs profileviewer/ProfileViewer.glade profileviewer/ProfileViewer.gladep profileviewer/ProfileViewer.hs scaling/London_Eye.jpg scaling/Makefile scaling/Mountains.jpg scaling/scaling.glade scaling/Scaling.hs scaling/Stones.jpg Source-Repository head type: darcs location: http://code.haskell.org/glade/ Library build-depends: base >= 4 && < 5, glib >= 0.12 && < 0.13, gtk >= 0.12 && < 0.13 build-tools: gtk2hsC2hs >= 0.13.5, gtk2hsHookGenerator, gtk2hsTypeGen exposed-modules: Graphics.UI.Gtk.Glade other-modules: Graphics.UI.Gtk.Glade.Types extensions: ForeignFunctionInterface x-c2hs-Header: glade/glade.h x-Types-Tag: libglade pkgconfig-depends: libglade-2.0 >= 2.0.0 glade-0.12.1/SetupMain.hs0000644000000000000000000000076311633370304013304 0ustar0000000000000000-- The real Setup file for a Gtk2Hs package (invoked via the SetupWrapper). -- It contains only adjustments specific to this package, -- all Gtk2Hs-specific boilerplate is kept in Gtk2HsSetup.hs -- which should be kept identical across all packages. -- import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools ) import Distribution.Simple ( defaultMainWithHooks ) main = do checkGtk2hsBuildtools ["gtk2hsC2hs", "gtk2hsTypeGen", "gtk2hsHookGenerator"] defaultMainWithHooks gtk2hsUserHooks glade-0.12.1/COPYING0000644000000000000000000006351011633370304012075 0ustar0000000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! glade-0.12.1/Graphics/0000755000000000000000000000000011633370304012575 5ustar0000000000000000glade-0.12.1/Graphics/UI/0000755000000000000000000000000011633370304013112 5ustar0000000000000000glade-0.12.1/Graphics/UI/Gtk/0000755000000000000000000000000011633370304013637 5ustar0000000000000000glade-0.12.1/Graphics/UI/Gtk/Glade.chs0000644000000000000000000001203111633370304015347 0ustar0000000000000000{-# LANGUAGE CPP #-} -- GIMP Toolkit (GTK) Binding for Haskell: binding to Libglade -*-haskell-*- -- for loading XML widget specifications -- -- Author : Manuel M T Chakravarty -- Created: 13 March 2002 -- -- Copyright (c) 2002 Manuel M T Chakravarty -- Modified 2003, 2005 by Duncan Coutts (gtk2hs port) -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Library General Public -- License as published by the Free Software Foundation; either -- version 2 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Library General Public License for more details. -- -- Notes: -- -- glade_xml_signal_autoconnect() is not supported. The C variant is not -- suitable for Haskell as -rdynamic leads to huge executable and we -- usually don't want to connect staticly named functions, but closures. -- -- glade_xml_construct() is not bound, as it doesn't seem to be useful -- in Haskell. As usual, the signal_connect_data variant for -- registering signal handlers isn't bound either. Moreover, the -- connect_full functions are not bound. -- -- | -- -- Libglade facilitates loading of XML specifications of whole widget trees -- that have been interactively designed with the GUI builder Glade. The -- present module exports operations for manipulating 'GladeXML' objects. -- -- * This binding does not support Libglade functionality that is exclusively -- meant for extending Libglade with new widgets. Like new widgets, such -- functionality is currently expected to be implemented in C. -- module Graphics.UI.Gtk.Glade ( -- * Data types -- GladeXMLClass, GladeXML, -- * Creation operations -- xmlNew, xmlNewWithRootAndDomain, -- * Obtaining widget handles -- xmlGetWidget, xmlGetWidgetRaw ) where import Control.Monad (liftM) import Control.Exception (evaluate) import System.Glib.FFI import System.Glib.GType import Graphics.UI.Gtk.Abstract.Object (makeNewObject) import System.Glib.GObject (wrapNewGObject) {#import Graphics.UI.Gtk.Glade.Types#} import System.Glib.GList {#context lib="glade" prefix ="glade"#} -- | Create a new XML object (and the corresponding widgets) from the given -- XML file. -- -- This corresponds to 'xmlNewWithRootAndDomain', but without the ability -- to specify a root widget or translation domain. -- xmlNew :: FilePath -> IO (Maybe GladeXML) xmlNew file = withCString file $ \strPtr1 -> do xmlPtr <- {#call unsafe xml_new#} strPtr1 nullPtr nullPtr if xmlPtr==nullPtr then return Nothing else liftM Just $ wrapNewGObject mkGladeXML (return xmlPtr) -- | Create a new GladeXML object (and the corresponding widgets) from the -- given XML file. -- -- Optionally it will only build the interface from the widget -- node @root@ (if it is not 'Nothing'). This feature is useful if you only -- want to build say a toolbar or menu from the XML file, but not the window -- it is embedded in. -- -- Note also that the XML parse tree is cached to speed up creating another -- 'GladeXML' object for the same file. -- xmlNewWithRootAndDomain :: FilePath -- ^ the XML file name. -> Maybe String -- ^ @root@ - the widget node in fname to start building -- from (or 'Nothing') -> Maybe String -- ^ @domain@ - the translation domain for the XML file (or -- 'Nothing' for default) -> IO (Maybe GladeXML) xmlNewWithRootAndDomain file rootWidgetName domain = maybeNull (wrapNewGObject mkGladeXML) $ withCString file $ \filePtr -> maybeWith withCString rootWidgetName $ \rootWidgetNamePtr -> maybeWith withCString domain $ \domainPtr -> {# call unsafe xml_new #} filePtr rootWidgetNamePtr domainPtr -- | Get the widget that has the given name in -- the interface description. If the named widget cannot be found -- or is of the wrong type the result is an error. -- xmlGetWidget :: (WidgetClass widget) => GladeXML -> (GObject -> widget) -- ^ a dynamic cast function that returns the type of -- object that you expect, eg castToButton -> String -- ^ the second parameter is the ID of the widget in -- the glade xml file, eg \"button1\". -> IO widget xmlGetWidget xml cast name = do maybeWidget <- xmlGetWidgetRaw xml name case maybeWidget of Just widget -> evaluate (cast (toGObject widget)) --the cast will return an error if the object is of the wrong type Nothing -> fail $ "glade.xmlGetWidget: no object named " ++ show name ++ " in the glade file" -- | Like 'xmlGetWidget' but it does not do any casting and if the named -- widget is not found then the result is 'Nothing' rather than an error. -- xmlGetWidgetRaw :: GladeXML -> String -> IO (Maybe Widget) xmlGetWidgetRaw xml name = maybeNull (makeNewObject mkWidget) $ withCString name $ \namePtr -> do {# call unsafe xml_get_widget #} xml namePtr glade-0.12.1/Graphics/UI/Gtk/Glade/0000755000000000000000000000000011633370304014653 5ustar0000000000000000glade-0.12.1/Graphics/UI/Gtk/Glade/Types.chs0000644000000000000000000000577111633370304016470 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Axel Simon -- -- Copyright (C) 2001-2005 Axel Simon -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This file reflects the Gtk+ object hierarchy in terms of Haskell classes. -- -- Note: the mk... functions were originally meant to simply be an alias -- for the constructor. However, in order to communicate the destructor -- of an object to objectNew, the mk... functions are now a tuple containing -- Haskell constructor and the destructor function pointer. This hack avoids -- changing all modules that simply pass mk... to objectNew. -- module Graphics.UI.Gtk.Glade.Types ( module Graphics.UI.GtkInternals, GladeXML(GladeXML), GladeXMLClass, toGladeXML, mkGladeXML, unGladeXML, castToGladeXML, gTypeGladeXML ) where import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) import Foreign.C.Types (CULong, CUInt) import System.Glib.GType (GType, typeInstanceIsA) {#import Graphics.UI.GtkInternals#} {# context lib="gtk" prefix="gtk" #} -- The usage of foreignPtrToPtr should be safe as the evaluation will only be -- forced if the object is used afterwards -- castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String -> (obj -> obj') castTo gtype objTypeName obj = case toGObject obj of gobj@(GObject objFPtr) | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype -> unsafeCastGObject gobj | otherwise -> error $ "Cannot cast object to " ++ objTypeName -- ******************************************************************* GladeXML {#pointer *GladeXML foreign newtype #} deriving (Eq,Ord) mkGladeXML = (GladeXML, objectUnrefFromMainloop) unGladeXML (GladeXML o) = o class GObjectClass o => GladeXMLClass o toGladeXML :: GladeXMLClass o => o -> GladeXML toGladeXML = unsafeCastGObject . toGObject instance GladeXMLClass GladeXML instance GObjectClass GladeXML where toGObject = GObject . castForeignPtr . unGladeXML unsafeCastGObject = GladeXML . castForeignPtr . unGObject castToGladeXML :: GObjectClass obj => obj -> GladeXML castToGladeXML = castTo gTypeGladeXML "GladeXML" gTypeGladeXML :: GType gTypeGladeXML = {# call fun unsafe glade_xml_get_type #} glade-0.12.1/demo/0000755000000000000000000000000011633370304011761 5ustar0000000000000000glade-0.12.1/demo/glade/0000755000000000000000000000000011633370304013035 5ustar0000000000000000glade-0.12.1/demo/glade/simple.glade0000644000000000000000000000756611633370304015342 0ustar0000000000000000 True window1 GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False True False 6 True False 0 True A simple dialog created in Glade False False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 True True True True GTK_RELIEF_NORMAL True 0.5 0.5 0 0 True False 2 True gtk-apply 4 0.5 0.5 0 0 0 False False True Press me! True False GTK_JUSTIFY_LEFT False False 0.5 0.5 0 0 0 False False 0 True True glade-0.12.1/demo/glade/GladeTest.hs0000644000000000000000000000150511633370304015246 0ustar0000000000000000module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade main = do initGUI -- load up the glade file dialogXmlM <- xmlNew "simple.glade" let dialogXml = case dialogXmlM of (Just dialogXml) -> dialogXml Nothing -> error "can't find the glade file \"simple.glade\" \ \in the current directory" -- get a handle on a couple widgets from the glade file window <- xmlGetWidget dialogXml castToWindow "window1" button <- xmlGetWidget dialogXml castToButton "button1" -- do something with the widgets, just to prove it works button `onClicked` putStrLn "button pressed!" window `onDestroy` mainQuit -- show everything widgetShowAll window mainGUI glade-0.12.1/demo/glade/Makefile0000644000000000000000000000024611633370304014477 0ustar0000000000000000 PROG = gladetest SOURCES = GladeTest.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc glade-0.12.1/demo/scaling/0000755000000000000000000000000011633370304013401 5ustar0000000000000000glade-0.12.1/demo/scaling/Mountains.jpg0000644000000000000000000007176011633370304016073 0ustar0000000000000000JFIFC  !"$"$C@" A!1"AQaq2#BR3$brs&CSc&!1AQ"BaRq ?0OoK0]:a$au0GF-qXLoLm+Fk'ƮWڬ\oDiYVg~" _5V`5(k-\Yxm3rXtːx! ~GEWmxe by}Tn)B:m[OZfc&V̺4mU~T-f*'riIɅ`ǭ:-ڌs}Xn%G57b Fpք8VsfP#{ 饁XoY\$]EJh(3 TD: ]lPށc2ږU75_Pz\ՆTPʬJ$/ ˸ iҲ(4!ғa͎Vam07C8r:VİȻ&= n̴eZ2ZQVr"F/4-4؅UMmTZCǥp@5A։ zžV9\hiTtMWW2s}kU`*#d4،/z=*`(V갢#6҈63} " 9j8v:CLjj*,MZ 15a3WGZ FdhX$clP'"5ֈ%V5^%4(XU`yoEL]6׮!fbsX=1*ƌMdz$R+#/0j\S b.nǎ#12ފ5bVz}u޼xVhl܊424nZՁ/5+zT8H Սm4l<-]/fc8|~Nq_/&0([Mυd6" ؚt4)[Q:Z8jЊhrWζpޕTqUgAQ7Z, AF\.Z K>[ $W2)wiJˋPѩ^ +>+&0U\Q&' s{^ ,{Fmʼn7]faCi<"fc\Ɗ5ftR)(_]i$‚apqSգެGJiFw4kYVgX2M:lJ2 %K6[P bKxkV=kTb4 CZj$,0qExX(֊¢E j(گ`E&THI*Փ5Lg>.9#:Hͱ&f?Id*zf*i6xުH-z&ĜֽS{f*6Do4M|6F:).ن1HτdGYAZ_*E/ⱉP6֡-+5̣]JGN`,zWX.ՖVALo)ʫJV|K){Q/)S tog3li>bAm*h߭9ƷҰB[0Ն# П-p`FBم[Td5w9 eT[oZLUb,&XͭVSxPEQmjYj}=6ڬ1ztNQNEBHȅ[Jt\\Q Zl̵ 2(>z d B.\iҷ2[}VM*ƫҌw֕D, W^ƪNXJ:oֻJeTtI )L(˵/ JS'8@Lz0}*VEXުڊP j`EA֐dշ5|VjrԩhGQt[)JԍWuYYjP(d.*oCQHPjj6֨SSQhC13A&T("PTֵaDW8ҬMc`NojmvsV{VӹkLn dC&2u>V"33[ZÁ?Y9#aGB+- +7H:0噪qmI -EȮh$ZW""9jj¡)-^Z yjB+-֪ʁ媶UM KȰ4d7҈)ƣ_F H<ƋDy; םxGYo -+Cڵ@z*md4,K~OUS#af@Ehr47@~!YLLCIcpIn#>lƭ.! i_{O3Nmozk#KW:oު#O\*0WV-^j)$kHZы3L[Z:esBPpyXsVj6TG-hQVA ZfBĖ Z9N eLC=jlQh뗘\1jJUݴ &Djśz8fžXݙkω-Ո+'3X&eDm]XOX,3tӈ_4ڛ 6}UsUս e#7]*鋘.UEZWy1S&6mI6ʍמ4첷0ZȡA{ԙPIZf;u4F[zmP4UTvBMuE뉨 jh"L!m]p55Rd:-mSQ HP XL5C8HiJ-22~HE^f(5 $TbC#4|ZX*QFfLQoZXx(lTn5cgJ-q|O5)nc͔fըmç2~t#aI '{!i12h3( 84"!*jj2DT*.M;KZT8&⑕@zHG PK"m^~CHZ}E^Yhlzljhw`g:l³'ų_]iD9~Hc-I,M2 WäfEִ8TmaMf鬎S.F!jFK[`ÒsHVI{QeFxF'i1ٍ֚{m^Y2FXCЗ G7cZiHti5t*) k"+:akoY/5u$jZH+ ɹgJQ8oeIt_^$MYVʌXUs& hDVAJ:ar릂"VKUիWTRP*o2QmjȀ* կ]zjEN Qj kVUd@ZR'TV6$Z ]j ֦:RDZ5Z1z2Bc[saj,f:y&d)֞ e,|U8,v4 2x"$_F-jT^wDʗcBn%+KLʧe&F_PF`[gfyFd{d+v/Yb.I'̃G$YQD*6d">'HaqZ!d7AYHHPxE 2.sSm;#+);Ad< ߕBaa~f{ lG~* ۀw|),c[C\XOs=Ū±>[S=@4hd;t4ZtE 'Bk\~L4MZd)%wLFMMP;RI el\>M*,`@[ڀ2Xm(ŪTT25dubI=싛ڒ 33ۨ`{6T+E+?'98gc?JbfUV &T`LT'򎖡Cn=I,LZtv'Pk`'rK>[x mgZ+ e2]Lv0? Qb$eZcz)@w*AM;xU P/A]j)QҭjRk֪ŠUg4\I!VkP/'@"G?:_sW?uX,UP֬%vsboQr5XQe .mފQMSo =-}FXիK@XՐj,b„U⮩aګ*F.U & SUF$U΂:VȊWWUduuMpĊte ,j3vV]#ŗԌ6 ~uZ©$H S#Ŷ(/ A[t)};sGrhh\;rA㖇6X>3Jޝ ̣3:Б f(ڋ *lL1S~vjɦ[iFHq33}ZZ_h$1Ds0QDK&EY%r6݅0 MTOvl:/ s,LVf5k\Cf0oT䰹vS`"8 1=-G {Qa\MtFn!lU*@\-'/G6P_1BJTn* ssz؁VCɕEY@:^o`(r#FEZ;6ބJ\N "؆ZR[U0ˎ_,@c>QXxq".8f]j胿+c߼>+;vދv[9U.vj Xv濵$1ά [/QLG؟R3DȞOڪѫ#) E`gPIW"3U5ҫ*3]jNP2 zzmjUe@D@QUjFuaT0}ijU]bP6r€aPv4|ޛAWj=$oFSj,P-V@(VERTU]j[*ENQ]QjY$T/U3/Q956"'hm~}!P4Օ'֨Zj2}NuUnhK.KhC2U;kUgIoWitڇjeH1(m{N&,>#fAfc*zEq+6k?ڙLT`Z׬%ċ[.t4b9sNw&njLbYbUOzǨy3o#!+J!feʬ@@3;([IjGwJ8c(xk_P{V|fkVLiJKi5$S1csV%g(yq[5;+Ahr9d,Qp)$\ST5|,NY ZFQ4JuԪk~t1K'J~%F[V,@b!(]oHM[NUV`j.ɪ)42hJz38Sz!9=ZCtyQ.,9FLŞ&3Nj*zm Tڬ-m+6jڸ YUeDZm{W5YQuǚ֮NJ,hu_-Zi{md&izwI3fVmUv/aC%cb)wī3/nM|E]ڂ_b~v8PFL IUՃ/JaјA$jJfhyhU`74|Z"UW;GWPI.kn! ȶ $zؒe˖<4j.SkV=&aNPjVqDLC+-D\H<ԮQbcY@!X)Xz(oZф6HP$cGܮo@$0&L;Ҏ5&XPX7DL1hɃfA.K̐K޴ׇ_6b$4قbS5GWϘt0qGP})yMnvJ~v+k# VA4xd:#(5Ȍ&bZZL% dz"pwE[u1+W I?zӅ&".+5=Oj.HS,Y0R+{eIM <0 BQ$:̨J˕H/naḷRLzM!hIl 4Faj:ğcQm Z0GF,#H $25LG ?R%lMhb ! v#m|^TkTL:딁 @j^U1>`2o͌Vu$$r܃So!\%"LP|1#`V|w}OzCludm9oLd ,g#Ѵ2G"kuTDt=&VR1j[CԊ?:lhYߡP.iq9ڈX3†EjE:ӭZe~aolrdHz-jPFF̿qC{htānZX4Am*4Enԗ3?j9֑|^꽬hJ7'SpTܨtK`i.nIJf7yfA (xw{ ´fUK1ċ/jSlH\ O׵%)b,3cvvzۧ~dm?ރTttҪXƗwPmQx *!Wekz!G[-"5 \e6:'PRK^;9adFYQoʁ;~TiPsZݫ:ltb\ZAGA3"0vl% \TQ??muj3e<ةJe e0E $˧Am:ՑQS*!^d&QZT P֨&T))oEx6=MfƄ00jǩK v$*l 1% e6Mi]蠊h(E9f(A$-*[Jh;-Wٍ(l CcZvy{suTԅ-؉˕42Cf-,2a%~O4,r=mFRxfQ[ v6Xg@yAiC1-."W\Djz1;;q[ .|SAf ڍy\DyUNpl.2i vUGc18 Ayずվ53]qoz"c+W -ZQEc#顧 |[f5ɭʄkͣI!C洌𘍞ǵbQ4+j*qH۔hk 3r^L8LBh] X)n*ͩ:4VfvkP1rj#(l(]\>$ #jJGL4h *D*@K@h/j蘍nԼ~fj+&d$߭&VJ>'=6 ^]MZ4K'a]$d$1 +y5+ 0FXfQj۔L·F|26x [P*" uftŞAn@?:#5*HƬ-hŒ3}TkYp@ޥpMq^䷊/57 |M|G'4u~`=[pXq#ڂ6WH'%bᯖƶz]pX`ޒ+9\$%EMuHց"aS@ bH-*<Ɋ*.FRrN .ܱ> & *Z6k @Ps[ c`v5$'X ZU8f†S&kՅXTҼO|>^!lygJ#=_2181I"`1rgk?9|#8qo1X_qsa畤IXՏ8_xpapXexHv=ƃ.)Q9#׮̸M9 98&n`F?~kOd g) ~%ǸW|F.Q_'s\篋?spi )qI,x%$MdBKq>5~'L\ɋJ]8RFeȑ+E]in%F?qrz# L[DX ?XRؓ^ ,}:iG8!C^Ee&}<~;#/3bD4kp? Ŏ*%? b$|!K =~|@R-Zg*l-۵.I߅&ODZx=2o⽜퉍 s56\82!I 1?xpV ἃ4 Ё"n={٪8E4tb/oLU~?f$+ wQ} >asklA*"⯅d8\cop>)wFT>)X+tN'8NayqFsy5޾UW_.' ># 8Dl^iG\9Goѧ%G r\g:> &{`}|;HXcI'+ܬ=5T8C]bUa(//+?ZCs Ʀeŀ»\,TWPi~ @\!%W_[Z)pnSe6~?K%'O@Ǿazȸ 8ۇlI6{-upAVSb؂5\\.-q>$HWÿ ?p?i\gy#ĿFbIExC# PAGZ.7JKGF! f-Z,~65mҽ4XXԒT_8<5SkOѥ/H5:_$ 8l[W8HEbGQB8!aU(dpP׸  ãu4#0KŦġ|uJX/F Qwh֟2] 񿧅1yڜ6Cjp ދ 21(|GNBX&Rmnc#]rc\}mVFmBF`֪b.E3)Վ^eo v޴4eFғyU54A)޴ nĂ#no5VFH^֥0Z}kBSmzvgԎ՞04/^,C#[I4r}IU0zwnz)qDoƒ5=LQ>itQֱ)Y7_80n;Vq5R)fE)]i`՞;[rK)R g氰PEnq`Px>-R^1\*y"(^g9joG6dy OE>N3qǿ2> ĸ kYXoJq)ƌ~QTscؖ}Le.I#H޾ki6668&僻L@Q|o_?ČfGa .uXcnDFwrNruq>bsomVqAsapɆ8&oMTEuK~՟#Ƥ2l@ԟ~H_PgfֶQIh瓳ViюQͯR@PыjF֪M8PTցxؘnu*D݁ζR6C_>%2ξ=hGfW6$mnfj\rҚ+M:CbHjk`aDl;y1YF J#U MSk*}1t.Ңzڛ̳nnk^-e|iezLPˣȸ;1Ȍdʣ.bQҴ0Xx-/RIEOMϠ'IZ N`ݫ?IyeFákr\ ` i1[=ni7N#X)l1>PɄpQ5Q`A_`|m\_7~"xb`4{&#|G0sD2K ]mZ_TrTw|$y.C|\} `n-c\Jӳ9tơ*@6=iaᦎh%A$RFE"ᔍ#cD^3# QV]j̄5"EwcIse p nb/޸PȣmMDSM-z06[ f",nzҜO8F,g <|8!]Ѐ 쵨RXz GfW '~_?|EFQ=Gn#8)qCy1תMGc;W:O0،R<$o>SnY!|N%6 |ŒTaPvqfx5|bl8{E9? pS} |Szlu5VhP@ٖr /$<6 Z۵m6 6OHGU+gæ(yYv10-Jn^ԳNr>A&,+ҾmWᘎ+m21?#^ [1I0%=F ~ES|sN+8Ttqo;/>;`LJ&݌>T gcN%عW l31&C8A$JP7$50KbRa}u:Tb.` PC5n jXg|4ߕ?Q m݈EJ"* ̽, m-SViBg%{R.QFH؟'j$6i+eR%,},-v_3o;²$Rt4 %%cn\t]hмf`CZChpExo~sb\BVm/ʡ8vaHFHI-3IyݾMFV`BS׵iR1$\moj d!a=?:$QFcچ 1r;t9Pyjf$]B]͸]+9\^p "gR،#[ډl%Y1 2a^Yο{W,4W[0ăڝsa|HG2}kwҹ-L⇤{[uJL񮹎ib+_1!1w8!de3-݈0RݙbجG"H*+vjޜ! zGv)AڠU?Z[6=r3^6sHbl#P2L4.I-{y%U=hU̹{QkT3+H h %8 C3(!6G|TS!Pd b:Qt5b̯7B8(.4k֟X56aVnh׈LFmmF֧xD&-BT[]-hx_G+a})0#>y'cYkIanq֒a5QՃ3ٵ5G|/񅛉Pd,&3WKX澩|>';l$$ b_!3f$VIb8XCBPDAP]{W?ŞrSI8G$$ lݵ?GpX+6r7 x{o.c_x)$fldn<@!]UnO+ v/G菋f%#39qBG~%bVY Ǹw71`bXau~f}a. $HqEo$jNMLG ؜p M&$Κ9=ՉjI0fR["`ÿqUON@M~ડaEK{{U0e%rҧUlszg81q+7ᦀdNa^@e*mB6hic\NVkQO!>T|wxr,7gW*>1˥AfONjaaxW]|֘߈X $c5S "@{|S&lTUkv+n1eıqaJP]gq5Fxϩqڜ0ـS$y[͡8+}@5ÆOYa[? 7'`3(08`mLr| |Xv/Rw1F67@>5q+22!@Z,Z^)Gʎ-oփI7ޚǐXYu&QH.і͔Z>OYc FT涞7HS)BM:Z|))c%%a|˩\d}X䌰V'8M`&/Qr9}Z76e1fRNc[i8Yvo& ܍vH41˝ŮC0ҟI1|ZS3&tlo\aZgДn9SRR%%[2ک#clwF}K30Qڽ |\V c EMt 'cQ$a,hC[]:+FQdn77B7|« VH F@ EŒS߱ivi9lqmWANKňFoJEjK2/sKfW jlJ[͔FPs_j^,t$>f*@Y5]5 0}aQ\Շ3e~VXZ)'gGz. "eeɅIX.A;k6β_{6[v[ 0"ԍ$KYKOqRK eaړbK1cY[#(9M|w10_->j8L ޢ|ftz0G>!c5F2emڅ94yU7X35f%$uC6 Mq ,fK{_RF/#v5 &ۋ'ìڊ#)zBMsj]W>;pn|c`X(J2 jOs_A~>"S@X9kLd^#Y\)mf_ O_1 P儰8h3߮d:ȚuI zas@.AsR2k6VSzh«KiPb\q KPųkp)ɤ^VK%FT}7#rk/zLfjP 5, ǥMv@YA{i~ M2^Q$`.mKnM։H,1K=i7͛#0IUʹE H;ҴOdE…$z\4'\4I߱fWB]KvީFJE?Ljȡl\"rZ6+ ?Y޶'NR-rV9;V`3Z%xѰ$_o (8g|/R(IHq};-xZF+t O#+H*o{m\˔J[ {bl|ښf`T\gf| +G>[skPҾl.26eVeM)xϠ,Tt <&^uE[;קuL*h1HNtq;AyQ1B@{MI1PO#nc0Ĕ?[ ("%]$н*NC$(KuOTpbLUoLf-v6t45+[ =z|,d74HXeptnm X.PܚoqUܤB7>FtQ^,й'f}n-٦XkUf TmⲖX؅ckj ?WRr"mKemڔ*M4%`sCk_ڀ0̣8W:z+d94uV5v6ӵW =\RHamIӡ+b!Fa}h q2~PiXY0EFKB UZi07daҸY9qN}4ī,!,Ue x *ץ*XPc)ǘmz+0ek2Li*}Z/z6;ڹ.Jf*oz^7 bkŴpzv[/ށ.$:t\+F&1,@C@9oKC{ezV gDhP9s#>Hor\4asXYW6QaO vd6{ۭyw~0$pӪ.U)8P4@R9OP!B:QNh; 7ްĉ+I6j;ZܽY/g=*&RwڒUVI*[#.PH]GeXV ڷJ|mde#266LK"V lm~8"0E"s,ꗊbi}H"!Qz۱ͅ,l`42 ѫ0Z㮔 [>$>OLr]jq a- v7}x+$EگOLBuf6yxd;ՅEF ?I$|@/@6;FX_K/m)$\? T+y Y UUQ%lf8eb/Z_PYV=K\z,,_b:ר%x.@MRO1Ikc4cy7׊6õH Aaԑr֋FW7T/6chc؂$zВ3uUL2y66T]WRkWʠ[(1ktbs0b6C#ZH^4S#[1['@ SO;M51֦Z]`hQiC?O3r/Z3a^W`3H!!׹+bE vJf`B^fETtCW fH kJՙ+]mtq~A)w#0˥d^,Q|̒: >xq0PI* A9okVR?%klkQluv4[5{j5#$Qee 09RUROO5+MŹvkԗ?HTEkaUvP2 }\x4gOO#q ˈ[6]m~׳S?+Ņ+7`D_5l;֏4 <.r74;F#[N:tvؾ7?2Rk,j9Tv"5:K ;'ѓ)f۝除ѿapgURFqyK%{1M;Pl,C^֪fUs:6֨N@^92Z׿A֡ut\e˔~8}߭L^ryEȬ5n62]-ں$ke[~zDeX-՗+Z,?huWp;%۫xK r.[2He'ktvf/m.Җ%_Hk˗NJ 5Dp@7Z|F-P]ikq1HuRA4c#g4W뭁?{-u+utQՉ4@5$) irEsp|AcmPeߛoz[7TvQ2gSUűFBĆ7&k(LeM7QќFU^FSX>ԋCvhzbѭQ 6ˌf}vl-j^IKb{+׾Tc9Xro]ub/.{j-Vj|њ@ٍa׽hʪ@Sd`9mC#f֬2rGǒ4; IܵźS+ʲuEf :_j1elsksB)%}jAȷ@HqE 5ˑcl^$f:ɽ'qAF.Y,HHq7u\[;.4L0ox1Yˉ^Wbvҳ.&2SN6o~זBg_]Gj,x{b46Q~zj)D 8̞|Qnj"1~e`:,ibBa)%ץ3 J`,Ff&L69ltwBzmU (oƏ4 3}38hkK7..c!PF520r+bOHMs6EE?S]UQmRr3IUrO[G d}I[/,*ҔbsڥWR g6EtT!Wt(fyUvn_ /-7M@@4ENcSWv$*R\ƹȩ/ok,@] r7F5.uy;k#-5WpmR[]Gob&3$ꌍz{Z)&EF+`.؎Rʊ͈ZǾW$ e)M;ZT+}JF2N^q{#/F]ǽyѻ! seW7=F^vZWJgU`R7]Hܷ6N*‡pjB:kAI%O rJV(+Xօ8i1ڷBjKb ghTk 5+1b Df?WPw+Lolo嶚mL2de Ҳ0*~l5ds =U\zS d`N&(jPQlv˘uh+#QBiVGh,+՛UN`u\::q!! ECV 5)Z! [\R=50THJS1ڃHTjk MlƸ{T֨XEckNðt&7&ځ$^\WR5S uֈcTiIL*4#Nu\z[J>ݗ(^1Њ 6(G2hmRl 6?Z\cT3.o4͢[JuCJ*W$ֹME\EmED\1Tf YEεn7Xhoֆ?J־bI5ߝM JvK0AmTCޚ03kkn(dnIVI!kJفm3LXzY:!l[iWUMHXu2Fm:S!TСszVYsar r/!/枛̉ <#RVqޢYC(P,tt9yPEmVAP`&RQ^lқ(`$ z 4E LdI`W0ͰqecBL|U6Tgi#*ekR[e 6ƣ7!mj+XuTw9DZb3jLn6.ҳf*o X;-WōT?(}iڭ P EkPZ`,J(9JՉ$_(lT w:Cvחj.2НTzzP{}YL̶5+NSU3 r+~!} %{ԕ[J k?UMG!SUڲȢH͚U*Xj [ n\qm y<_Vcod.;x}ukZXj)$iwޣ-Η\6]osaUE~95ݍ뱭Y&)~QHL߽)&^m:E:qy,Ƒs(aنƗ+fUjrK^]/~Dqڻ5*1=NO"WVKCw (jm\N T$֡yN{(Hb Z3˦QrZ2Ր[cE kҡtH-mJs̗7ڪVFR+]cF\mnP~ScG8k߽kUj +*4pn.7tAk9*2z 4PzJ8yһG)vcaއ4*Um$.@$Uc例ŕ*Az侇,j@tQb3m\Ѡb׌2[ ojؔ؀uz,hR ڹ+*91R!6,OV7&yGf2t%4JE}I=?e0?CP}bzL IJ1W6ǿZf& MRo[ⱬaD̐aS.1,PX69[2]~3qgx" BfXҸ'F!\R6XkkP7iqp*adC C{x9;.eAbx oI5ol4a#$LHf?_K{Va!=coԍFM:^؎!$5@=1kYl4m(9Ns͒5*PjZy.ӧj!tn t&?FTzIރ 桓r ,Nbj}3tQv&`qG6YcNf9}[{x56K׎^˒>e\15慛+H|J"mEu^(S`AIZI'PO|М~ר\۷js[YH؛=ij3'ߥp͗J#ZC5uP$ےF@OsEXB(*.)RMX"FCТ6I,F:=jYBY_[lMtx$p>4$;pk|$QԊ A8@"[kYbm#j:Yn+e-fwUeOJkrVv ns6 *4󕸽 TS2(eq]"tzkޤ5ޛu])5u˥IﮗExxUwMQ~u[NP9UOޫfUNcҪ{u7'ڒ[3^.El4QR;ԅmfULˬ3-e`osFDv'*5hiRfX>f:QD9HFߵ40S4o:oNI8߭vڍ2T&fb@CqFۓ\9GތкX2ǡhT,T UI0 zBkBhq5btQ$i[0\~b5`Lmnoƫ+F~T㨷UG-aT*; c L_ŷ;,h9UE=ڲ4KM4EokrwK2i"h]H l2@{Dɘ.=!b Ysq\xN kIy͍;ernKP}0ܶ; eRKB"hނ-a"i^TByg|JH T\|?d eE:;vo絛klW ksV Q{k}kd7h|JiaNlBZfҾS Y@\K>bZYYXz!<0fe^ݫОV I9M*$wi[AK$y ^ץͮõwQX,; >61%"=t4J2F )֬<&IY(<Rcqv#, ԰?֬~b!:\źSCTǭ>h/a'JT^/"h\3/KZ,Q2  3YlM={\7$@ILZ5Eڰ*? pg 4 /aD8PLޓ/a{X\<Z9V Kx0x$Dm@ڍ<~IsPF@%Bc0P,7IŲKrY+  V *>pEyyS!ٯ`= \6SHUHhScg(-h͓gdR9dbtiUd!C ^Og5!ݦc$1"5+~I2R jv'N֦ߋb \ܺaIbqҳ&'fe>4w p2NqI n6k}"eM| !H ri/ ZN)Ň.+)*zڱ'>g0=h~-9(<*S#1NlN+ы(!:mYO/ ͺhcǓ[_4جBIg(nhq35֧]na>`nډ;䥼޲vr˖K_5dvf7rOov9wڊ#«ֳ"ıhu01PIwN,"\ Zچ|,21-Z^)) j1=(}Ȟdž3hm pfV,+4`W&Sk0=3l*}/*h ED.NCV1J}(.ue {J|ᛇޛ koD,3`Mo0 mV9 ƭoԮroG'!8n155R8^:D-^]~%Fkr-Hֵ=-◚2`cy☆(: p6 %q̤1V ),~h 5a p |8Jfe1J Ƅ~jy=16,IiC7*ѵV!ʳSe>FbIZ4Xn I{5gebt64x܋ldaO3K/Q]A"7If94J5ؘ\G" %o5.0|wkEaUIS:V>'2M(ffHlj|9i68 XjmxBmI;ך"\x6&sZ\)yBocY3/f$][a]޳C"hܙ[S/yo[7گ^_6_LXユyASj\Dr'JmK"}|+#i Z 3v,u>k:LCG+T Yִ )mn[ԔaYO#J@H)lǘ>$e7ўq~(c^'|}(wi:49W ɱBZ0.Toڳf,jo\B5m^4Yr. #]A|zoZeKvCINm.4>I>*0/V8vVl}r1z$b&ѭ)W7c`<[VL톻t{Jږ[(V2MA": a sje`E6tN12 iC_J KXiM!]( ^f JgmkL[[CJI#w$R@If/rb=s6M=94$j/c֊dq-1U/ތDӈ,&]r̬و724rEAkfA̷YU5l{ڎf,|\B2ef+8ݼsWW`ՃdhJ yΦ1+0b6 9vrREߥ*!glade-0.12.1/demo/scaling/London_Eye.jpg0000644000000000000000000010702511633370304016143 0ustar0000000000000000JFIF``ExifII*C    $.' ",#(7),01444'9=82<.342C  2!!22222222222222222222222222222222222222222222222222" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?%_l ZL:I|:ۚ#I`.GKGz%Pwh1KKIAKKE%%:PqKE-'J)hhPRE%PvEb -R@'-Җ(PwR(;KE&)hwRbjLP QKIP JQF( E-NԸ NQF(-RځEhV QKI@!h@(S=(PړPGj(RP)hBъϽ"PŔ昨I4C}I;s֤GME.8Ks TPW*$=)(3bZ)h(Gz Rb (4PEZ(ZC@ŽԴJ(KE RqKE%z()h4(QE(@ ;R@E%@'J)iq@ 4R@  ހJ( `-QHbQKE%'Z^(@ E-%-)\QRRv4ih))Ԇ (Q@XAKӭ% Pzv;W@H+3b+:xMFxJWhđNJrF)$\qKs]]5P*BRڊ?bځJ(4bQF(1E`E% )qGN4v,7S8Ҋv(H,6vV)h;:bqZMJ)vь ڊ\RP; ފ;A!EP0 -4 (QE)hE AFh@@Ţ;P1KE)1Jiq@) /'h1G-%QLAE CRtQ@X) -!m/cHi_JmIQBh;(!F(HzR &o"ՑSPPV"p ٪,k4dsfvRz{WQo q5q Қ1Zn4b掴%Q@)- @QځXm-ch-JZ1KJ:P(bR=(%-途wu斊ފZ1Hb )@)h4Ph(qJ(1E-P; ^`ӨpQv(6u!@XJ)qK@ E- ;KI@ 1KڊQKi  =(R7SqE1E?ah柶E%?m&v]\,3bIΘ7b1EaCu4X^GҖx>>pv5QM\qԠbI=*^F8t@珥( ~%A-XJ(JQKh,&(.(R!(Ҋ^QE(@袀 ){twR (4LR 1Hb`G/JJ`%袌P=(斊h0QKRKRvbu9)ؤ!1F)qF(XJZ\J(QK1 R(LP!1E.)(ҊZ8{Q@ţ4gJZ)\u'jL@\Z1IQ@\ I@槌#zF dxޛw5PԔH&ҹ ;S@#qbO'5#v݊?JLQE6'LQKE2DE.(b֝Hb!bhLQ\Q)qGOa)N(XeQNa)XoGzZ1hQޘQ@Q@j;R@Œފ@ Z(-%0 Qޖ LP)ha0iq.3Nǽ!n(bP; ;,2]h;m.WRZ<%{ 7v!7+ ?tҠBw%; ǽma6Д`ъLRbGa1@XgF)P+ QNa? .F1NP+ LS1NV\Qa1K\Qa1I~)0iRP 1K;PbZ(b1K )ؠRH 6ӀvJʹj@)i\=jM)\j$[hSlm) Ti6q4CB*mi\8JV\V"#TS ӹ-n1RMRdauъ\sF(14R1F)E*bEIF9+1OpRb6qXc&6担1RmqX}O$Ǧ{2cSsQ.]˜O0+97:̮32'Jhȿ*g}mIF}JqJc3Ɗ.ssHUOQDxmMzQ Fڟe&9n;Rm))N$8&6qXcڟLQpQ_Šb{Rb)Bb-.)\,7/=)\v#"mL=BQ>Rce_4s!_e&ʵ.`*eYGG0rQt]>arъ>arF8{RlN$X.i ӸHT}6 cbQޗR) J)) u(Q҂fiT piRR MPh4fG)FVIHE:H4wDDSJԤ{SHr!"jR*!,QyZLSbSF=b@ \R@+I}; )0jL 1Eb<1Oǵ.Em ~LS ;`Ն69cCӱ(Uϯ~=uFvr5)a؎`=1BMHW)Ҳ1̇'dVkA1U(4dfB8@4ꂒm?ql5>L{RB>BZB9Jnw%o4+M+M2HF)yU\ 8-(SƐii@RH҅O574Q#K N SrHvQKb hV6R죘\m*J6SB˫{)6Q/fT ~oe?,LGҮt]R.K>:{RyTtF:O.*a{"FVTyTe]yX7.B 0j.g\\xiv:RKQai4&r|C̣̣2%nMK`y4Fi D6f"▛3@Jx&Z%LZVlNCf0 8/O$4 ]i\v#Fڔ-)Z.;SmN!Fڛo4iV!Fڛm&."IiV FjmxJ: {Uj+ZMԅV)M)Z)4ZdSvՒ•IAvբ#V'J;VįPz<^wW̬sT6g:G+s7'uXec?<,+1tp0OTIt/4,ZnQksDĤN9i1O@ 1RmJbRbivQmmY<9-Oy4s'X_.ajuQ7ׂ+Ԕ?H?SUuK/2 nIQZ鉢Q2_x\"q$"wU+ֺ.dw (?֛'Q'I2=֖<đڔTDDw+Ô'+isٴlQw˜Q^qnYHD9h<'?k1/{{Y\(%f|un2cۡgWvbJZ95E! `#S<|Gj6wo $b$Ŵrr/K/> cR7=HmL.GV<]jWՍ+ˣ˩RbGSbE[@1pj] ]i\⍵&RbmSh7O&M1 Җ)&d[zԂݻw={RN;뎴8]f9ۍ;`jm[#D}sVAoiTk Rqk, ǖcFL#O~ƳRImdf}p䚙ISTp({'K+/h&3+8|olpXGgZ9<$c'@,pbcEk~+CdN 3=qFx`øM!`Tq[:O*(IQ4- 4;ni6 MwCJJiPjMi،3mMޓ&CZLTi U\VGI&LP+ (`P!1NLQLcTsJ'WYSiq4ShYL JGz5UMQ e RjH8YTp*E8b|pes3K%HVe]2Mh NaivөE4{hRSCmKmRb6iBVԖmRzcI, }kHun#yvQֽLmF(QBG?E}Y>׺-xRpʆ#ָXxÑn\q*Ɉmos޼W$FXL3"'l jUrgb69SMkȫ Rv)Ã@4;8:]gb{w):!d.!7%{yhAzEZҨگq~<62Sl$=#FG;@syL3^\73Db d~¸3ʊ&< ^vss`g9d+MO#4k¹b*} b*}죘V!Kڧ JNC Jm.a␊V+N\0Ȧ-0 a\&KD$RR$ei*\QӸ2#y6<'qzTϖx\sm#JQs:VWKBhT-B)Hħ[֦tF .V5-ٚ(# %6q 8=qW k(93ۭBn^/1zqV6qqT"=%OryF|=)iB}LNjs)&1r3ivƚbMpis)`"=}E!iR#6oҚTvBPSJb㸤1"H6Ѷϭ2;!`Q9!-KJO,Q̃g֝Jvvo+3N 1"> 2("zƠ\-#\5Yk6c"R VAYZV*Ri3J BP\4 }85ZB O~5wOm6JS皏s*gEYxo{] =(73"aYzmu8Q@X\dl@_W[TV|U8i$sXdWk9ͳ)ÕY99ԬS>b"&MIqXni3JVm+NR]/7Mcǝiz24 ϰkvY?Nٗu~ғGmE3ZP\Wl~}54{q!Gzlu9*$ ?-W{js0p{kJ^ VjZy x!9S7X2╄H)@J$0QK 1IJaS|`ҚqM/M/vc-!Z5!4T#)L)NE&9rlA6(Ect dqS`ðS :Krs.b$*?]HJ&X O}j4ԹJ`9Q!U<-AX+BkѭE@f#욊uC̪Ou;] Λj|țPS^c^5˻1$^⫗|%cd)28)k/sɊ l2w&r="vaL-Ⲱ\wJ3QQIhw`PqJSJ2)Vi\]ZW(h*Ql Mn?isk_K_g%pIHV4RF~h}ii1E\~\JøKMhў)sH A)79&h(x+'B˳$0i֖B`$RK̑F'< 蔹c 0uv2ʽO(HRM(l`nOP{N2ľhgwIXV`9ȩlMVRȊ6N7g=VVwZq&:ZU48$m\ӷVv`RbZBnwbHi ,AvѶ❸Q +IG\,3MIGӸX*}*j1Ebm) {Tm+1F=QpͼQ ϕheb |(VLhc&)ԟzmQzwm?Q.1O\Vҏ;m% NqKL ;-4zp&)qFhP1KKKK襠P ZZ1@ F)أ捴qH;(ObS\{U&J)LV*A@Zp-R!"8+Ӽ!dl+ͼ+:~+6^=#Vdr{Wm7oۻc{Xd0iRV{Xxi!SJאaD/w=uiQ @9灚e4z5J\Υ55fzϊ#2uݻIa?5sI̳+dYmbxT"_[3iv22}3׹Bjv|mZk派 DiZΝ|TK';޹y{y@bl1 M:v_jiD2=ExxMwUdQ:iʅުvGXƌYe`}2kV̡h~@`3Yç Gf|j;9j÷'+}ҕ]-u[۠% U=eR$XkM[d`$rhNgWSNGmg7/yݡ^"\o&ܕ8ZA(G35|lO8_ƪW-ȊoDW0$B A+úA~&@^y'F8ny'"nI5k̠iԝ^mxM;cLy\7;lC6M\v#Fړmp(?ԄQpRS? .ڊZZ`74a'ACtKkp/ A g"C vU 8jۮ+#ۡQdΤ7QuͼWeckn4&XZ䙀oFֺ<|!3//nDnLױ^yB> Je^zF#rgҷhDȻX#X2# H*s=fi]zRmMFu0wg^c:b6?J~+T 2qLhMui⑆.jH߾ίpрzO՛ jXDd; 9³mr[՜J;˙moTHM0q_[вkcȧڏE4gI? '8i-|#d+ m%]KifMDO 8SЭv_\]9q%J%knOQu m2Ht.Xd%}r?*ŶdbIkXҬsmc%/mlh,DKYV"C&7Oq{- )-Lu T|T$j-[`Pt $0u$H@?=k*I9'ǍK#$3А'/kp)qOK#FړqfB&(pM'z),CmMHG\,C.;N8H;Uo5+粵# 1?uJud4$[}nA$a`xq5ZURH]ہ vvZ7URZeoI 8I]- i^jBtwYlDc̏-1'3HO7,a{Fw-nn}7w-Ѯ#!m#2ISI#Ɲvӳظjglͼ2#0?wIሥ>heRa=R[ Q]]$t\3o͂Jfhd nMZdcZQv5dO"hJyċn8y "q#kz:~1o2;qsPx[KrAt|+)JQj>E+nOB Q?vNnjT[fvLf:,DvA#TWGZb}S48EqWHs1֖%]赯p2J\.8w 1HڣI4d!d1ӎ}hAq2E.M64 Psڗ4fEPRwZ`0MԤRL.G+O;ڗͨh|̛`ŐdqUJbТooZv|Ŏ=hۚQ€©jQ)M\Fjޞ$YJe8|G=hc'($Qb&iõ@SsVcOFG +}?ze+YH3kRV)ת#-u{yʗV?c_YZx)En|cks׭SbޮǶg پz\ǚs%y.$7nQKnxK@-v Asaslz9xs]oU/&\/C*vg4qt[]EŌ~"cu55弖Aۻ dď9$Ϲ}khXH>kFJLڊmt}Ġ[_jV+9i_1J<N{YgB'fw~5@,LE~''j1<*x5--7u.^碂(&i \RbOATmmf U(ܻJ?J*@? JZ1@ ڌJ\PE))cR"y_#q%xfr|L&AKi D)*1+KZkYKv`sV0~3z!X7gBG)ZQE<D!f=Gúu&dH]y$~xÿl0Ak*P*|ZDe>h5iޞ5;Q zBQ./ܢ)/59Vk!Eˎ=YZ֘31v1Vp#J\8mo Сmx*8[_Xjnu 8pL9qZxt5B0C dXn~C}يXo\YB&n[wlQlx~Y<6ͦclH3 AYx& xP%fg*2N'X+v|e(|>ǽgNeQl8Ð|0M񢕌-Ť#1Q#OZmEks4i|;Jlͧygp0?wZ o.2 PN['n5Uh-FwFִv'ԲIqjYާ u5&q|.H` }kXx ݊+*9!jɿDLez~*N3v2ksuTn;3+d*5@'jƯiwm(!-N Ҳ̑I+, -p6 mf \@=sYplsʴGciJ]ljMsl3p~Z[?h=75X4-QmfPZ1,>89*JSd6K /؀݁Ҫ*ݕ&R25~b=(\)1Jh4vR@8)4~T&;R$A4ۙı=I9& ӠQKIL/z(b J:ڝ+ x ܘLtA2g,د>H=d:\y*ZST.Dݧe/]_8)"G h7zdבjoe{$.1*t/MǬ_.f$fIx)g2iXRc[^lǸ>5}j_ʹx\kNH|q 0ﭑna]Sq3 _eg4<؉eMq~uۘeO3ųv&8$ z&m#nfjq.j#voSڠfsѱ:## zVNftRXq-CohG!.91=zu4US^l2-NIpk<p?LP )X`|g&MKQ(\yDAcoàk^g"UʰھIʤKźu=p ?ֶ.19PM7Pյ5Yл`cW«Ts[cԕ#}=k=,3>99k:!m:yy @LCH=Wy,7 !jI NxVztb%9H#D_0&;Ocj&A\xk<$F,.fӜ'#YxyoJ9 8ʓSӧY)+Ţ/'m91V?-dA/e1c1 ^P*nVe<($tl.ۖG(AR3=lX NdHa6@Д~#*؈I{Kjb +rA* s4NI&}?+1G97cyu0{5jҤjU5?-sRru|-ՄkvҢ{vHщlFrQhѾ5X}Pa=\[Hp5#=@zh,2mI@ѥ-d*kuH<1}}QĭNfc8ۓɮ%̥(j,4i_st}2V} 9\Əj3jFʷ$+Fc<'ױX6[jr 'kzq˜׷ZƌdhN=*S{꥟WmXZ2P|Y voPQqY9tD{s`sjrKXb2%rsUK 藺UvV>IM>ŵ;h 둚gLѬƼ@N=;WC|]KInmIyrrI犞:lʚk!+N?S]Rrr*Rs|>κ\.%Puw k-B/xzi";6$d?ݥ;o;GdI#PdP~e`g Np1/Ϟﴋ$; kWbB2£Ӵ[+J({*e0C=:m%SR "\>jzf6,ZG@~U^u=+N6NԱ4;5c~0k{yEM ߸q\W'{Ci s#RhT8T U+[PJ@&|}+]um1%^h|2p9ayr>PyOy{pTG #zץwc4st4+r!{3tcjMhuiUSYl8n ijZyہ _ʉJ{)A4.n;;4 +nPgֺ;Hg6 62zz|$MA +W(N ?^&o Gmeqsϒ\*7@F;Vr["ܭoȎ:,7j%e؂\vn>"ީu7թnuXӥc^;z`b{gL5.-gDѮO\5|RZD/j}"L$$UAdN;: M@G7X!<e<BEl@&)1vtfx_346r"2Wr;|ZJܜ3j9kds&X eܘHq{Ue~ѻ|˖lsb2QaԼ=izL#%qihq<@*ƫ8SQU.U% S7,[+VKkXQۙMfE$Η2v1Q].4뫹m?Sj+ĭ?"8iZHrԺnaC=XK goޛqk ŜT74Gnl,b-VǷ8f~5ɞ)9-WrR s?4m{فGDFB1GjR7*1U>q8k,-/'k[Y'YLx`7myWq(.ytZ]O(@1!;C{K`uwBԭdYVdRU#4]<+ Ԝl>S]M}CN".K[V3Ao\GUrj wk:gVHHq2$$cjZna c wFSWi> [ˀ [lumB/68Qm 9#; KS™1L+^>&O; \\捠C{qrjEkѕ-ݜ7R[\.P [# i ooVۭek61Y_L.dGPqUƤQ޽ ޜH<.@9v-#Pa)&PO{NG '7Fº:W0Mlćq ߏ֜]uw9&I#.4ֱ"IK[w\`1\r8 Z;=xnz2Q} &5x<sG}Eq.pw[3#V7D}b yGRN:<Ȩ.(Ǖv$}S77FmqINV?.[9m<<,}#nH-|?,o9 sJе >Is 2x1#k!,pAG=۲͝'kѭNSWٞ|*Ɯ34Xe{f"C{ӎ_mЬ?y?SzvW-nm4XFkn5kIdhXB|׿5R|&QFJ[ +6v uM1w (\}'f6$1w" ZRRӑ+YX4}1Upqpjv-p>Vȭ.~Γ(REҫz֕ͧna(C[Ehq-䓊FfJ9Z{Si׫[|G֩$ofTm^PWMQzkY#T|3AJ& վK ӊ֛1t%VA~9X(E߹C ZKC&Γ+7ۦ &ƫԮ:DסhU4(2k̼qkiYZ$.v*ON5j.E'Dzu#7?hPZblS֛=BI٭x CsVV4k$w5:X"#.nӋ:ZɪRȚqInB1lZikblC)&w_j+4b y''}?yưKjr?Zږ&U#-j1'SDOcs"+6Xu @r7pHHpHq 7Zޚ!cn)?dF[\_Ut:ZLm|N3.KBI{Af,X ֡X4Og뵋/cUf[I#-sCҳ'vM)M66c2RbadtQ 6EOª_]KSUFBZ2޷Es÷m۴MˏҺwSƃ9F>.1^_o/ a \7_@\ӤܼT;;Va -9XˌtN1TzgNina*DKLH~ CTrJZ'L񱵴tIdHo`.һ/ S)qmn&,wLsԜrj~9wٮ)?}v.siB2;=Q"Am\h\Q8}ꖳh0l9CGSFAܶIq*&+ȸ%Tfjn_QQNO5h-F{Ȳ[M "m4y2nGo\g9Q|4DjQ"rg9oJԖ?wX 5ûoHC0 Fծj~`70zW\|6/*1[[A*E&,{\=s,E4+[iYNVkz}[ԚԪ+=NMS'405(n[IbG?:CKV.EԢ+Рサ{V9g}BtbH`r9Snj{&9W6\I+O +5jY^w'YoVud2 W1`kqO5KQn i$dgޙm WnA+m|8 iZ$;T7 ,c;L%iOc^Iz|h ]OH5OCZ˧'T"rJx?}^5)/aݝ9鞝_5ǖ c9jax0OR%ZOc#ZyKXD$z9WCM M0kQl2) Cӽy-yI6{=CLk3;0tDiZSۓяb{ƕ,j-U#<+Umrd*cgFܼu󮧩^S˶1/8^I%D6pڝX_cwP.u w2NC|ԁ[^VgJY#>Vt"5<۳0sSI![ll1BrWk2R2G_VoS!G\6.?)+kR5[+j,I<0:+Я-oXxx;17w H$}+u/ΗR>Tԃ3V喗 oyi#G y鎞}GgN0bbZEsf1ޙ?Z֒}WL u}B<ȏ*}3Imp4ҡBF=*X;&IôF$lm|r;y帐i24a@RpGoU{ l̠U^T"˧W=HP8yzȯ]FJO4sߊ&9Y>R?Tn E Ұ I {tׇ-F=GӈHX*0 g sqLıTxbnIb#Lt*.bO&v@>ӭ~ aԓ]YD~b;VBY+0|$*oOSQ CG?+WrG;Oi^"ܜ`PIm?̻ksgdԲď-2n0ֶϙ$Q XknOaTDiK ZVH9'4?ugF*խ2k'Tۑsy: ۅ ]E 0g}Mc{U܍q9Shk-w%jWy?Im Uc +D_gƍ]Pp9Dr0fy ' d՛MQa2 `T%N-lf 8IS8I"ee^Q"NַghfdG[K {0 *ag`K+N6V9 U$MbvZ0rf5\Ɋ2Z1wıjk$i!n y0jƟ2#6CgoXt {f1F$#U@ɻy+ږk|o+ghݝr\G'vTR<3m8sP?Z,'sk´, F5XS`sߴWj?1$ q9 >C4PH`a(ֺ3=Ify[[T'x4ӌi1値\|=Ck+y̒+ +>ށuIwsmrrnOaן۔,?C[t=}rԃkJJm%9/6.4RN`x#{R8TOp8ۊ` b[K49KJ ۩oⴷy-D뎹ޭZZ;iE+gn{,GTl~cy#<5dj7 AxlG;O/'|Ea$60H8+}G˵HUT(ϥ<⯹jWgkl[\/GXN0GC 5cM.' Bdc#5xOǰ~kb(mPxFu;'yL-",P:\WnKFr^"/RW Y`AwMLlR\L O~?1V\SZJ-iueDH\18#8n/ҮlVVBNHǦyN U3i# !n[->&[uOX`B*ʹO|}kmYJ,1v򈱵cˎ9 y<$TbV,Ē3j(eiGV.xj}ʹtmVH/<# 7 yk6_ M4pEhuK;'C1q}mt eqf隕$^{$]!WgmKkxϛo(> sbQ{lSu5wLa+cQ&, $LnWVzm|G >cjD g`cVOb*a)Rc/"WQ)%9z'}BZ$mӖ<Ut7?+o01ùTEQn$3[ا=q]էe8,4,zEi9=;&O wv%If=3C2ukw2m"U :ֵ1{X\n2!\=0j%Z3Ӌ\CnK(0]d!?.j"ۥ6e2 >Z'qw?)cR]G{h%kf_0G^6GOIF:Zw+9'S躵QZ?,k`7skoQ𮢳Lp'86Tp}+Qt-\NVT`rwnYMz$SӲq9{na.%!,z~kRiEaXƺ-A֮4xU.L*2O<+ Hȕ$`ԨIB+8]55!=g+-#v Ȫpk_Inx'9]:j04=AmuCopzZͦ^0S:W:(Vn--}-l*Ĵxwҙ}9h9>ⵆ? mrIl6?+^fK G#8xUӋWTy?mby̤p\[XÏz?&XI) T`u+НFeܲ+I9Z.Ztzqcnt-?u `ҩi:M[^' :IBQus4kvӕGw^o_2 lT9HZ neq1ttSڨg݉f,$yykjMnoNI>V<5/ݹrNh< * mǭI~G#F"dUAKP_,⦎?#=?ZYYQAКMMfj ލ!LM)A>NW5c<~cq=U/N- %T䓞&3ڡS%ڭ9\8Xi`ұ`N.!S+De o2̵:uʔ]6?]BObP0$x6_ \x4IDDhS1#5kmE݄1.1Fcyh !p?,f N{}>٭.X㓑\p\J[w]qS=CuZG^4nQO0NwϿL*nF\nA$SC\F^3y S}MH|iOrтAT2|a֚CPCr>$P7ȼZ+qWg>-[ pc,Jm3:oX$e8׊'RNhCqY+ԟ+OG'wZO əfgZ~?Zu11$c=Ozmn\✷lMKTiE٫}5]:S;vݑ(zFUabr|xqoq$duTwvd*ZLH-kHZI$X^Hb `G\)⮿[KFIb~YKg>P=z[yS 4c;sҵuv+3㒉 {Wβjdx!?}PݗíRk)F)E7DyUQv)[ĞkmԳ'F׊c S+ڽBpw?ZƦIEedjiнN>Y#נG3Bq5?U&di{`Qғ #?,fօ6UU |j-U{$HٗO}XH ד D&aKq_3Yb2Ko1T$pHǧ_zNU9箖0XhYhzj6K?7Js^,6էqcsi0;3WOi@4k=2 5I%o)6913mcRQ֌&2UMv/tuN B\ycoPzS3aړh'jȏޤR G3Kk\M9S÷̐rc ¸4`*/4 89fB4; elH3BlD-c* ϻy CV^K=LSrVLtû"NߔVdmŹc*+$yp ЀHKiSi[c]Eh4{R2[㊴<*ep@iEns0|]$՛{;!!C(#$0ἾY:OZMhYYx9T!]֎$YTRQ2G6:oڤ&d>:gV8e[a+*3y&_~_Eo(0w(f9o]-Lڊ^[CgQX(9#QJFSy[RDs0ΠHFsnÁ?z~Rz39'o5" KHY0?,ZeT~Tƕj\ H\Lӵ@1R}wCpIAx篧תu"Ltd|T1j6'=WS|A6Z]G 0jI=d!L񞘪֭Hn(\UBcmiHudgVz [ش2#8OL梵.9JZr$Fx\}ӏzY3lF>Asq۵@;f6 x֜ZMCsT`۶Jv3э:oinaDXnr~U.Pw_ޤ>2°/m [H%<Vh˿## !nۂxJsSnZ~=_kf6IpyZ(ekڗ3!]B%auHW>3Jt52ԒDEP#35Fy4&)cIZIL,cY>4빎OOqY7=gB oR\ǥ^]8ç?J[CU%~^j9~\d5vҊHҵ@+[ֺ^_uW/sjDWVp&SOs^Ke8<.ߴW8ƒ5M >sdR#zoq*9XO?M|J?+MT{ntṟ%ԊZ= H7@HO;3Uo `~繅"^5L2v:xd;kkGl2)sT"?cr"aڋ;IO.:ZG] Ik'l]f[:$i<#;# ሡ}ɦ_U$1:x䔱L40(> M%ٔe[Q,2>曧j7UN%F2 k5x?I|mץ ]0*Nyc2%xs[뎿„ƁmiT܀=1^ei'r*ST84v5{7-jlչ+QVf̳Z;.m2XKAhn`,mGHGJ׸};`sb[с_xs*lDJJ3dC!mIxyFgb$l:rqbGM'@Tb3>wZYyϦ)#0랔04  i6c>DSJE$ph$ƑCw{:yNh6iтԬu}餐sҚlPЎ5<Krhg_qU#NHa"КgCxZ$B+-NQoQJ4 ώL+O@# 2(!uϱ#RKKpn=kUMIKk]!?3bןkMbndgڲRYlj/(;Y!K \j#ϞpnkYp jtX>б8e19yW|GXZ\}`,OrMkr?Pח1[îvZ.`+p\IU%Ir[QMUDmj }- Qm+F~0fR{"lrzXӇC'Z𭥼w/:؜;<=}'p_:8 C6OUvxeܓ+)TRk o "$>yR@ φX`d*NxzU PPY ,&@8QϹcUĆB)ɑ>#_X}Yk4_%2K}<\ǰ~uhPs *ӨUo n"FY'GY$nCEn6LbH56u?wk#Q, v͹: ] HJ8O9ax^LeD 4b.qӟҶ/dRQLqQ:s5Թ(,[[Gmapd !=s+u}y$iṟ*=1ֽIe#v#W'[aIvs5(.[qK[Ȃ/y#߆ռfH팋oo1lʱ&9^Xj-%§<ͅ#8^e\bU;m%WVWaOcSt4Թ&'Ev~K=U5*nBc]Χw2"npI+V?a>Nk}c(6ξP+'0w">ŀ?59*½U(4dZxq1TZ2֯It~45oC2]OF3[ZA<{S8획noVʏ%9t S 1X~MC&{uḿކ^juCvEo5n;+ȚL2JMt'rŝbU$ J/ ݫ -C}˸B{s]χtMS0 G +!#iu<;EX/d+R˗VFXN*Ңl:3LUo]֓0s^gat]{bTn[٫qt=mNgdu?SV,/KןFsʟCWYL7$B-QP®=>o hJXـOK eP_v.tn(Ђs.:n98<{EzlvӀpM=UEKe$! EХќQ4 (2dqҔQIJ[2}"2q݄dE$N9(Px A4Q@Ǟq4sҊ)]*w!eaЩMK92rzEZ1(OI#^Y:jZ6*p1~cm'_ʊ*GrI#PHD #*6 <CDX*8lEnq\Žn \7W?(&VODIoiyAj7v4L#nr/0eMfsCPkZKd%}[Ɗ*J*Z$ut6gbX>a\IRhuy#Y#@Fv4Q^rwmރ/8Tduַ,hl* EĠ[ʶ˄vD}qU䳱9/og\~+D,mZc$q#mr9UOH[]&:bEѦԛGY<ڕBSqNq]^(m*ۆ39(a'rdhp㌹* nm-.ik t#חJ^h߰m?(RQxGZҁk)=|)>==hI;pnn&+xM%\֧Iz( ZԚ Vı|Ky7Od#E}Z]h./,,?[u4UD?6Z(M{=XQ Ve|0QM_ 'j-]TW-ʟ(i^8"G(܈FXQQE<^*"zaFORIKmI%}Q ^0*Qvg\iX-IWV 9 UKtD+bkNTӈN1vB\"uGҫ!EUZ3ĉZ͈OUi,؟ W)3TE7Sן8%"+ɽ cY~nc;Ͻ9%py5Qou9>hGKآƕC L6k|= h@(mɢƟ 1/ԡ=gV1Z,@9?J+%"EESWg ݒHj u.0qEk?O7-#t:7(I} KؗUS[&+3osHɽ $P82kE-#glade-0.12.1/demo/scaling/scaling.glade0000644000000000000000000001667711633370304016040 0ustar0000000000000000 5 Scale False True GDK_WINDOW_TYPE_HINT_DIALOG False True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK | GDK_ENTER_NOTIFY_MASK 2 True True Width: True 1 2 True True Height: True 1 3 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK | GDK_ENTER_NOTIFY_MASK GTK_BUTTONBOX_END False GTK_PACK_END 5 Seam Carve False True GDK_WINDOW_TYPE_HINT_DIALOG False True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK | GDK_ENTER_NOTIFY_MASK 2 True True Gradient Count: 16 True 1 1 True True Width: 16 True 1 2 True True Height: 16 True 1 3 True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK | GDK_ENTER_NOTIFY_MASK GTK_BUTTONBOX_END False GTK_PACK_END glade-0.12.1/demo/scaling/Makefile0000644000000000000000000000057511633370304015050 0ustar0000000000000000 PROG = scaling SOURCES = Scaling.hs #HCFLAGS = -prof -auto-all # use -fglasgow-exts since older ghc versions don't know about FlexibleContexts HCFLAGS = -O3 -fglasgow-exts #HCFLAGS = -O3 -fvia-C -optc-O3 #HCFLAGS = -O0 -keep-hc-file -keep-s-files -fvia-C $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc glade-0.12.1/demo/scaling/Scaling.hs0000644000000000000000000006560211633370304015326 0ustar0000000000000000{-# OPTIONS -O #-} --- {-# OPTIONS_GHC -XFlexibleContexts #-} see Makefile -- Author: Pawel Bulkowski (pawelb16@gmail.com) -- Thanks to Michal Palka for teaching me Haskell -- Photos by: Magdalena Niedziela -- based on other gtk2hs example applications -- the code is public domain import Graphics.UI.Gtk import Graphics.UI.Gtk.Gdk.EventM import Data.Array.MArray import Data.Array.IO --import Data.Array.IO.Internals import Data.Array.Storable import Data.Bits import Data.Word import Data.Maybe import Data.IORef import Data.Ord import Control.Monad ( when, unless, liftM ) import Control.Monad.Trans ( liftIO ) import Control.Monad.ST import Data.Array.Base ( unsafeWrite, unsafeRead ) import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade import Graphics.UI.Gtk.ModelView as New import Graphics.UI.Gtk.Gdk.GC (gcNew) import System.CPUTime import System.Environment ( getArgs ) import System.Directory ( doesFileExist ) type ArrayType = IOUArray --type ArrayType = StorableArray -- The state and GUI data ImageState = Empty|NonEmpty data State = State { pb :: Pixbuf, is :: ImageState } main = do args <- getArgs case args of [fName] -> do exists <- doesFileExist fName if exists then runGUI fName else putStrLn ("File "++fName++" not found.") _ -> putStrLn "Usage: scaling " runGUI fName = do initGUI window <- windowNew window `onDestroy` mainQuit set window [ windowTitle := "Scaling" , windowResizable := True ] label <- labelNew (Just "Content Aware Image Scaling") vboxOuter <- vBoxNew False 0 vboxInner <- vBoxNew False 5 (mb,miOpen,miSave,miScale, miGradient, miSeamCarve, miQuit) <- makeMenuBar canvas <- drawingAreaNew containerAdd vboxInner canvas -- Assemble the bits set vboxOuter [ containerChild := mb , containerChild := vboxInner ] set vboxInner [ containerChild := label , containerBorderWidth := 10 ] set window [ containerChild := vboxOuter ] -- create the Pixbuf pb <- pixbufNew ColorspaceRgb False 8 256 256 -- Initialize the state state <- newIORef State { pb = pb, is = Empty } let modifyState f = readIORef state >>= f >>= writeIORef state canvas `onSizeRequest` return (Requisition 256 256) -- Add action handlers onActivateLeaf miQuit mainQuit -- onActivateLeaf miOpen $ modifyState $ reset gui onActivateLeaf miOpen $ modifyState $ loadImageDlg canvas window onActivateLeaf miSave $ modifyState $ saveImageDlg canvas window onActivateLeaf miScale $ modifyState $ scaleImageDlg canvas window onActivateLeaf miGradient $ modifyState $ gradientImageDlg canvas window onActivateLeaf miSeamCarve $ modifyState $ seamCarveImageDlg canvas window modifyState (loadImage canvas window fName) canvas `on` exposeEvent $ updateCanvas state boxPackStartDefaults vboxInner canvas widgetShowAll window mainGUI return () --uncomment for ghc < 6.8.3 --instance Show Rectangle where -- show (Rectangle x y w h) = "x="++show x++", y="++show y++ -- ", w="++show w++", h="++show h++";" updateCanvas :: IORef State -> EventM EExpose Bool updateCanvas rstate = do region <- eventRegion win <- eventWindow liftIO $ do state <- readIORef rstate let (State pb is) = state gc <- gcNew win width <- pixbufGetWidth pb height <- pixbufGetHeight pb pbregion <- regionRectangle (Rectangle 0 0 width height) regionIntersect region pbregion rects <- regionGetRectangles region putStrLn ("redrawing: "++show rects) (flip mapM_) rects $ \(Rectangle x y w h) -> do drawPixbuf win gc pb x y x y w h RgbDitherNone 0 0 return True {-# INLINE doFromTo #-} -- do the action for [from..to], ie it's inclusive. doFromTo :: Int -> Int -> (Int -> IO ()) -> IO () doFromTo from to action = let loop n | n > to = return () | otherwise = do action n loop (n+1) in loop from -- do the action for [to..from], ie it's inclusive. {-# INLINE doFromToDown #-} doFromToDown :: Int -> Int -> (Int -> IO ()) -> IO () doFromToDown from to action = let loop n | n < to = return () | otherwise = do action n loop (n-1) in loop from -- do the action for [from..to] with step, ie it's inclusive. {-# INLINE doFromToStep #-} doFromToStep :: Int -> Int -> Int -> (Int -> IO ()) -> IO () doFromToStep from to step action = let loop n | n > to = return () | otherwise = do action n loop (n+step) in loop from --forM = flip mapM makeMenuBar = do mb <- menuBarNew fileMenu <- menuNew open <- menuItemNewWithMnemonic "_Open" save <- menuItemNewWithMnemonic "_Save" scale <- menuItemNewWithMnemonic "_Scale" gradient <- menuItemNewWithMnemonic "_Gradient" seamCarve <- menuItemNewWithMnemonic "Seam _Carve" quit <- menuItemNewWithMnemonic "_Quit" file <- menuItemNewWithMnemonic "_File" menuShellAppend fileMenu open menuShellAppend fileMenu save menuShellAppend fileMenu scale menuShellAppend fileMenu gradient menuShellAppend fileMenu seamCarve menuShellAppend fileMenu quit menuItemSetSubmenu file fileMenu containerAdd mb file return (mb,open,save,scale,gradient,seamCarve,quit) loadImageDlg canvas window (State pb is) = do putStrLn ("loadImage") ret <- openFileDialog window case ret of Just (filename) -> (loadImage canvas window filename (State pb is)) Nothing -> return (State pb is) loadImage canvas window filename (State pb is) = do putStrLn ("loadImage") pxb <- pixbufNewFromFile filename width <- pixbufGetWidth pxb height <- pixbufGetHeight pxb widgetSetSizeRequest canvas width height widgetQueueDraw canvas -- updateCanvas canvas pxb return (State pxb NonEmpty) saveImageDlg canvas window (State pb is) = do putStrLn ("saveImage") ret <- openFileDialog window case ret of Just (filename) -> do pixbufSave pb filename "png" [] return (State pb is) Nothing -> return (State pb is) scaleImageDlg canvas window (State pb is) = do putStrLn ("scaleImage") origWidth <- pixbufGetWidth pb origHeight <- pixbufGetHeight pb ret <- scaleDialog window origWidth origHeight let update w h = do putStrLn ("seamCarveImage::update w: "++show w++" h: "++show h) --scalePixbuf :: Pixbuf -> Int -> Int -> IO Pixbuf pxb <- scalePixbuf pb w h width <- pixbufGetWidth pxb height <- pixbufGetHeight pxb widgetSetSizeRequest canvas width height widgetQueueDraw canvas --updateCanvas canvas pxb return (State pxb NonEmpty) case ret of Nothing -> return (State pb NonEmpty) Just (w,h) -> (update w h) gradientImageDlg canvas window (State pb is) = do putStrLn ("gradientImageDlg") --scalePixbuf :: Pixbuf -> Int -> Int -> IO Pixbuf pxb <- gradientPixbuf pb width <- pixbufGetWidth pxb height <- pixbufGetHeight pxb widgetSetSizeRequest canvas width height widgetQueueDraw canvas -- updateCanvas canvas pxb return (State pxb NonEmpty) seamCarveImageDlg canvas window (State pb is) = do origWidth <- pixbufGetWidth pb origHeight <- pixbufGetHeight pb ret <- seamCarveDialog window origWidth origHeight 2 let update w h grdCnt = do putStrLn ("seamCarveImageDlg::update w: "++show w++" h: "++show h) --scalePixbuf :: Pixbuf -> Int -> Int -> IO Pixbuf --pxb <- scalePixbuf pb w h cpuStart <- getCPUTime pxb <- seamCarvePixbuf pb w h grdCnt cpuEnd <- getCPUTime putStrLn ("seamCarveImageDlg::cpu time: "++show ((fromIntegral (cpuEnd-cpuStart) :: Double) /1e12)) width <- pixbufGetWidth pxb height <- pixbufGetHeight pxb widgetSetSizeRequest canvas width height widgetQueueDraw canvas --updateCanvas canvas pxb return (State pxb NonEmpty) case ret of Nothing -> return (State pb NonEmpty) Just (w,h,grdCnt) -> (update w h grdCnt) scaleDialog :: Window -> Int -> Int-> IO (Maybe (Int, Int)) scaleDialog parent width height = do Just xml <- xmlNew "scaling.glade" dia <- xmlGetWidget xml castToDialog "dialogScale" dialogAddButton dia stockCancel ResponseCancel dialogAddButton dia stockOk ResponseOk entryWidth <- xmlGetWidget xml castToEntry "entryScalingWidth" entryHeight <- xmlGetWidget xml castToEntry "entryScalingHeight" entrySetText entryWidth (show width) entrySetText entryHeight (show height) res <- dialogRun dia widthStr <- entryGetText entryWidth heightStr <- entryGetText entryHeight widgetDestroy dia putStrLn ("scaleDialog width: "++show width++" height: "++show height) case res of ResponseOk -> return (Just (read widthStr,read heightStr)) _ -> return Nothing seamCarveDialog :: Window -> Int -> Int -> Int -> IO (Maybe (Int, Int, Int)) seamCarveDialog parent width height grdCnt= do Just xml <- xmlNew "scaling.glade" dia <- xmlGetWidget xml castToDialog "dialogSeamCarve" dialogAddButton dia stockCancel ResponseCancel dialogAddButton dia stockOk ResponseOk entryWidth <- xmlGetWidget xml castToEntry "entryWidth" entryHeight <- xmlGetWidget xml castToEntry "entryHeight" entryGrdCnt <- xmlGetWidget xml castToEntry "entryGrdCnt" entrySetText entryWidth (show width) entrySetText entryHeight (show height) entrySetText entryGrdCnt (show grdCnt) res <- dialogRun dia widthStr <- entryGetText entryWidth heightStr <- entryGetText entryHeight grdCntStr <- entryGetText entryGrdCnt widgetDestroy dia putStrLn ("scaleDialog width: "++show width++" height: "++show height++" grdCnt: "++show grdCnt) case res of ResponseOk -> return (Just (read widthStr,read heightStr, read grdCntStr)) _ -> return Nothing openFileDialog :: Window -> IO (Maybe String) openFileDialog parentWindow = do dialog <- fileChooserDialogNew (Just "Open Profile... ") (Just parentWindow) FileChooserActionOpen [("gtk-cancel", ResponseCancel) ,("gtk-open", ResponseAccept)] widgetShow dialog response <- dialogRun dialog widgetHide dialog case response of ResponseAccept -> fileChooserGetFilename dialog _ -> return Nothing --simple pixbuf scaling scalePixbuf :: Pixbuf -> Int -> Int -> IO Pixbuf scalePixbuf pb newWidth newHeight = do width <- pixbufGetWidth pb height <- pixbufGetHeight pb row <- pixbufGetRowstride pb chan <- pixbufGetNChannels pb bits <- pixbufGetBitsPerSample pb pbData <- (pixbufGetPixels pb :: IO (PixbufData Int Word8)) pbn <- pixbufNew ColorspaceRgb False 8 newWidth newHeight pbnData <- (pixbufGetPixels pbn :: IO (PixbufData Int Word8)) newRow <- pixbufGetRowstride pbn putStrLn ("bytes per row: "++show row++", channels per pixel: "++show chan++ ", bits per sample: "++show bits) putStrLn ("width: "++show width++", height: "++show height++", newWidth: "++show newWidth++", newHeight: "++show newHeight++" bytes per row new: "++show newRow) let stepX = (fromIntegral width) / (fromIntegral newWidth) :: Double let stepY = (fromIntegral height) / (fromIntegral newHeight) :: Double doFromTo 0 (newHeight-1) $ \y -> do let y1 = truncate ((fromIntegral y) * stepY) doFromTo 0 (newWidth-1) $ \x -> do let x1 = truncate ((fromIntegral x) * stepX) let off = (x1*chan+y1*row) let offNew = (x*chan+y*newRow) --putStrLn ("x: "++show x++", y: "++show y++" x1: "++show x1++", y1: "++show y1++" off:"++show off++" offNew:"++show offNew) r <- unsafeRead pbData (off) g <- unsafeRead pbData (1+off) b <- unsafeRead pbData (2+off) unsafeWrite pbnData (offNew) r unsafeWrite pbnData (1+offNew) g unsafeWrite pbnData (2+offNew) b return pbn {-# INLINE arrmove #-} arrmove :: (Ix i, MArray a e IO) => a i e -> Int -> Int -> Int -> IO () arrmove arr src dst size = do --putStrLn("arrmove "++show src++" "++show dst++" "++show size) doFromTo 0 (size-1) $ \x -> do --forM [0..(size-1)] $ \x -> do v <- unsafeRead arr (src+x) unsafeWrite arr (dst+x) v --putStrLn("arrmove2 "++show src++" "++show dst++" "++show size) return () {-# INLINE arrmovesd #-} arrmovesd :: (Ix b, MArray a c IO) => a b c -> a b c -> Int -> Int -> Int -> IO () arrmovesd arrsrc arrdst src dst size = do doFromTo 0 (size-1) $ \x -> do --forM [0..(size-1)] $ \x -> do v <- unsafeRead arrsrc (src+x) unsafeWrite arrdst (dst+x) v return () {-# INLINE arrmoven #-} arrmoven :: (Ix i, MArray a e IO) => a i e -> Int -> Int -> Int -> Int -> Int -> IO () arrmoven arr src dst size w n = do --putStrLn("arrmoven "++show src++" "++show dst++" "++show size++" "++show w++" "++show n) doFromToStep 0 ((n-1)*w) w $ \yoff -> do arrmove arr (src+yoff) (dst+yoff) size return () -- content Aware scaling --TODO! seamCarvePixbuf :: Pixbuf -> Int -> Int -> Int -> IO Pixbuf seamCarvePixbuf pb newWidth newHeight grdCnt = do width <- pixbufGetWidth pb height <- pixbufGetHeight pb row <- pixbufGetRowstride pb chan <- pixbufGetNChannels pb bits <- pixbufGetBitsPerSample pb pbData <- (pixbufGetPixels pb :: IO (PixbufData Int Word8)) --pbn <- pixbufNew ColorspaceRgb False 8 newWidth newHeight pbn <- pixbufNew ColorspaceRgb False 8 newWidth newHeight pbnData <- (pixbufGetPixels pbn :: IO (PixbufData Int Word8)) newRow <- pixbufGetRowstride pbn putStrLn ("bytes per row: "++show row++", channels per pixel: "++show chan++ ", bits per sample: "++show bits) putStrLn ("width: "++show width++", height: "++show height++", newWidth: "++show newWidth++", newHeight: "++show newHeight++" bytes per row new: "++show newRow) tmpPB <- pixbufCopy pb tmpData <- (pixbufGetPixels tmpPB) :: IO (PixbufData Int Word8) ----double gradient let computeSrcPic pb cnt | cnt <= 0 = do pixbufCopy pb | cnt > 0 = do pb <- computeSrcPic pb (cnt-1) gradientPixbuf pb --computing gradient but one more gradient --will be compute later by gradientArray function tmpPB2 <- computeSrcPic tmpPB (grdCnt-1) tmpData2 <- (pixbufGetPixels tmpPB2) :: IO (PixbufData Int Word8) -- array to store x coord of removed pixels coordArr <- newArray (0, (max width height)) 0 :: IO (ArrayType Int Int) let removeVPixel pixData x y w = do --unsafeWrite pixData (0+x*chan+y*row) 255 --unsafeWrite pixData (1+x*chan+y*row) 255 --unsafeWrite pixData (2+x*chan+y*row) 255 --store x-coord of removed pixel unsafeWrite coordArr y x arrmove pixData ((x+1)*chan+y*row) (x*chan+y*row) ((w-x-1)*chan) return () let removeHPixel pixData x y h = do --putStrLn("removeHPixel "++show x++" "++show y++" "++show h) --store y-coord of removed pixel unsafeWrite coordArr y x --putStrLn("removeHPixel1.5 "++show x++" "++show y++" "++show h) arrmoven pixData (y*chan+(x+1)*row) (y*chan+x*row) chan row (h-x-1) --putStrLn("removeHPixel2 "++show x++" "++show y++" "++show h) return () let removeVGrdPixel grdData x y w = do arrmove grdData (x+1+y*width) (x+y*width) (w-x-1) return () let removeHGrdPixel grdData x y h = do --putStrLn("removeHGrdPixel "++show x++" "++show y++" "++show h) arrmoven grdData (y+(x+1)*width) (y+x*width) 1 width (h-x-1) --putStrLn("removeHGrdPixel2 "++show x++" "++show y++" "++show h) return () let vPixIndex x y chan row = (x*chan)+(y*row) let hPixIndex x y chan row = (y*chan)+(x*row) -- possibly it can be made shorted let removeSeam pixIndex rmPixel rmGrdPixel seamArr grdArr x y w = do rmPixel tmpData x y w rmPixel tmpData2 x y w rmGrdPixel grdArr x y w unless (y == 0) $ do v0 <- if x==0 then return 0x7fffffff else unsafeRead seamArr (pixIndex (x-1) y 1 width) v1 <- unsafeRead seamArr (pixIndex x y 1 width) v2 <- if x==(w-1) then return 0x7fffffff else unsafeRead seamArr (pixIndex (x+1) y 1 width) let nextX | v0 < v1 && v0 < v2 = (x-1) | v2 < v1 = (x+1) | True = x removeSeam pixIndex rmPixel rmGrdPixel seamArr grdArr nextX (y-1) w -- possibly it can be update to be more general let updateGradientArray pixIndex grdArr y w h = unless (y == -1) $ do x <- unsafeRead coordArr y unless (x == 0) $ do g <- pixelGradient pixIndex tmpData2 row chan w h (x-1) y unsafeWrite grdArr (pixIndex (x-1) y 1 width) g unless (y == 0) $ do g <- pixelGradient pixIndex tmpData2 row 1 w h (x-1) (y-1) unsafeWrite grdArr (pixIndex (x-1) (y-1) 1 width) g unless (y == (h-1)) $ do g <- pixelGradient pixIndex tmpData2 row 1 w h (x-1) (y+1) unsafeWrite grdArr (pixIndex (x-1) (y+1) 1 width) g g <- pixelGradient pixIndex tmpData2 row 1 w h x y unsafeWrite grdArr (pixIndex x y 1 width) g unless (y == 0) $ do g <- pixelGradient pixIndex tmpData2 row 1 w h x (y-1) unsafeWrite grdArr (pixIndex x (y-1) 1 width) g g <- pixelGradient pixIndex tmpData2 row 1 w h x (y+1) unless (y == (h-1)) $ do g <- pixelGradient pixIndex tmpData2 row 1 w h x (y+1) unsafeWrite grdArr (pixIndex x (y+1) 1 width) g updateGradientArray pixIndex grdArr (y-1) w h return () let findMinVal pixIndex seamArr w h = do v <- unsafeRead seamArr (pixIndex 0 (h-1) 1 width) xRef <- newIORef (v :: Int, 0 :: Int) --let modifyState f = readIORef state >>= f >>= writeIORef state doFromTo 1 (w-1) $ \x -> do --putStrLn("findMinVal loop x: "++show x++" (h-1): "++show (h-1)) v <- unsafeRead seamArr (pixIndex x (h-1) 1 width) (mval, m) <- readIORef xRef writeIORef xRef (if v < mval then (v, x) else (mval, m)) (mval, m) <- readIORef xRef putStrLn("w: " ++show w++ " minSeam: " ++ show mval ++ " at: "++show m) return m grdArr <- gradientArray tmpPB2 width height let removeVSeam w = do seamArr <- (computeVSeamArray grdArr width height w) m <- findMinVal vPixIndex seamArr w (height-1) removeSeam vPixIndex removeVPixel removeVGrdPixel seamArr grdArr m (height-1) w updateGradientArray vPixIndex grdArr (height-1) w height return () let removeHSeam h = do seamArr <- (computeHSeamArray grdArr width height h) m <- findMinVal hPixIndex seamArr h (width-1) removeSeam hPixIndex removeHPixel removeHGrdPixel seamArr grdArr m (width-1) h updateGradientArray hPixIndex grdArr (width-1) h width return () --let nextX | v0 < v1 && v0 < v2 = (x-1) -- | v2 < v1 = (x+1) -- | True = x let grdSeam w h | w > newWidth && h > newHeight = do --putStrLn("grdSeam: "++show w++" "++show h) vSeamArr <- (computeVSeamArray grdArr width height w) mv <- findMinVal vPixIndex vSeamArr w (height-1) hSeamArr <- (computeHSeamArray grdArr width height h) mh <- findMinVal hPixIndex hSeamArr h (width-1) if mv < mh then do removeSeam vPixIndex removeVPixel removeVGrdPixel vSeamArr grdArr mv (height-1) w updateGradientArray vPixIndex grdArr (height-1) w height grdSeam (w-1) h else do removeSeam hPixIndex removeHPixel removeHGrdPixel hSeamArr grdArr mh (width-1) h updateGradientArray hPixIndex grdArr (width-1) h width grdSeam w (h-1) | w > newWidth = do --putStrLn("grdSeam2: "++show w++" "++show h) removeVSeam w grdSeam (w-1) h | h > newHeight = do --putStrLn("grdSeam3: "++show w++" "++show h) removeHSeam h grdSeam w (h-1) | True = do return () -- remove/add seams --doFromToDown width (newWidth+1) $ \w -> do -- removeVSeam w --doFromToDown height (newHeight+1) $ \h -> do -- removeHSeam h grdSeam width height doFromTo 0 (newHeight-1) $ \y -> do arrmovesd tmpData pbnData (y*row) (y*newRow) newRow return pbn -- compute the gradient map gradientPixbuf :: Pixbuf -> IO Pixbuf gradientPixbuf pb = do width <- pixbufGetWidth pb height <- pixbufGetHeight pb row <- pixbufGetRowstride pb chan <- pixbufGetNChannels pb bits <- pixbufGetBitsPerSample pb pbData <- (pixbufGetPixels pb :: IO (PixbufData Int Word8)) pbn <- pixbufNew ColorspaceRgb False 8 width height pbnData <- (pixbufGetPixels pbn :: IO (PixbufData Int Word8)) putStrLn ("bytes per row: "++show row++", channels per pixel: "++show chan++", bits per sample: "++show bits) putStrLn ("width: "++show width++", height: "++show height) let getpix x y c = do case (x < 1 || x >= width || y < 1 || y >= height) of True -> return 0 False -> (unsafeRead pbData (c+x*chan+y*row)) let gradient x y c = do let convM = liftM fromIntegral blah a b = convM (getpix a b c) v00 <- blah (x-1) (y-1) v10 <- blah x (y-1) v20 <- blah (x+1) (y-1) v01 <- blah (x-1) y v21 <- blah (x+1) y v02 <- blah (x-1) (y+1) v12 <- blah x (y+1) v22 <- blah (x+1) (y+1) let gx = abs ((v20-v00)+2*(v21-v01)+(v22-v02)) let gy = abs ((v02-v00)+2*(v12-v10)+(v22-v20)) let g = (gx + gy)::Int --let g8 = (shiftR g 3) let g8 = if g > 255 then 255 else g return (fromIntegral(g8) :: Word8) let totalGradient x y = do rg <- gradient x y 0 gg <- gradient x y 1 bg <- gradient x y 2 let g = rg + gg + bg return ((fromIntegral g)::Word8) doFromTo 0 (height-1) $ \y -> do let offY = y*row doFromTo 0 (width-1) $ \x -> do let offX = x*chan doFromTo 0 2 $ \c -> do let off = offY+offX + c --putStrLn ("x: "++show x++", y: "++show y++" off:"++show off) --v <- (totalGradient x y) v <- (gradient x y c) unsafeWrite pbnData (off) v return pbn -- compute gradient fo single pixel {-# INLINE pixelGradient #-} pixelGradient :: (Int -> Int -> Int -> Int -> Int) -> (PixbufData Int Word8) -> Int -> Int -> Int -> Int -> Int -> Int -> (IO Word16) pixelGradient pixIndex pbData row chan w h x y = do let getpix x y c = do case (x < 0 || x >= w || y < 0 || y >= h) of True -> return 0 False -> (unsafeRead pbData (c+(pixIndex x y chan row))) --False -> (unsafeRead pbData (c+x*chan+y*row)) let gradient x y c = do let convM = liftM fromIntegral blah a b = convM (getpix a b c) v00 <- blah (x-1) (y-1) v10 <- blah x (y-1) v20 <- blah (x+1) (y-1) v01 <- blah (x-1) y v21 <- blah (x+1) y v02 <- blah (x-1) (y+1) v12 <- blah x (y+1) v22 <- blah (x+1) (y+1) let gx = abs ((v20-v00)+2*(v21-v01)+(v22-v02)) let gy = abs ((v02-v00)+2*(v12-v10)+(v22-v20)) let g = (gx + gy)::Int --let g8 = (shiftR g 3) let g8 = if g > 255 then 255 else g return (fromIntegral(g8) :: Word8) let gradient x y c = do let convM = liftM fromIntegral blah a b = convM (getpix a b c) v00 <- blah (x-1) (y-1) v10 <- blah x (y-1) v20 <- blah (x+1) (y-1) v01 <- blah (x-1) y v21 <- blah (x+1) y v02 <- blah (x-1) (y+1) v12 <- blah x (y+1) v22 <- blah (x+1) (y+1) let gx = abs ((v20-v00)+2*(v21-v01)+(v22-v02)) let gy = abs ((v02-v00)+2*(v12-v10)+(v22-v20)) let g = gx + gy return (g :: Int) rg <- gradient x y 0 gg <- gradient x y 1 bg <- gradient x y 2 let g = rg + gg + bg return ((fromIntegral g) :: Word16) -- compute the gradient map gradientArray :: Pixbuf -> Int -> Int -> IO (ArrayType Int Word16) gradientArray pb w h = do width <- pixbufGetWidth pb height <- pixbufGetHeight pb row <- pixbufGetRowstride pb chan <- pixbufGetNChannels pb bits <- pixbufGetBitsPerSample pb pbData <- (pixbufGetPixels pb :: IO (PixbufData Int Word8)) grdArr <- newArray (0, width * height) 0 putStrLn ("bytes per row: "++show row++", channels per pixel: "++show chan++", bits per sample: "++show bits) putStrLn ("width: "++show width++", height: "++show height) let vPixIndex x y chan row = x*chan+y*row doFromTo 0 (h-1) $ \y -> do let offY = y*width doFromTo 0 (w-1) $ \x -> do let off = x + offY --v <- (totalGradient x y) v <- (pixelGradient vPixIndex pbData row chan w h x y) unsafeWrite grdArr (off) v --putStrLn ("x: "++show x++" y: "++show y++" v: "++show v) return grdArr computeVSeamArray :: (ArrayType Int Word16) -> Int -> Int -> Int -> IO (ArrayType Int Int) computeVSeamArray grdArr width height currentWidth = do seamArr <- newArray (0, width * height) 0 --grdArr <- gradientArr doFromTo 0 (currentWidth-1) $ \x -> do v <- unsafeRead grdArr x unsafeWrite seamArr x (fromIntegral v :: Int) doFromTo 1 (height-1) $ \y -> do let offY = y*width let prevOffY = offY-width doFromTo 1 (currentWidth-2) $ \x -> do p1 <- unsafeRead seamArr ((x-1)+prevOffY) p2 <- unsafeRead seamArr (x+prevOffY) p3 <- unsafeRead seamArr ((x+1)+prevOffY) v <- unsafeRead grdArr (x+offY) unsafeWrite seamArr (x+offY) ((fromIntegral v :: Int) +(min(min p1 p2) p3)) p2l <- unsafeRead seamArr (0+prevOffY) p3l <- unsafeRead seamArr (1+prevOffY) vl <- unsafeRead grdArr (0+offY) unsafeWrite seamArr (0+offY) ((fromIntegral vl)+(min p2l p3l)) p1r <- unsafeRead seamArr (currentWidth-2+prevOffY) p2r <- unsafeRead seamArr (currentWidth-1+prevOffY) vr <- unsafeRead grdArr (currentWidth-1+offY) unsafeWrite seamArr (currentWidth-1+offY) ((fromIntegral vr :: Int) +(min p1r p2r)) return seamArr computeHSeamArray :: (ArrayType Int Word16) -> Int -> Int -> Int -> IO (ArrayType Int Int) computeHSeamArray grdArr width height currentHeight = do seamArr <- newArray (0, width * height) 0 --grdArr <- gradientArr doFromTo 0 (currentHeight-1) $ \y -> do v <- unsafeRead grdArr (y*width) unsafeWrite seamArr (y*width) (fromIntegral v :: Int) doFromTo 1 (width-1) $ \x -> do doFromTo 1 (currentHeight-2) $ \y -> do let offY = y*width let prevOffY = offY-width let nextOffY = offY+width p1 <- unsafeRead seamArr (x-1+prevOffY) p2 <- unsafeRead seamArr (x-1+offY) p3 <- unsafeRead seamArr (x-1+nextOffY) v <- unsafeRead grdArr (x+offY) unsafeWrite seamArr (x+offY) ((fromIntegral v :: Int) +(min(min p1 p2) p3)) p2l <- unsafeRead seamArr (x-1+0) p3l <- unsafeRead seamArr (x-1+width) vl <- unsafeRead grdArr (x+0) unsafeWrite seamArr (x+0) ((fromIntegral vl)+(min p2l p3l)) p1r <- unsafeRead seamArr (x-1+((currentHeight-2)*width)) p2r <- unsafeRead seamArr (x-1+((currentHeight-1)*width)) vr <- unsafeRead grdArr (x+((currentHeight-1)*width)) unsafeWrite seamArr (x+((currentHeight-1)*width)) ((fromIntegral vr :: Int) +(min p1r p2r)) return seamArr glade-0.12.1/demo/scaling/Stones.jpg0000644000000000000000000005533211633370304015366 0ustar0000000000000000JFIFC  !"$"$C@"B!1A"Qaq2B#R$3brC4%Ss&!1QA"2BRaq ?S Kg߈ (& Կc=eS2-a V,LjK /~D$\6i+l<yW+3ZNYx퇗OB΢^kS4cq$MR9c[03Pnc16j(~%/7gv^^4@7Nr} ˽̫{m[A0VWҦGjcTZsvC*= z Fc%YyL%,JʜfKw`·tCma 8WLր 4n a0.WGYqnf8hVQ 78:3;B-+&gQj`;=N;)=[SNV@ MI\편XŘ- +hAe`^l1GscG1!aNH"R1O]b̛~1L &Vf妦0Kv`^3.{<=5bڟNg5|WNUo7$>gV ~[\|/ +gI5(LmOےYrxu MƟw>]l`}!6-`}!ImS;rLvZ#c)=*v55P l5KY'HP Zg.oa RюoYȻ1Mkq[`/jyb 2KL\Ya*z(s7%nOhxb1hXEF3s;&5eB b%1eMdsڅL+I? 2d Fҕi4??x\NS*+a3wsOyaaɩU 70ZV%s۬ ()ΑAD11kr X(HgGm" !,{S@ J7YzL04,2/!a{LDMm#<PjZЍ>?5ILu'&to3]~ZU&fd@scTjaoCKOUEC].If 7 YAf&rfLw=5V2j*P ɸדf~)G {A>o?E7;eXx-iʀ~Q+|s+]1CC kņY{9X(͏h,Vyc SzcM^;҅8[=ӹү^U5ML-b$:@dU6j5Pn$reSncrneZ2HYɶ=9d+Iit JaX ttX[&0[/=D޷[I_K;G6叨s%lAA`~z W򬅷LYH(&TA<&^#"b*C;ANEzp okH48 |MOȳ9~,kU ʴ춁H3ue%Nml(ʙӹ\/ϐRB٘$0r O09CfܑjrXq펠*'jdfi"acA"ʞݾ %J+x1*YN HoSGR?i_?=v1ҭA*&gк+:_<~ 04mYQ}&>OnXiSh93m  Wq2ݷukhl FS"n]ް5)]}'עEt3a#N"ڷMoHv=LnLe[MN"c\hZc۩){5b4veC&scq_Rgo'[bw ӂJgy=϶mM*s:^I=¨%*çzHͷc$WPRB32In`C&]$kB+Kq}ݹ6TOI@09Q{,3=5+BeڸY %YLLs"=3&cQiF].@DDGFmK"-%M2^oh;a K%}PX%IФK@B]-l$] aem/0h0pKe,תyʊ>3ӝtoCQ)s%ǘ EoAD [Q')'}LY0 nƄ>ҘgbMo ѧ\Ĩgk.cU|3k5v~Sr;;2/&]e̡.kl.IR6BP ΨJ߰=:cQ r`e3$R&IRMl'2! ^йN,!reA>YAj"[Lݙh$&vڸ$/& 2(D˕-(ʖdGʴ)XKI.U᳥J2^[\2DgjZA.=9i-% +ii\ٖP3B%> bzE>\;A%} W$/- /^ɸNG=LS- 2>ھqŢI7sSh,ݠi[Kk,}/u$ʴv5`,[0HqDR>t= \ltc~BR*!eLWŏh A`f>Þؓ> " ,.!g2K ׸hw žV"Lt0B"QrĢ!<tV(ˣm%ʗKI,GIF].PFIRr*Kʤc*ʴ:$Kk ` f[<!p,Z#$Cg/WPzgq3OympӸJ&~6h*I:ʼGVN'^ՂjryD欮'3=~$b:u$?b#+#EīԔj.Z.%&~S+ a3MHAa(IE<;nUI[<1*iE(RK+p5 =yh(jA5"ZQiԒ夷9F c= \Za2u%>7ԙ:ԓ|Ԗ*KGQ4S_TGME_y:ݿWSb5}Gj{:u +mOyrĮ[mIԘXyrzI< 26ԘL5%&1RZo-6ueu&CRټHh鯫(ԙ:u%RNԜM#U+kmJKNRM?miu:}{yoã / z:z Mm`E=#U-j59|_ҡS=ZiJֵ%u#VWRdI2WRWRe{ɾZ-=I:+U]*(3=Iژg~#ݚҍYkj*9ON`?Xʟv M}ݳh_Ohj~C)\U3'7Tx?kO~)#6qu >J!k_^jhhtt2q{ZÉY+gҏQrv'C;Ǔ1tu, J X!#ӷN~0ޡIr@ | XOigQ_kWm}b8bӺ.DZMH&Gt/X@jA5=P=}*Mw r?j%PGWg_ۄqq!o(I鰺#YO3f}I'XCԓ|֖*˕ΤA$J]ԦC 0M\7YW{U7Цz5ZkP,O> 4aGsXWl%n|>>P? rktHO:vhܠ3,dg~c1_4jWs\6"o/)⺝Zzlzhz"M_O5Gi;E[* g3q^OΝsޯ?b봀VK[ᾠGRJxe6Mܯ$)Y쮎3oP3xE?6n2o>?jzZQ mr =~,ZFߴjVҧqϠlfݡrochӢ/O=ڃ Mjgq}JSbLߦi Nq zOP:}8NP$:T M|I'R$l۽b*30lu3WP+7Rx3h+Wgֶ!}V離+QiA⺖[jZyp}iF9SSOSUsxlU'{'^ ',n}ַq:5a>{|g@8-~jռJ6 KxRu:..[|*zov '/+FS&hT[O>] A'ǣ6]{eWcxLt>\깨Aag7jk5OR<4%6>XEAkY0H6<|,4cv^ဿ,NmCݕޝ.~gZvP0&AI֥ސtCnGqӬn2ꞝrPlE:Vo6;icӂ"twjeJkM[TQk)P76):ˌ \[aZIsV c <T ծ UH6cW8GUUmtj8oH͊}ԝ Hմ"z l_vDRމb]_^cGmTTMZ`ZԚ?T`];m\{KUR7Mj(ҩ>f1^TF {1 |8`wXO>XcVlxri_OT>22j:ߴVI7/uwuuӕǵZ-+ j?h{L:oLh fUbI)WU+QӨQNA?/տuMw*Kv3Skfap :q֩_^\y,3ɟ($sFѡҶ>FA_h35&ch9zAz㪭Ijۺdk :m,c{EFlo8 L 7uԙ~7xuB{;goI?.u WSEw5V6} j)tM 5 #HkR(;ӯJk^ 5xW5q"׎o@w;o̺)S74kբ9t7Fj G=_Gg!*.HɈkRON?+NJ0:6m>yOrڼR]#mUqZḾ,~'I@ni KPM{Z]dj'efŠM5tرFQLJrmΫJ6SFPXrQOD =S3PdMI*:z v xM ME}Z`ٷ?J5>87 Uw_345)VaKN/c(]m|Z{y\`lDb傆nATJ~mՇABm=vb=A1#r݆{DbL|7BM,35frn#h0F[fnLʷ:զT+`wh[Bm5jivRI$[=vT)?;{er̩OV]Nխ] _3VRpơ_fZZU^-A3_.sL6F}nD$_rQ~-shOuM7jnLTMe~;-ҷƘSJ!X[iEtmEZeP\ ¢ 9U[a-$Z ނfjeZjk&5K-UR˴gg2xN %yI@ s9_8Yk%\};t_SQ oǼѢ yI1קzsP0"Z"=jtylZqySLnp 9 i: GۡTynC30QTjă:W*}a* ] ^8gR1cv ߴFb%VUoSPK%> M]J n.`'h;zo SUwx]EH:}ԫ ;ӕ \/ӥVmm`m JM7[܀s۸qkJMz bg6Ǭj**+tz .VtDKRM#ߦga1⺭FufrF ڠSb85u2=6c.ӓS9z,ޱ5]:Do3+L--ZֹfEI1+Jϸ[iNċKQ[jb ME@@QjaKU0tPTiԍ3KQx&ÆPs/5Ž1EiQ ԵjTߦl{{N-DyUM TUأe2Nv9ͅZnPl0=5mη]]0UhC]FebN}F XA2*Qk.mnO:*uթ z[36fUd#qҳJBFAhX mw,DT S  Pw.H .mNEwVU'UMe!rOhsNm{)mz I̗ $Q,78] XoMTW ]zi;lmm{@WDr l ٱ[2;2ָ6[b!FxszZA &nB. |EeaGR?fȹ$-QmY 3o1F`Ewk$.mx+XS [%U6okTe \3Qu.%$^ך]vQ/Ɵs ~*"2\O0`frjp7qa ZVMXa+نlyOxU\6*6[+psϴE?t$`ec d/ZRQ(P NFjWP2Wo:N5 =ɰHiЊ|3J  Sl7ik*@;X{3oL Y[ͫVʶ#ZqkpG򍧪m8&e-3*Ul7k=6b쀓YϪT0u:˵ݯq~&J:%Z*MMS<ߙx7=gp*\aKPZ)FX8p iʒ-&Y䑋ִUJ>dqG7Tp}Hwb, !SAyKOTa8]_OoXB[Ө1=}BU5{myU]΢M2G4RmrӦPԩIȷh5W?x Hٺ1+SSsʨ[ |Z,`JYr.o5*6_1Wm}Lj`>U+Xb ^X ^1䋓n1*JN*JgpKTQojM!XǪİ#!ЪZ+0-.lZ ~D`c**>i3X-4R5q6P=`{Rd4V6\gMi]&mɷ5xu~:P<5X]Fb 4_s6'8 ǥ ؆V ;Tk`0B䙋[ 7inñ/ٽԫ{ 2ch'#Vzm[Sy .sls1}g6[!5ٵȹ;Q-5eJkтԽQ|ze70]Xl]Jq;gjlT qh*+# Ƕa H8*&n i 5,qOxQOރ&I}EA LdgF7|Jj$< AG8  Jy^)C@6=}@*3sH`f%fK 9۱ {V#A6 ԌHGSsۏN#uk*kRx:Mvb)RXk'1v\p}aU4ow0L)eE("Y7ի*5Gl>Qsp}'V*7"ySII,GߘUumP=b A)}]F DRMriVaꨢA+Rr;^j=&7clij 2'K5j+mz+e,=i[9t-ߟh& oks{4Ue-I84Sj\1^*!=76-#zKAeT 6NP[~Q}l{fIqT׾xPwnNU,ķ%ݹi&݄ #x+fEY7ZaiA+i*TzJ6AxR/caWNE<{JZlkfn:}FMu";bZlf ~Q*OQl͐Fn$hWB7 W2ky>\MKXpQbct%?8'c(Ri}8:W!6kY6ʣUST ۃTĔ]6e/S]LTdTjN!_}" omA1&#k@&׷ K\Eu)(wm6ϗ0S "@n%w7|fKЙw2ɋ+P VV]ZO./ق0$EY-s3S]uϓH|M/`mf1:OL_f%[ 0MYjfnm8EU 3֧MS88ը3|ǐI[y'#b, Bt@fqa9Ш䜟:ܷ ='9Tނ0:~ c᯴Eʘun/4ˆ[%״wss|U#S5C,a*1Lt(+~ Ep H;^! 0"i+xtݻO Ѓj/xh6yޣ k1MI[j)3VkXܩMF6WvjJm,{i ̺mboIV=Lbpӡ]%5l9z}93rg\f;lO|MMv2miî70͍#~Qרrp=&s@+ac~Ѫw[2W -ɲTlpNpL&Q#^k/{ ,)Z3e'~jQZ}dxBVm9)mS3r?PȒoVs me&ٶ&*Z1#h~ 7) n 1ږ!ߓ NEL FiR >a궷)5A=|UT{׶.}dlc!T7=▝JvQM}x2j_5夔YA)n7MQ݀EF*,F@orD4,Um۳9 +Y#}EᆧL2)H r=/Uܧ>` =YN1gp6!_& ^ē <}׭L( C08RTL܌"y߈nǝsouٙӷԞg#-Ԥ,.%ҡ[_9Q}e#Oͷb tCM4ϑ[|Zav+~u*6_)]7e[yKm q{Mc QTUEQ1y#0/QJ76^r7*JCq^˰ff[)ojJnlp L=TK0wS`,ceFAv6m&pfc |3k չMO1dU{{MZZu5T];-wH zOܖevUJUl =bѮ8,@7~ndwz;;8%暛'6oĕUUBS~&"'9ܮ ]OFlCchoaC[oؙLhfB{ްvAvR1n L20SLyT5V>PmK\FcR^\ U,lZ7k`NLj4_*$M'qßXnM]qHzoosYN Hڕ) |"sRkaC_dz]@i\'E- LoP3alE ۹P-sGR6$r":plG ǤdURM>8um0Rn4 -J )4TS"rtPZ˷85)/`M6Rvze]FQ O.~=$acIj ܂./ T|3n[$u+Q['׼ѝB@Hb~V3R 9R?OPXž"R8"6tGmP)fJUSY}ppV"BA6?XE}#,t]]v9`Y6lcFeRʬm~H#4ϟkZ]5]׸]Zl*vFBS~_Nowd,~f3P_I` amh欪v5 Fs}޵:_Ϻj!fGBjT\üji*,s~VR֢݀'V7p'S[ſEMFTmNjD4m`Mt6>x3m.p@Aa~e4$ȍLbfk' KV l,H̍Ss7Ѯ-snu 5DP-@ i(Q<׵:m۰1E^Yokc|`-Sm`q[#v6Xc=lbA R E6*0E9eXuoxJfFp '}_ۈZ$6Wh#׈3g1Al{:K1f`yiKBg[a~I)$o#S݇ʚn*Sk=2l|&-, _ b)SQo5Uچ퐹EZy*7ǫ =`c2W} ?2j?jaEyir}BZK}p< pzM|ssyj[ jST'8s)rÓ~f}bll-#Qz2=?,R d !Q:[/pIՉcYFዋ^e5׫PMԱ- b؊Z`-Q]nD$GQ³X{t[ >ZM-Xֆِ'SmOOڶA6<$ն,JMetU_ u~ϤGr'$9@LwiŜ-cMZpT1<2߱S4Ш=àJv ؕ 0oъ .Q^vtKPUTXXUEcE*:r@{n^ oXd_Wʵ.g̝:vD3*VMX`l/c/nLo[ n^eS!iiY8*9~]ET% ,ne3n^@l\&lͤg͚Ñe)QHlKJ$oPw$HYP;4UM0͡ ׷>i)n{^]}2"[ǘU o~ )QH5xm4Z)~_TeMUSY6[-0ثxv= Bj@%v)aIp-ڊG3!:[&/QjǷ3U QX확0Łc"Z& l>}gjnQdfv01z<H$[tm^[I`LB1Su$Mq35*oSA;oHٔ?`Z_EUp-r;>;qjDno/G챹MEtd P]q9}e_2ٛ7J-OSSqe6]WmĨ \ZHLU'}ϔFUWQX_˻, .ftEҠn۶A&CZhI}BI@m8*TPeȌŷ0>͚j 7qqϷș4f#7 cc1+~G"Iשz۫āϤOEe lgNE߂=b*A#0;vŎsYos?gwS @6? {LzE[(4YZ rWYYxlVYos4e' FE* 8S^h6N?2M ~,";{v7c"h nḿ_u{ P=25JI, sU (G7 ZTHϚޑ 2irmqa]/̤ ؐxPRyd +mu r`&қѾ0JؾgO(Zn9Ny`Z1F !~ ^I%r(U4+nMW^c_ =Ԩ܋EtPS*M{+E cn#350-*̸D l/JSSr{Fuǥv{*~5zEIbt7oBIR<BTT)GR PfUJSio r@ńy!IU/kSakZШ*ia{X{!J%2t۰apMn/ŷPUT ťHqbc9F[I[nl,Hn [XM5 acv#%{Ūe4737jihŹ*i,mg7bO&(tَ4 + -j@7%SXxe==J(~n*]fĐ,;f:є%`namkZI`*/{bba>̶7[Z,ȶڬssnRASLCLyUnRaL7H* iMeݏq(uj=5WmkjE'd]\>&Rxf@tmN!gP-7a ^f[};ZNmy!:{%="Ԡ$ QjJ-v&܏ÏyWױ[X1muV 08u zCDQ)%AR2aTQzkrˁ]? vr0.U@7Ε rx]bFe!xcέ&dIjv}4oq9><6\at8\Cl790hQ!@AU JC#hh5+7P0+2Z q7J,Cqw6x ?Cqkhf(N%`GnmM;l4߷IXF\Kd;@do[Kb=BAhl7SuıN3!͐}t6j@rL.k)MJB֫$T&;%(”<"ըm@R/N% Vc{Lpfny}ZbsbGV֍>A$S\RjCL񹉷 (Mc)y:}J(`5*4BzUozXT䒤lzyaԕ`=J/3ҝ5aӣLm@>^{MԦ[dfPI^w[K&#fTKjzBm ~B(WKfV7E;]/<_2o|Om]A=1makb2 K`?vJZCI1b2PS,~ +1Qv[QY@ r^N5)]T&U'9'R){Ǎ)c}nAGw=G0_bO$ .@@G`'ۘJRjZ\H FdsQH= 6z2230aF)kݍ`VA3:YjF,/2zGo\iZU{ERv?'ԁ6ZGPUF6jn/rǑ4[CT6A>X@٩VCikJ P%sA|EP_5iYN7e]An/PjԪ9ojv"'KM:Re ;l~gIUHӲְ"UTaIG= Qͩ..T|3+=;CD껆c-3Wqd[qZ}o=3"#߱KnvyR*+j}>1u|m2^؈T(RJyzJ]>O =: ^GWuT6lxc "h56a*3>T))eet({(.i.Ӆߞ`V qdZg-sYR:dN.G'ոӭ}I};͡X qS{7żJbD)f,طVQQFIcv=q~ش[\ݺu(jn,czk+Z0M5r?y7]m=b 6aK_=kj/X18a*Jfڔꐡ֡m}Y2nn~Kglade-0.12.1/demo/profileviewer/0000755000000000000000000000000011633370304014643 5ustar0000000000000000glade-0.12.1/demo/profileviewer/ParseProfile.hs0000644000000000000000000000765511633370304017607 0ustar0000000000000000-- Copyright (c) 2004 Duncan Coutts -- This library is liscenced under the GNU General Public License version 2 -- or (at your option) any later version. -- This is a not-terribly-clever parser for ghc's time profile log files. module ParseProfile ( Profile(..), ProfileNode(..), parseProfileFile, pruneOnThreshold ) where import Data.Char import Data.Maybe (catMaybes) data Profile = Profile { title :: String, command :: String, totalTime :: Float, totalAlloc :: Integer, --can be several GB breakdown :: ProfileNode } data ProfileNode = ProfileNode { costCentre :: String, moduleName :: String, entries :: !Int, individualTime :: !Int, --scaled by 10 individualAlloc :: !Int, --scaled by 10 inheritedTime :: !Int, --scaled by 10 inheritedAlloc :: !Int, --scaled by 10 children :: [ProfileNode] } pruneOnThreshold :: Int -> ProfileNode -> Maybe ProfileNode pruneOnThreshold threshold node | inheritedTime node >= threshold || inheritedAlloc node >= threshold = let children' = catMaybes $ map (pruneOnThreshold threshold) (children node) in Just $ node { children = children' } | otherwise = Nothing parseProfileFile :: String -> IO Profile parseProfileFile filename = do content <- readFile filename let (titleLine:_:commandLine:_:timeLine:allocLine:theRest) = lines content profileDetail = dropWhile (\line -> take 4 line /= "MAIN") theRest return $ Profile { title = dropWhile isSpace titleLine, command = dropWhile isSpace commandLine, totalTime = read $ words timeLine !! 3, totalAlloc = read $ filter (/=',') $ words allocLine !! 3, breakdown = parseProfile profileDetail } -- intermediate form data ProfileEntry = ProfileEntry { depth :: !Int, ecostCentre :: String, emoduleName :: String, eentries :: !Int, eindividualTime :: !Int, --scaled by 10 eindividualAlloc :: !Int, --scaled by 10 einheritedTime :: !Int, --scaled by 10 einheritedAlloc :: !Int --scaled by 10 } parseProfile :: [String] -> ProfileNode parseProfile file = case (profileEntriesToProfile [] 0 . map parseProfileEntry) file of ([profile],[]) -> profile _ -> error "multiple top level entries" parseProfileEntry :: String -> ProfileEntry parseProfileEntry line = let depth = length (takeWhile (==' ') line) in case words line of [costCentre, moduleName, _, entries, individualTime, individualAlloc, inheritedTime, inheritedAlloc] -> ProfileEntry { depth = depth, ecostCentre = costCentre, emoduleName = moduleName, eentries = read entries, eindividualTime = floor $ (read individualTime) * 10, eindividualAlloc = floor $ (read individualAlloc) * 10, einheritedTime = floor $ (read inheritedTime) * 10, einheritedAlloc = floor $ (read inheritedAlloc) * 10 } _ -> error $ "bad profile line:\n\t" ++ line profileEntriesToProfile :: [ProfileNode] -> Int -> [ProfileEntry] -> ([ProfileNode], [ProfileEntry]) profileEntriesToProfile acum curDepth [] = (acum, []) profileEntriesToProfile acum curDepth (entry:entries) | depth entry == curDepth = let (children, remaining) = profileEntriesToProfile [] (depth entry + 1) entries curNode = ProfileNode { costCentre = ecostCentre entry, moduleName = emoduleName entry, entries = eentries entry, individualTime = eindividualTime entry, individualAlloc = eindividualAlloc entry, inheritedTime = einheritedTime entry, inheritedAlloc = einheritedAlloc entry, children = children } in profileEntriesToProfile (curNode:acum) (depth entry) remaining | depth entry < curDepth = (acum, entry:entries) --we're done for this level | otherwise = error "bad indentation in file" glade-0.12.1/demo/profileviewer/ProfileViewer.gladep0000644000000000000000000000043711633370304020607 0ustar0000000000000000 ProfileViewer profileviewer FALSE glade-0.12.1/demo/profileviewer/ProfileViewer.glade0000644000000000000000000003646511633370304020441 0ustar0000000000000000 True GHC timing profile viewer GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False 650 400 True False True False 0 True True _File True True gtk-open True True True gtk-quit True True _View True True All entries True True True Only entries with 0.1% or more True False allEntries True Only entries with 0.5% or more True False allEntries True Only entries with 1% or more True False allEntries True Only entries with 5% or more True False allEntries True Only entries with 10% or more True False allEntries True Only entries with 50% or more True False allEntries True _Help True True _About True 0 False False 5 True 4 2 False 2 10 True <b>Total time</b> False True GTK_JUSTIFY_RIGHT False False 1 0.5 0 0 0 1 2 3 fill True <b>Total alloc</b> False True GTK_JUSTIFY_LEFT False False 1 0.5 0 0 0 1 3 4 fill True True False False GTK_JUSTIFY_LEFT False True 0 0.5 0 0 1 2 0 1 expand|shrink|fill True True False False GTK_JUSTIFY_LEFT False True 0 0.5 0 0 1 2 2 3 fill True True False False GTK_JUSTIFY_LEFT False True 0 0.5 0 0 1 2 3 4 fill True <b>Report</b> False True GTK_JUSTIFY_RIGHT False False 1 0.5 0 0 0 1 0 1 fill True <b>Command</b> False True GTK_JUSTIFY_RIGHT False False 1 0.5 0 0 0 1 1 2 fill True False False GTK_JUSTIFY_LEFT True False 0 0 0 0 1 2 1 2 fill 0 False False True True GTK_POLICY_AUTOMATIC GTK_POLICY_AUTOMATIC GTK_SHADOW_NONE GTK_CORNER_TOP_LEFT True True True True False True 0 True True True True 0 False False glade-0.12.1/demo/profileviewer/Makefile0000644000000000000000000000027611633370304016310 0ustar0000000000000000 PROG = profileviewer SOURCES = ProfileViewer.hs ParseProfile.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc glade-0.12.1/demo/profileviewer/ProfileViewer.hs0000644000000000000000000001556611633370304017776 0ustar0000000000000000-- Copyright (c) 2004 Duncan Coutts -- This program is liscenced under the GNU General Public License version 2 -- or (at your option) any later version. -- This is a slightly larger demo that combines use of glade, the file chooser -- dialog, program state (IORefs) and use of the mogul tree view wrapper -- interface. -- The program is a simple viewer for the log files that ghc produces when you -- do time profiling. The parser is not very clever so loading large files can -- take several seconds. -- TODO: The gui will appear to hang when loading files. We should use threads -- to keep the gui responsive. module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade import Graphics.UI.Gtk.ModelView as New import ParseProfile import Data.Maybe (isJust, fromJust) import Control.Monad (when) import Data.List (unfoldr, intersperse) import qualified Data.Tree as Tree import System.Environment (getArgs) import Data.IORef main :: IO () main = do -- our global state thresholdVar <- newIORef 0 --current cuttoff/threshhold value profileVar <- newIORef Nothing --holds the current profile data structure -- initialisation stuff initGUI Just dialogXml <- xmlNew "ProfileViewer.glade" -- get a handle on a various objects from the glade file mainWindow <- xmlGetWidget dialogXml castToWindow "mainWindow" onDestroy mainWindow mainQuit mainView <- xmlGetWidget dialogXml castToTreeView "mainView" titleLabel <- xmlGetWidget dialogXml castToLabel "titleLabel" commandLabel <- xmlGetWidget dialogXml castToLabel "commandLabel" totalTimeLabel <- xmlGetWidget dialogXml castToLabel "totalTimeLabel" totalAllocLabel <- xmlGetWidget dialogXml castToLabel "totalAllocLabel" -- create the tree model store <- New.treeStoreNew [] New.treeViewSetModel mainView store let createTextColumn name field = do column <- New.treeViewColumnNew New.treeViewAppendColumn mainView column New.treeViewColumnSetTitle column name cell <- New.cellRendererTextNew New.treeViewColumnPackStart column cell True New.cellLayoutSetAttributes column cell store (\record -> [New.cellText := field record]) -- create the various columns in both the model and view createTextColumn "Cost Centre" costCentre createTextColumn "Module" moduleName createTextColumn "Entries" (show.entries) createTextColumn "Individual %time" (show.(/10).fromIntegral.individualTime) createTextColumn "Individual %alloc" (show.(/10).fromIntegral.individualAlloc) createTextColumn "Inherited %time" (show.(/10).fromIntegral.inheritedTime) createTextColumn "Inherited %alloc" (show.(/10).fromIntegral.inheritedAlloc) -- this action clears the tree model and then populates it with the -- profile contained in the profileVar, taking into account the current -- threshold value kept in the thresholdVar let repopulateTreeStore = do profile <- readIORef profileVar maybe (return ()) repopulateTreeStore' profile repopulateTreeStore' profile = do New.treeStoreClear store titleLabel `labelSetText` (title profile) commandLabel `labelSetText` (command profile) totalTimeLabel `labelSetText` (show (totalTime profile) ++ " sec") totalAllocLabel `labelSetText` (formatNumber (totalAlloc profile) ++ " bytes") threshold <- readIORef thresholdVar let node = if threshold > 0 then pruneOnThreshold threshold (breakdown profile) else Just (breakdown profile) toTree :: ProfileNode -> Tree.Tree ProfileNode toTree = Tree.unfoldTree (\node -> (node, children node)) case node of Nothing -> return () Just node -> New.treeStoreInsertTree store [] 0 (toTree node) -- associate actions with the menus -- the open menu item, opens a file dialog and then loads and displays -- the the profile (unless the user cancleled the dialog) openMenuItem <- xmlGetWidget dialogXml castToMenuItem "openMenuItem" openMenuItem `onActivateLeaf` do filename <- openFileDialog mainWindow when (isJust filename) (do profile <- parseProfileFile (fromJust filename) writeIORef profileVar (Just profile) repopulateTreeStore) quitMenuItem <- xmlGetWidget dialogXml castToMenuItem "quitMenuItem" quitMenuItem `onActivateLeaf` mainQuit aboutMenuItem <- xmlGetWidget dialogXml castToMenuItem "aboutMenuItem" aboutMenuItem `onActivateLeaf` showAboutDialog mainWindow -- each menu item in the "View" menu sets the thresholdVar and re-displays -- the current profile let doThresholdMenuItem threshold itemName = do menuItem <- xmlGetWidget dialogXml castToMenuItem itemName menuItem `onActivateLeaf` do writeIORef thresholdVar threshold repopulateTreeStore mapM_ (uncurry doThresholdMenuItem) [(0, "allEntries"), (1, "0.1%Entries"), (5, "0.5%Entries"), (10, "1%Entries"), (50, "5%Entries"), (100, "10%Entries"), (500, "50%Entries")] -- Check the command line to see if a profile file was given commands <- getArgs when (not (null commands)) (do profile <- parseProfileFile (head commands) writeIORef profileVar (Just profile) repopulateTreeStore) -- The final step is to display the main window and run the main loop widgetShowAll mainWindow mainGUI -- display a standard file open dialog openFileDialog :: Window -> IO (Maybe String) openFileDialog parentWindow = do dialog <- fileChooserDialogNew (Just "Open Profile... ") (Just parentWindow) FileChooserActionOpen [("gtk-cancel", ResponseCancel) ,("gtk-open", ResponseAccept)] widgetShow dialog response <- dialogRun dialog widgetHide dialog case response of ResponseAccept -> fileChooserGetFilename dialog _ -> return Nothing -- just to display a number using thousand seperators -- eg "3,456,235,596" formatNumber :: Integer -> String formatNumber = reverse . concat . intersperse "," . unfoldr (\l -> case splitAt 3 l of ([], _) -> Nothing p -> Just p) . reverse . show showAboutDialog :: Window -> IO () showAboutDialog parent = do -- create the about dialog aboutDialog <- aboutDialogNew -- set some attributes set aboutDialog [ aboutDialogName := "profileviewer", aboutDialogVersion := "0.2", aboutDialogCopyright := "Duncan Coutts", aboutDialogComments := "A viewer for GHC time profiles.", aboutDialogWebsite := "http://haskell.org/gtk2hs/" ] -- make the about dialog appear above the main window windowSetTransientFor aboutDialog parent -- make the dialog non-modal. When the user closes the dialog destroy it. afterResponse aboutDialog $ \_ -> widgetDestroy aboutDialog widgetShow aboutDialog glade-0.12.1/demo/calc/0000755000000000000000000000000011633370304012663 5ustar0000000000000000glade-0.12.1/demo/calc/CalcModel.hs0000644000000000000000000001134011633370304015041 0ustar0000000000000000-- A simple push button calcualtor without operator precedence module CalcModel ( Number, Calc, BinOp, plus, minus, times, divide, clearCalc, enterDigit, enterDecimalPoint, enterBinOp, evaluate ) where import Data.Char (isDigit) import Control.Monad (when) import Numeric (showGFloat) -- we could change this to rational type Number = Double data Calc = Calc { number :: [Digit], operator :: BinOp, total :: Number, resetOnNum :: Bool -- a state flag, after pressing '=', if we enter an } -- operator then we're carrying on the previous -- calculation, otherwise we should start a new one. data Digit = Digit Int -- in range [0..9] | DecimalPoint deriving Eq data BinOp = BinOp (Number -> Number -> Number) plus, minus, times, divide :: BinOp plus = BinOp (+) minus = BinOp (-) times = BinOp (*) divide = BinOp (/) clearCalc :: Calc clearCalc = Calc { number = [], operator = plus, total = 0, resetOnNum = True } -- Maybe for the case when the operation makes no sense enterDigit :: Int -> Calc -> Maybe (String, Calc) enterDigit digit calc | digit `elem` [0..9] && not (number calc == [] && digit == 0) = let newNumber = number calc ++ [Digit digit] in if resetOnNum calc then Just (show newNumber, calc { number = newNumber, total = 0, resetOnNum = False }) else Just (show newNumber, calc { number = newNumber }) | otherwise = Nothing enterDecimalPoint :: Calc -> Maybe (String, Calc) enterDecimalPoint calc | DecimalPoint `notElem` number calc = let newNumber = number calc ++ [DecimalPoint] in if resetOnNum calc then Just (show newNumber, calc { number = newNumber, total = 0, resetOnNum = False }) else Just (show newNumber, calc { number = newNumber }) | otherwise = Nothing enterBinOp :: BinOp -> Calc -> Maybe (String, Calc) enterBinOp binop calc = let newTotal = (case operator calc of BinOp op -> op) (total calc) (digitsToNumber (number calc)) in Just (showNumber newTotal, Calc { number = [], operator = binop, total = newTotal, resetOnNum = False }) evaluate :: Calc -> Maybe (String, Calc) evaluate calc = let newTotal = (case operator calc of BinOp op -> op) (total calc) (digitsToNumber (number calc)) in Just (showNumber newTotal, Calc { number = [], operator = plus, total = newTotal, resetOnNum = True }) instance Show Digit where show (Digit n) = show n show DecimalPoint = "." showList = showString . concatMap show digitsToNumber :: [Digit] -> Number digitsToNumber [] = 0 digitsToNumber digits@(DecimalPoint:_) = digitsToNumber (Digit 0:digits) digitsToNumber digits | last digits == DecimalPoint = digitsToNumber (init digits) | otherwise = read (show digits) --CHEAT! precision = Just 5 --digits of precision, or Nothing for as much as possible showNumber :: Number -> String showNumber num = if '.' `elem` numStr then stripTrailingZeros numStr else numStr where numStr = showGFloat precision num "" stripTrailingZeros = reverse . (\str -> if head str == '.' then tail str else str) . dropWhile (\c -> c=='0') . reverse testProg :: IO () testProg = do evalLoop clearCalc where evalLoop :: Calc -> IO () evalLoop calc = do putStr "calc> " line <- getLine when (line /= "q") $ do result <- case line of [digit] | isDigit digit -> return $ enterDigit (read [digit]) calc "." -> return $ enterDecimalPoint calc "+" -> return $ enterBinOp plus calc "-" -> return $ enterBinOp minus calc "*" -> return $ enterBinOp times calc "/" -> return $ enterBinOp divide calc "=" -> return $ evaluate calc "c" -> return $ Just ("0",clearCalc) _ -> do putStrLn "invalid input" return Nothing case result of Nothing -> evalLoop calc Just (display, calc') -> do putStrLn display evalLoop calc' glade-0.12.1/demo/calc/Calc.hs0000644000000000000000000000446311633370304014070 0ustar0000000000000000module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.Glade import Data.IORef import qualified CalcModel as Calc main = do initGUI -- load up the glade file calcXmlM <- xmlNew "calc.glade" let calcXml = case calcXmlM of (Just calcXml) -> calcXml Nothing -> error "can't find the glade file \"calc.glade\" \ \in the current directory" -- get a handle on a some widgets from the glade file window <- xmlGetWidget calcXml castToWindow "calcwindow" display <- xmlGetWidget calcXml castToLabel "display" -- a list of the names of the buttons and the actions associated with them let buttonNamesAndOperations = numbericButtons ++ otherButtons numbericButtons = [ ("num-" ++ show n, Calc.enterDigit n) | n <- [0..9] ] otherButtons = [("decimal", Calc.enterDecimalPoint) ,("op-plus", Calc.enterBinOp Calc.plus) ,("op-minus", Calc.enterBinOp Calc.minus) ,("op-times", Calc.enterBinOp Calc.times) ,("op-divide", Calc.enterBinOp Calc.divide) ,("equals", Calc.evaluate) ,("clear", \_ -> Just ("0", Calc.clearCalc))] -- action to do when a button corresponding to a calculator operation gets -- pressed: we update the calculator state and display the new result. -- These calculator operations can return Nothing for when the operation -- makes no sense, we do nothing in this case. calcRef <- newIORef Calc.clearCalc let calcOperation operation = do calc <- readIORef calcRef case operation calc of Nothing -> return () Just (result, calc') -> do display `labelSetLabel` ("" ++ result ++ "") writeIORef calcRef calc' -- get a reference to a button from the glade file and attach the -- handler for when the button is pressed connectButtonToOperation name operation = do button <- xmlGetWidget calcXml castToButton name button `onClicked` calcOperation operation -- connect up all the buttons with their actions. mapM_ (uncurry connectButtonToOperation) buttonNamesAndOperations -- make the program exit when the main window is closed window `onDestroy` mainQuit -- show everything and run the main loop widgetShowAll window mainGUI glade-0.12.1/demo/calc/Makefile0000644000000000000000000000025111633370304014321 0ustar0000000000000000 PROG = calc SOURCES = Calc.hs CalcModel.hs $(PROG) : $(SOURCES) $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG) HC=ghc glade-0.12.1/demo/calc/calc.glade0000644000000000000000000003442111633370304014567 0ustar0000000000000000 4 True Calculator GTK_WINDOW_TOPLEVEL GTK_WIN_POS_CENTER False True False True False 4 True <big>0</big> False True GTK_JUSTIFY_RIGHT False False 1 0.5 0 0 0 False False True 5 4 True 4 4 True True . True GTK_RELIEF_NORMAL 2 3 4 5 True True 0 True GTK_RELIEF_NORMAL 0 2 4 5 True True 1 True GTK_RELIEF_NORMAL 0 1 3 4 True True 2 True GTK_RELIEF_NORMAL 1 2 3 4 True True 4 True GTK_RELIEF_NORMAL 0 1 2 3 True True 5 True GTK_RELIEF_NORMAL 1 2 2 3 True True 7 True GTK_RELIEF_NORMAL 0 1 1 2 True True 8 True GTK_RELIEF_NORMAL 1 2 1 2 True True 3 True GTK_RELIEF_NORMAL 2 3 3 4 True True 6 True GTK_RELIEF_NORMAL 2 3 2 3 True True 9 True GTK_RELIEF_NORMAL 2 3 1 2 True True ÷ True GTK_RELIEF_NORMAL 1 2 0 1 True True × True GTK_RELIEF_NORMAL 2 3 0 1 True True - True GTK_RELIEF_NORMAL 3 4 0 1 True True + True GTK_RELIEF_NORMAL 3 4 1 3 True True = True GTK_RELIEF_NORMAL 3 4 3 5 45 40 True True AC True GTK_RELIEF_NORMAL 0 1 0 1 fill 0 True True glade-0.12.1/demo/noughty/0000755000000000000000000000000011633370304013456 5ustar0000000000000000glade-0.12.1/demo/noughty/NoughtyGlade.hs0000644000000000000000000001071611633370304016411 0ustar0000000000000000-- Copyright (c) 2006, Wouter Swierstra -- All rights reserved. -- This code is released under the BSD license -- included in this distribution -- Imports import System.IO import Data.Maybe import Data.List import Graphics.UI.Gtk hiding (Cross) import Graphics.UI.Gtk.Glade import Data.IORef import Control.Monad -- Players, boards and some useful pure functions data Player = Nought | Blank | Cross deriving (Ord, Eq, Show) next :: Player -> Player next Nought = Cross next Blank = Blank next Cross = Nought type Board = [[Player]] size :: Int size = 3 empty :: Board empty = replicate size (replicate size Blank) move :: Int -> Player -> Board -> Maybe Board move n p b = case y of Blank -> Just (chop size (xs ++ (p : ys))) _ -> Nothing where (xs,y:ys) = splitAt n (concat b) chop :: Int -> [a] -> [[a]] chop n [] = [] chop n xs = take n xs : chop n (drop n xs) diag :: [[a]] -> [a] diag xss = [xss !! n !! n | n <- [0 .. length xss - 1]] full :: Board -> Bool full b = all (all (/= Blank)) b wins :: Player -> Board -> Bool wins p b = any (all (== p)) b || any (all (== p)) (transpose b) || all (== p) (diag b) || all (== p) (diag (reverse b)) won :: Board -> Bool won b = wins Nought b || wins Cross b -- The state and GUI data State = State { board :: Board, turn :: Player } data GUI = GUI { disableBoard :: IO (), resetBoard :: IO (), setSquare :: Int -> Player -> IO (), setStatus :: String -> IO () } -- reset the game reset gui (State board turn) = do setStatus gui "Player Cross: make your move." resetBoard gui return (State empty Cross) -- when a square is clicked on, try to make a move. -- if the square is already occupied, nothing happens -- otherwise, update the board, let the next player make his move, -- and check whether someone has won or the board is full. occupy gui square st@(State board player) = do case move square player board of Nothing -> return st Just newBoard -> do setSquare gui square player handleMove gui newBoard player return (State newBoard (next player)) -- check whether a board is won or full handleMove gui board player | wins player board = do setStatus gui ("Player " ++ show player ++ " wins!") disableBoard gui | full board = do setStatus gui "It's a draw." disableBoard gui | otherwise = do setStatus gui ("Player " ++ show (next player) ++ ": make your move") main = do initGUI -- Extract widgets from the glade xml file Just xml <- xmlNew "noughty.glade" window <- xmlGetWidget xml castToWindow "window" window `onDestroy` mainQuit newGame <- xmlGetWidget xml castToMenuItem "newGame" quit <- xmlGetWidget xml castToMenuItem "quit" squares <- flip mapM [1..9] $ \n -> do square <- xmlGetWidget xml castToButton ("button" ++ show n) -- we set this in the glde file but it doesn't seem to work there. set square [ widgetCanFocus := False ] return square images <- flip mapM [1..9] $ \n -> do xmlGetWidget xml castToImage ("image" ++ show n) statusbar <- xmlGetWidget xml castToStatusbar "statusbar" ctx <- statusbarGetContextId statusbar "state" statusbarPush statusbar ctx "Player Cross: make your move." -- Construct the GUI actions that abstracts from the actual widgets gui <- guiActions squares images statusbar ctx -- Initialize the state state <- newIORef State { board = empty, turn = Cross } let modifyState f = readIORef state >>= f >>= writeIORef state -- Add action handlers onActivateLeaf quit mainQuit onActivateLeaf newGame $ modifyState $ reset gui zipWithM_ (\square i -> onPressed square $ modifyState $ occupy gui i) squares [0..8] widgetShowAll window mainGUI guiActions buttons images statusbar ctx = do noughtPic <- pixbufNewFromFile "Nought.png" crossPic <- pixbufNewFromFile "Cross.png" return GUI { disableBoard = mapM_ (flip widgetSetSensitivity False) buttons, resetBoard = do mapM_ (\i -> imageClear i >> widgetQueueDraw i) images mapM_ (flip widgetSetSensitivity True) buttons, setSquare = \ i player -> case player of Cross -> set (images !! i) [ imagePixbuf := crossPic ] Nought-> set (images !! i) [ imagePixbuf := noughtPic ], setStatus = \msg -> do statusbarPop statusbar ctx statusbarPush statusbar ctx msg return () } glade-0.12.1/demo/noughty/noughty.glade0000644000000000000000000003176611633370304016166 0ustar0000000000000000 Noughty GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False False False True False False GDK_WINDOW_TYPE_HINT_NORMAL GDK_GRAVITY_NORTH_WEST True False True False 0 True GTK_PACK_DIRECTION_LTR GTK_PACK_DIRECTION_LTR True _Game True True _New Game True True True _Quit True 0 False False 10 True 5 5 False 0 0 True 0 5 1 2 fill fill True 1 2 0 5 fill fill True 3 4 0 5 fill fill 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 0 1 0 1 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 2 3 0 1 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 4 5 0 1 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 0 1 2 3 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 2 3 2 3 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 4 5 2 3 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 0 1 4 5 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 2 3 4 5 100 100 True GTK_RELIEF_NONE False True 0.5 0.5 0 0 4 5 4 5 True 0 5 3 4 fill fill 0 True True True False 0 False False glade-0.12.1/demo/noughty/Nought.png0000644000000000000000000002016711633370304015436 0ustar0000000000000000PNG  IHDRqq~L xiCCPICC ProfilexgXY*H U H(QHHHBa;XtlXPi*X*"d :6~Hԝgss=s^@S F$РK1D0x Wu֏׏bޑ*Y a@+EjJڱbHdď성qJ>@%Qj"6cqx%@aEIK(n/|U@(n9|0;o(B( @(ndo>oHFH$N)̒"K5)49yE%Uu M1zF&ll;Lprvqu :5lzxdTtl܌Y ̛NNI,LKB8sQ%?ܥWr5k׭߰q-[=o]ݷ=tNJ8qT3gΖW;BŪK55\z7oݪo}Ʀ{[Z>xa{GGgWWw?~ٳ/~?޼z?}d*]NAQYUMCS[GWOЈabfn9~.n'O :mzxDdt̟ɩit_!gf}? N}CN:-lzxDdTtLll܌fϙ;WF% i}$$$$m)(Yzǎ?qԩgΖ}kKjo}nӽvtu<~y_o}"whL60 Xu2BHe !g>Q2w dA:0 \؃4_+MMD1H tI>$6i+ALɣ G\j%#͕&rT0<++X(d)R4R)Rb(e+5))U2WZBZZjAy5̴vki1)4Rwn؅cGӯ233\idbTe<3$iBhKeٸ+cNm6Ѷڶv3[Py'ggsj4ϗzyWwzW i StDžY0C{bvyW.=16\˩KLJVy6gsN, [ӫU֜_wM?ma{qݝ< 65cr瞬=m~v]`E5]Wjo o8~g)H[H{^D=u+/}U?5⏗?~H$Ο%h@p$LL`b/NxKD !.H椩$iE#ȷMMi*P9 a;mz}-\\FBabb@鮲v$zՉՔPޠQyDTPBHYjLlᱛ 6q0fMMYff7s-,,Ʊ,llKƯpHpt5aȩŹbAuݸ=<'{yzO0?P&xoHO\¸O4J>3=c{xk[:閘ϒgN\Jf 'd^ZݽDzNqn{~]9ڄ6oμwٵTŽkXwbɩ}}_f]1ʫU5>W];w-Uo6jc> ( }_G^4dnWvH$ӗ&p?f8&%"A\#ޑHHE^)I>@~J(tzGnM99/y;<BH1F񆒷Rr SW5Ulu Fff֏چ5:ic4\5ۮ~uUFrw{LL')f^ig1.ZF9:LT|pir[nI^s}Nշo0"pNP^ݐ/nSӧk׊̍C9=v8ݹy +X1 i\^<%#F lY4;gI#9s͗^XūTKX/xr쭴mǷء®݃{/(R!"@! aqtn8XZ% h%G=((Ff%sC@ @ — S#e Y Yn~Z4%8}]T5:8 @.I " I > <0 "D&d H .Ȅ`Ba/:3 !8%9˅g=g:wsC=[E6xVVO:巌o3EBۇ=Y`C4<9˿AMOl1T1O tA-c1]&$IDATx{}?t3Hx BP&nK.JI^]~yأ]6ðs> }[W6U| z%j41Y*I,#H^OY -Lן3WsNbҾ=JrLq0$vLo|6/K3 ?Y< d:9n)ƃDݎIj۷Ie?d|9lw{LL%sI-_:J`*0 f3O{ s75QlWBU* `zJYB^sj5׍V**:'rcYϖ_ K+so >70L!&̶"O(nܓ<׶ ̺G'HyU!Xw/)sRE]TR)tEB;P0yLΓp3[m~W̓pQbʾn}}І9$(r@=}-*Sӱ:iiͩ|PH5zg:9Ӓ//x7|݄@N&Om/u%IfyfS?:_[zM*G%y(XsP}΂pдB5ӤS^F@n _fY aR83z{]:s& 6A_K_{ |})kV9FTc9)͜he8/mqo/ò0nmc<((zͨ.lE?Q-[E|Cet^GR N.ħp75|!-$[EELy6q`:q7D|XP0Zq75v87*j(ZYR-YR7/?9tI0 - (9˼aSW-_E##%P?,®k`N_)ẩ8"u%Z$jŌE`pO}pwj:;[Ǐ9x≠b#;E\pD#sa:@l8!7ڟ@~78k'̺>_ڴ 4MNM-Xq6ř ,ZKg_ Q7 @bpNL8LX}υ其;̌b8&3f%,cB8䠬y 8xJezQoXm8dd] 6N;-68+|(T@kC!@yHL;Q歞.ҥ 6HQU CvPٯ.sDk5lvl._,yfh̟u&̥zG_E;DiʪQ C3^m?| AٺaNgy[(upڵ1o^Eh? %nhΚJ 5m圵;7 ֶ ~nPXE2ă¶YGjfdZ?ya*OQ mL79 T *BI^ᶱڵ)%vz`W8R\&VCY,5D-6OLwh +8k[;8k>&.$bU/>xShR-yspnFe,|},uE%f='imMnu$&T~b*'&m}h4;R)*-!ڿPЇF!%>&M ,T\( snx97[swŚ5A`nT_ "f{D7m^vU~^eM˓2 +Wgm+^^ ۰dgq0&zq'yw%1Eu*F+HIغ=]|E7mw0{op; sb m2% e"VX6lʺ6 ;H9=?Hwó%NXIZuZ*1ol/%X/8oLӿ-/3ΧRj#7Kl֑SO5Pq5g_oq 2TS`E?]?~FFK_[r .&jJVD z?  `(qc߃?p] Iv`bC y6Yl`hnKm< |++V7 fe@;7jCp7z鰕̃.ZXA@ 52}NOS3@lVÖ破 owG5>T_}9~8W=#"V5%SN,4ɜiY''}1U>8t8TE ׻:ʍs \?/':5P2HvĈ}!ʟA`hwA> ׿ޫ6ýϸ c[dQ^oRNkYkJHg.g]爗*O/^:  Lo[K)@ggNi+W-4ICDbɪfTEIWCZLR*ˁtMdql צ[a#?/UOl"0΋w*6X&%+.vRN.0JP@䝢Ҋ1a֥0858W]wW,$Wż :(}GDFHc VJK+Q(DzҲ_Άf3{CT(tB#0:û`d+|  [tMUI%jYMvhBhFZ}|OD9/6Z6v3I/#ѶyH5vI[Nu0^@iT k%!>c!qfZX@KiiCfֱ׳c$ʏ*X:/-"~yY1SjmG-OI$6JׁS2z"3u,]2[ioḤUVQ,s+W A.m4] m>f Aw^*UH&gZD)ϜRj&U>V_!w -i )ϢJIѝZH[j2cIa>cc;ЖD1$Xu)W>N(W!4"%"-(o|a?PhEj)f_wgIԧD}*v6i!(uE -A:̵YsjeDyfYEs#UӰYme@>qmި[|OvhTFU܄ӉTRaBUMVgL~HOZPc9Wd'9AmAILR%}2x>ORZ[)P$ ʙM8oҫ9)mE`w!1 I݊jIZۑ5ILb$&[ 40PIENDB`glade-0.12.1/demo/noughty/Cross.png0000644000000000000000000002036711633370304015265 0ustar0000000000000000PNG  IHDR@%Qj"6cqx%@aEIK(n/|U@(n9|0;o(B( @(ndo>oHFH$N)̒"K5)49yE%Uu M1zF&ll;Lprvqu :5lzxdTtl܌Y ̛NNI,LKB8sQ%?ܥWr5k׭߰q-[=o]ݷ=tNJ8qT3gΖW;BŪK55\z7oݪo}Ʀ{[Z>xa{GGgWWw?~ٳ/~?޼z?}d*]NAQYUMCS[GWOЈabfn9~.n'O :mzxDdt̟ɩit_!gf}? N}CN:-lzxDdTtLll܌fϙ;WF% i}$$$$m)(Yzǎ?qԩgΖ}kKjo}nӽvtu<~y_o}"whL60 Xu2BHe !g>Q2w dA:0 \؃4_+MMD1H tI>$6i+ALɣ G\j%#͕&rT0<++X(d)R4R)Rb(e+5))U2WZBZZjAy5̴vki1)4Rwn؅cGӯ233\idbTe<3$iBhKeٸ+cNm6Ѷڶv3[Py'ggsj4ϗzyWwzW i StDžY0C{bvyW.=16\˩KLJVy6gsN, [ӫU֜_wM?ma{qݝ< 65cr瞬=m~v]`E5]Wjo o8~g)H[H{^D=u+/}U?5⏗?~H$Ο%h@p$LL`b/NxKD !.H椩$iE#ȷMMi*P9 a;mz}-\\FBabb@鮲v$zՉՔPޠQyDTPBHYjLlᱛ 6q0fMMYff7s-,,Ʊ,llKƯpHpt5aȩŹbAuݸ=<'{yzO0?P&xoHO\¸O4J>3=c{xk[:閘ϒgN\Jf 'd^ZݽDzNqn{~]9ڄ6oμwٵTŽkXwbɩ}}_f]1ʫU5>W];w-Uo6jc> ( }_G^4dnWvH$ӗ&p?f8&%"A\#ޑHHE^)I>@~J(tzGnM99/y;<BH1F񆒷Rr SW5Ulu Fff֏چ5:ic4\5ۮ~uUFrw{LL')f^ig1.ZF9:LT|pir[nI^s}Nշo0"pNP^ݐ/nSӧk׊̍C9=v8ݹy +X1 i\^<%#F lY4;gI#9s͗^XūTKX/xr쭴mǷء®݃{/(R!"@! aqtn8XZ% h%G=((Ff%sC@ @ — S#e Y Yn~Z4%8}]T5:8 @.I " I > <0 "D&d H .Ȅ`Ba/:3 !8%9˅g=g:wsC=[E6xVVO:巌o3EBۇ=Y`C4<9˿AMOl1T1O tA-c1]&$:IDATx]yչ ̠ "Ⱦ A{ O "(dqyO_sԣ/'&Qf@1ghnTШ : w3/7otWΩso{t \7#d{uߑv/\7  TRMߪdeS'S\7 M$#Q2! A y KGr*3Hl!Q~H2}%4PV=Ӌ@,t`$I`I.A, 2 5D`㪄{+;)`HO^Y^C㻛(u~K0@@XNs zkAzm2@8k֑+ xI["IWbP۬⪭"ڈ㿥$ i0iSU$IնEx|RX !CƫAZ;[n p0̟T&ALMHrXUrfʼGs8% H՝ud 7˥7FRK5/ t$^A5ރwB&=n~T,.@#t7r!I: <5G3sx,P@~g b+mX[t*YiI^Hr@s xzf:v/#zPt }s7p%I&qr`6+^ORϒM!& z3h)9|k  &Ap"B1O"(=oZR*Ӄ]5xۥV Đ*5Ֆd[F*s_GAQX0͌|7TBI72Vf793Nԩԁ29/5svQb/<4I7iQa<#fSaIxrv&/²K= ::n≘lMHcf rsTϓy3;p+30uB9NHl28ȴc8׼svAeON්QIt.ЩgT>:<|qicwo J{3v}kOS x&I&ڍ BN'i9C~0Y' x&Igoȭ7DZg5 x&coe$y A *߸Osr.ANSͷґ$c]&UZH&> NPL=o0Wzx8෯m4Ւ&krPX(GIbX{ncRn}i?Xڝ{2֚(ʦGjX7>êhX} aKQ- ncsslZVc!vRh<،g=Xxj`=ɝ-X5EDw>f{& .1[@#~?a9jvh-tDSM/_֫tYRh5X5.a~81l[0\Ucɦ\Jl-AE}J;VOX4ec%Cѽ9s9ǁ\wNx5V3{ Kl Ԗ'h}ف<&uP6(T]C"3X*chv`Kfd6Ik8nlC'l;P _ځ GX${`e-L0],RDKٯAwP.(~Ʊl nGL**-;%!I*ZP~+$ cŤPW^ Rr7bmgyx[_~߬#B|D*s5ĢMII\Wg/Z}oU:6X?E+QV3 ,;ԕG`w2_201oב㒄뜙l ZVT`]7(t6F :4m՛0oG짱C:b#y& Q~e _0E=zvd5%hfiå }Z|Q5 ۪ldJe,õ;6ęu8 <Ep^}58L }]yy˓@<=oal\Z&A0$D>HY~{6n^ T-(E"V"A!,u|m8 ]SNU\6P#$#'AcyC`#Z ҁR4ٍW\: ڠ{3*7.%|Q)~lf\+R"H>D0N(Y RjqHܲN,(IZ$rN- LJ76΃t| nc)ATO5%ƫԌ-v^xiW>I:CfX\|A>%,:F ΓƦ$CZ=R"fb.=:~t0^B+jE31߶F*2*ajDnQ'B*a4"rd{ru% K;84~ MRס"ߍ nupbǥlAA*nתd,E*Ș" Đ@eˎ|cn$r . hwdHO1*#Uz+n-o'I!m^֡vљ%ErAAyb@7Rܽ "D*C6'GTc:<"7p%u%ɑ*%,nuɲy*_ջ"P-At%*,@j[J幤dT-8ۘsAT^Z!R%SeTW;yn / UIU#"WQKJ՞@%HCz0ҫ pnze>U\-#HQ$9xr+?v@gP!tt:It+[CTDH5ɲ Player next Nought = Cross next Blank = Blank next Cross = Nought type Board = [[Player]] size :: Int size = 3 empty :: Board empty = replicate size (replicate size Blank) move :: Int -> Player -> Board -> Maybe Board move n p b = case y of Blank -> Just (chop size (xs ++ (p : ys))) _ -> Nothing where (xs,y:ys) = splitAt n (concat b) chop :: Int -> [a] -> [[a]] chop n [] = [] chop n xs = take n xs : chop n (drop n xs) diag :: [[a]] -> [a] diag xss = [xss !! n !! n | n <- [0 .. length xss - 1]] full :: Board -> Bool full b = all (all (/= Blank)) b wins :: Player -> Board -> Bool wins p b = any (all (== p)) b || any (all (== p)) (transpose b) || all (== p) (diag b) || all (== p) (diag (reverse b)) won :: Board -> Bool won b = wins Nought b || wins Cross b -- The state and GUI data State = State { board :: Board, turn :: Player } data GUI = GUI { disableBoard :: IO (), resetBoard :: IO (), setSquare :: Int -> Player -> IO (), setStatus :: String -> IO () } -- reset the game reset gui (State board turn) = do setStatus gui "Player Cross: make your move." resetBoard gui return (State empty Cross) -- when a square is clicked on, try to make a move. -- if the square is already occupied, nothing happens -- otherwise, update the board, let the next player make his move, -- and check whether someone has won or the board is full. occupy gui square st@(State board player) = do case move square player board of Nothing -> return st Just newBoard -> do setSquare gui square player handleMove gui newBoard player return (State newBoard (next player)) -- check whether a board is won or full handleMove gui board player | wins player board = do setStatus gui ("Player " ++ show player ++ " wins!") disableBoard gui | full board = do setStatus gui "It's a draw." disableBoard gui | otherwise = do setStatus gui ("Player " ++ show (next player) ++ ": make your move") main = do initGUI window <- windowNew window `onDestroy` mainQuit set window [ windowTitle := "Noughty" , windowResizable := False ] label <- labelNew (Just "Player Cross: make your move.") vboxOuter <- vBoxNew False 0 vboxInner <- vBoxNew False 5 -- Add an initial board to the inner vBox and make the menu bar (squares, images) <- addFieldsTo vboxInner (mb,newGame,quit) <- makeMenuBar -- Construct the GUI actions that abstracts from the actual widgets gui <- guiActions squares images label -- Initialize the state state <- newIORef State { board = empty, turn = Cross } let modifyState f = readIORef state >>= f >>= writeIORef state -- Add action handlers onActivateLeaf quit mainQuit onActivateLeaf newGame $ modifyState $ reset gui zipWithM_ (\square i -> onPressed square $ modifyState $ occupy gui i) squares [0..8] -- Assemble the bits set vboxOuter [ containerChild := mb , containerChild := vboxInner ] set vboxInner [ containerChild := label , containerBorderWidth := 10 ] set window [ containerChild := vboxOuter ] widgetShowAll window mainGUI guiActions buttons images label = do noughtPic <- pixbufNewFromFile "Nought.png" crossPic <- pixbufNewFromFile "Cross.png" return GUI { disableBoard = mapM_ (flip widgetSetSensitivity False) buttons, resetBoard = do mapM_ (\i -> imageClear i >> widgetQueueDraw i) images mapM_ (flip widgetSetSensitivity True) buttons, setSquare = \ i player -> case player of Cross -> set (images !! i) [ imagePixbuf := crossPic ] Nought-> set (images !! i) [ imagePixbuf := noughtPic ], setStatus = labelSetText label} makeMenuBar = do mb <- menuBarNew fileMenu <- menuNew newGame <- menuItemNewWithMnemonic "_New Game" quit <- menuItemNewWithMnemonic "_Quit" file <- menuItemNewWithMnemonic "_Game" menuShellAppend fileMenu newGame menuShellAppend fileMenu quit menuItemSetSubmenu file fileMenu containerAdd mb file return (mb,newGame,quit) addFieldsTo container = do table <- tableNew 5 5 False buttons@[b0,b1,b2,b3,b4,b5,b6,b7,b8] <- replicateM 9 squareNew images <- replicateM 9 imageNew zipWithM_ containerAdd buttons images tableAttachDefaults table b0 0 1 0 1 tableAttachDefaults table b1 2 3 0 1 tableAttachDefaults table b2 4 5 0 1 tableAttachDefaults table b3 0 1 2 3 tableAttachDefaults table b4 2 3 2 3 tableAttachDefaults table b5 4 5 2 3 tableAttachDefaults table b6 0 1 4 5 tableAttachDefaults table b7 2 3 4 5 tableAttachDefaults table b8 4 5 4 5 vline1 <- vSeparatorNew vline2 <- vSeparatorNew hline1 <- hSeparatorNew hline2 <- hSeparatorNew tableAttachDefaults table vline1 1 2 0 5 tableAttachDefaults table vline2 3 4 0 5 tableAttachDefaults table hline1 0 5 1 2 tableAttachDefaults table hline2 0 5 3 4 tableSetRowSpacings table 0 tableSetColSpacings table 0 containerAdd container table return (buttons, images) squareNew = do square <- buttonNew widgetSetSizeRequest square 100 100 set square [ widgetCanFocus := False, buttonRelief := ReliefNone] return square