fltkhs 0.4.0.0 → 0.4.0.1

raw patch · 30 files changed

+84/−2030 lines, 30 filesdep −processdep ~directorysetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: process

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• README.md +5/−2
• Setup.hs +16/−18
• c-src/Makefile.in +4/−4
• fltkhs.cabal +2/−285
• src/Examples/arc.hs +0/−98
• src/Examples/bitmap.hs +0/−151
• src/Examples/boxtype.hs +0/−97
• src/Examples/browser.hs +0/−127
• src/Examples/clock.hs +0/−22
• src/Examples/doublebuffer.hs +0/−101
• src/Examples/make-tree.hs +0/−21
• src/Examples/nativefilechooser-simple-app.hs +0/−92
• src/Examples/pack.hs +0/−73
• src/Examples/table-as-container.hs +0/−113
• src/Examples/table-simple.hs +0/−78
• src/Examples/table-sort.hs +0/−241
• src/Examples/table-spreadsheet-with-keyboard-nav.hs +0/−292
• src/Examples/textdisplay-with-colors.hs +0/−23
• src/Examples/texteditor-simple.hs +0/−15
• src/Examples/tile.hs +0/−69
• src/Examples/tree-simple.hs +0/−48
• src/Graphics/UI/FLTK/LowLevel/BMPImage.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs +39/−50
• src/Graphics/UI/FLTK/LowLevel/GIFImage.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/JPEGImage.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/PNGImage.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/PNMImage.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/RGBImage.chs +4/−3
• src/Graphics/UI/FLTK/LowLevel/XBMImage.chs +2/−1
• src/Graphics/UI/FLTK/LowLevel/XPMImage.chs +2/−1

@@ -10,7 +10,7 @@ - Download [FLTK 1.3.3] [2]. - Install with: ```-    > ./configure+    > ./configure --enable-shared     > make     > make install ```@@ -21,11 +21,14 @@     cabal install ``` -- Test your installation by invoking: 'fltkhs-arc'.+- Test your installation by invoking: 'fltkhs-buttons'.  The rest of the documentation (including installation instructions for Windows and API usage) is located in the [FLTKHS module] [3]. This is the primary module that needs to be imported by every Fltkhs app and the entry point into the application. +A number of demos are also available in the [fltkhs-demos] [4] and the [fltkhs-fluid-examples] [5] packages.    [1]: http://www.fltk.org/index.php      "FLTK"   [2]: http://www.fltk.org/software.php   [3]: http://hackage.haskell.org/package/fltkhs/docs/Graphics-UI-FLTK-LowLevel-FLTKHS.html+  [4]: http://hackage.haskell.org/package/fltkhs-demos+  [5]: http://hackage.haskell.org/package/fltkhs-fluid-examples

@@ -1,5 +1,4 @@ import Data.Maybe(fromJust, isJust, fromMaybe, maybeToList)-import Data.List(partition, isPrefixOf) import Distribution.Simple.Compiler import Distribution.Simple.LocalBuildInfo import Distribution.PackageDescription@@ -21,6 +20,7 @@ import Distribution.Simple.PreProcess import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) import System.IO.Unsafe (unsafePerformIO)+import System.IO.Error import qualified Distribution.Simple.Program.Ar    as Ar import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.BuildPaths@@ -33,7 +33,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.PackageDescription as PD import Distribution.InstalledPackageInfo (extraGHCiLibraries, showInstalledPackageInfo)-import System.Environment (getEnv)+import System.Environment (getEnv, setEnv)  main :: IO () main = defaultMainWithHooks defaultUserHooks {@@ -56,9 +56,9 @@ myCMakePreConf args flags =   do     let runCMake = do-	fltkHome <- getEnv "FLTK_HOME"-	putStrLn "Running cmake ..."-	rawSystemExit verbose "cmake" [".", "-G", "MSYS Makefiles", "-DFLTK_HOME=" ++ fltkHome]+        fltkHome <- getEnv "FLTK_HOME"+        putStrLn "Running cmake ..."+        rawSystemExit verbose "cmake" [".", "-G", "MSYS Makefiles", "-DFLTK_HOME=" ++ fltkHome]     clibExists <- doesDirectoryExist fltkcdir     if (not clibExists)      then runCMake@@ -73,15 +73,10 @@ fltkcdir = unsafePerformIO getCurrentDirectory ++ "/c-lib" fltkclib = "fltkc" -withFltkc op pd =-  let lib = (fromJust . library) pd-      bi = libBuildInfo lib-      elds = extraLibDirs bi-      els = extraLibs bi-      bi' = bi {extraLibs = els `op` [fltkclib], extraLibDirs = elds `op` [fltkcdir]}-      lib' = lib {libBuildInfo = bi'}-  in-    pd {library = Just lib'}+addToEnvironmentVariable :: String -> String -> IO ()+addToEnvironmentVariable env value = do+  currentLdLibraryPath <- tryIOError (getEnv env)+  setEnv env ((either (const "") (\curr -> curr ++ ":") currentLdLibraryPath) ++ value)  myBuildHook pkg_descr local_bld_info user_hooks bld_flags =   do let compileC = do@@ -94,8 +89,12 @@         clibraries <- getDirectoryContents fltkcdir         when (null $ filter (Data.List.isInfixOf "fltkc") clibraries) compileC        else compileC-     let new_pkg_descr = withFltkc (++) pkg_descr-     buildHook defaultUserHooks new_pkg_descr local_bld_info user_hooks bld_flags+     case buildOS of+       Windows -> addToEnvironmentVariable "PATH" fltkcdir+       _ -> do+         addToEnvironmentVariable "LD_LIBRARY_PATH" fltkcdir+         addToEnvironmentVariable "LIBRARY_PATH" fltkcdir+     buildHook defaultUserHooks pkg_descr local_bld_info user_hooks bld_flags  copyCBindings :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO () copyCBindings pkg_descr lbi uhs flags = do@@ -107,7 +106,7 @@         ["c-lib/libfltkc.a", libPref]     case buildOS of      Linux -> rawSystemExit (fromFlag $ copyVerbosity flags) "cp"-              ["c-lib/libfltkcdyn.so", libPref]+              ["c-lib/libfltkc.so", libPref]      Windows -> do         rawSystemExit (fromFlag $ copyVerbosity flags) "cp"               ["c-lib/libfltkc.dll.a", libPref]@@ -117,7 +116,6 @@ myCleanHook pd x uh cf = do   rawSystemExit normal "make" ["clean"]   cleanHook defaultUserHooks pd x uh cf-  -- Based on code in "Gtk2HsSetup.hs" from "gtk" package registerHook pkg_descr localbuildinfo _ flags =

@@ -121,7 +121,7 @@ 	SONAME_FLAGS= -shared -Wl,-soname endif .SILENT:-all: libfltkc.a libfltkcdyn.$(SHARED_EXT)+all: libfltkc.a libfltkc.$(SHARED_EXT) .SUFFIXES: .cpp .o .cpp.o: 	test -d $(STATIC_OBJECT_FILES) || mkdir $(STATIC_OBJECT_FILES)@@ -134,12 +134,12 @@ 	@echo "*** Linking $@..." 	(cd $(STATIC_OBJECT_FILES); \ 	ar rcs $(LIBDIR)/$@ $^;)-libfltkcdyn.so : $(OBJECTS)+libfltkc.so : $(OBJECTS) 	test -d $(LIBDIR) || mkdir $(LIBDIR) 	@echo "*** Linking $@..." 	(cd $(SHARED_OBJECT_FILES); \-	$(CXX) $(SONAME_FLAGS),$(LIBDIR)/$@ -o $(LIBDIR)/$@ $^);-libfltkcdyn.dylib: $(OBJECTS)+	$(CXX) $(SONAME_FLAGS),$(LIBDIR)/$@ -o $(LIBDIR)/$@ $^ $(shell $(FLTKCONFIG) --use-images --use-glut --use-forms --use-gl --ldflags));+libfltkc.dylib: $(OBJECTS) 	@echo "*** Not linking $@ because of bugs in ./c-src/Makefile.in, help appreciated." clean: 	test -d $(LIBDIR) && rm -rf $(LIBDIR)

@@ -1,8 +1,8 @@ name : fltkhs-version : 0.4.0.0+version : 0.4.0.1 synopsis : FLTK bindings description:-    Low level bindings for the FLTK GUI toolkit.+    Low level bindings for the FLTK GUI toolkit. For installation and quick start instruction please scroll all the way down to the README. license : MIT license-file : LICENSE tested-with: GHC >=7.8.1@@ -141,179 +141,6 @@   if !os(darwin) && !os(windows)     ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" -Flag FastCompile-   Description: Turn off optimizations for faster compilation-   Manual: True-   Default: True--Executable fltkhs-pack-  Main-Is: pack.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    directory >= 1.2.2.0,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-tile-  Main-Is: tile.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    directory,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-nativefilechooser-simple-app-  Main-Is: nativefilechooser-simple-app.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    directory,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-table-as-container-  Main-Is: table-as-container.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-texteditor-simple-  Main-Is: texteditor-simple.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-textdisplay-with-colors-  Main-Is: textdisplay-with-colors.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-doublebuffer-  Main-Is: doublebuffer.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-make-tree-  Main-Is: make-tree.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-tree-simple-  Main-Is: tree-simple.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-table-spreadsheet-with-keyboard-nav-  Main-Is: table-spreadsheet-with-keyboard-nav.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-test_call-  Main-Is: TestCall.hs-  Hs-Source-Dirs: src/TestPrograms-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"- Executable fltkhs-buttons   Main-Is: Buttons.hs   Hs-Source-Dirs: src/TestPrograms@@ -322,116 +149,6 @@     fltkhs   default-language: Haskell2010   ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-table-simple-  Main-Is: table-simple.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-table-sort-  Main-Is: table-sort.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs,-    process-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-arc-  Main-Is: arc.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-    base == 4.*,-    fltkhs-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-bitmap-  Main-Is: bitmap.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-     base == 4.*,-     fltkhs,bytestring-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-boxtype-  Main-Is: boxtype.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-     base == 4.*,-     fltkhs,bytestring-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-browser-  Main-Is: browser.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-     base == 4.*,-     fltkhs,-     bytestring-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0-  if os(windows)-   ghc-Options: -optl-mwindows-  if !os(darwin) && !os(windows)-    ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive"--Executable fltkhs-clock-  Main-Is: clock.hs-  Hs-Source-Dirs: src/Examples-  Build-Depends:-     base == 4.*,-     fltkhs,-     bytestring-  default-language: Haskell2010-  ghc-Options: -Wall -threaded-  if impl(ghc >= 7.10) && flag(FastCompile)-     ghc-Options: -fno-specialise -fmax-simplifier-iterations=0 -fsimplifier-phases=0   if os(windows)    ghc-Options: -optl-mwindows   if !os(darwin) && !os(windows)

@@ -1,98 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Data.IORef-import Control.Monad--name :: [String]-name = ["X", "Y", "R", "start", "end", "rotate"]--drawArc :: IORef [Double] -> Ref Widget -> IO ()-drawArc myArgsRef widget = do-  myArgs <- readIORef myArgsRef-  rectangle' <- getRectangle widget-  let (x',y',w',h') = fromRectangle rectangle'-  flcPushClip rectangle'-  flcSetColor dark3Color-  flcRectf rectangle'-  flcPushMatrix-  if (myArgs !! 5 > 0)-    then do-    flcTranslate-      (ByXY-       (ByX ((fromIntegral x') + (fromIntegral w')/2))-       (ByY ((fromIntegral y') + (fromIntegral h')/2)))-    flcRotate (myArgs !! 5)-    flcTranslate-      (ByXY-       (ByX (-((fromIntegral x') + (fromIntegral w')/2)))-       (ByY (-((fromIntegral y') + (fromIntegral h')/2))))-    else return ()-  flcSetColor whiteColor-  flcTranslate (ByXY (ByX (fromIntegral x')) (ByY (fromIntegral $ y')))-  flcBeginComplexPolygon-  flcArcByRadius-    (ByXY (ByX $ myArgs !! 0) (ByY $ myArgs !! 1))-    (myArgs !! 2)-    (myArgs !! 3)-    (myArgs !! 4)-  flcGap-  flcArcByRadius (ByXY (ByX 140) (ByY 140)) 20 0 (-360)-  flcEndComplexPolygon-  flcSetColor redColor-  flcBeginLine-  flcArcByRadius-    (ByXY (ByX $ myArgs !! 0) (ByY $ myArgs !! 1))-    (myArgs !! 2)-    (myArgs !! 3)-    (myArgs !! 4)-  flcEndLine-  flcPopMatrix-  flcPopClip--setIndex :: Int -> [a] -> a -> [a]-setIndex idx' xs x =-  map-   (-    \(i,e) -> if (i == idx')-                 then x-                 else e-   )-   (zip [0..] xs)--sliderCb :: Ref Widget -> Int -> IORef [Double] -> Ref HorValueSlider -> IO ()-sliderCb widget sliderNumber myArgsRef slider' = do-  v' <- getValue slider'-  modifyIORef myArgsRef (\myArgs' -> setIndex sliderNumber myArgs' v')-  redraw widget--main :: IO ()-main = do-  myArgs' <- newIORef [140, 140, 50, 0, 360,0]-  window' <- doubleWindowNew (Size (Width 300) (Height 500)) Nothing Nothing-  begin window'-  widget <- widgetCustom-             (Rectangle-               (Position (X 10) (Y 10))-               (Size (Width 280) (Height 280)))-             Nothing-             (drawArc myArgs')-             defaultCustomWidgetFuncs-  forM_ (take 6 (zip (iterate ((+) 25) 300) [0..])) $ \(y, sliderNumber') -> do-    s <- horValueSliderNew-         (toRectangle $ (50, y, 240, 25))-         (Just $ name !! sliderNumber')-    case sliderNumber' of-     sliderNumber'' | sliderNumber'' < 3 -> setMinimum s 0 >> setMaximum s 300-        | sliderNumber'' == 5 -> setMinimum s 0 >> setMaximum s 360-     _ -> setMinimum s (-360) >> setMaximum s 360-    setStep s 1-    _ <- readIORef myArgs' >>= \args' -> setValue s (args' !! sliderNumber')-    setAlign s alignLeft-    setCallback s (sliderCb widget sliderNumber' myArgs')-  end window'-  showWidget window'-  _ <- FL.run-  return ()

@@ -1,151 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Data.IORef-import Control.Monad-import qualified Data.ByteString as B--sorceressWidth :: Int-sorceressWidth = 75--sorceressHeight :: Int-sorceressHeight = 75--sorceressBits :: B.ByteString-sorceressBits = B.pack [-   0xfc, 0x7e, 0x40, 0x20, 0x90, 0x00, 0x07, 0x80, 0x23, 0x00, 0x00, 0xc6,-   0xc1, 0x41, 0x98, 0xb8, 0x01, 0x07, 0x66, 0x00, 0x15, 0x9f, 0x03, 0x47,-   0x8c, 0xc6, 0xdc, 0x7b, 0xcc, 0x00, 0xb0, 0x71, 0x0e, 0x4d, 0x06, 0x66,-   0x73, 0x8e, 0x8f, 0x01, 0x18, 0xc4, 0x39, 0x4b, 0x02, 0x23, 0x0c, 0x04,-   0x1e, 0x03, 0x0c, 0x08, 0xc7, 0xef, 0x08, 0x30, 0x06, 0x07, 0x1c, 0x02,-   0x06, 0x30, 0x18, 0xae, 0xc8, 0x98, 0x3f, 0x78, 0x20, 0x06, 0x02, 0x20,-   0x60, 0xa0, 0xc4, 0x1d, 0xc0, 0xff, 0x41, 0x04, 0xfa, 0x63, 0x80, 0xa1,-   0xa4, 0x3d, 0x00, 0x84, 0xbf, 0x04, 0x0f, 0x06, 0xfc, 0xa1, 0x34, 0x6b,-   0x01, 0x1c, 0xc9, 0x05, 0x06, 0xc7, 0x06, 0xbe, 0x11, 0x1e, 0x43, 0x30,-   0x91, 0x05, 0xc3, 0x61, 0x02, 0x30, 0x1b, 0x30, 0xcc, 0x20, 0x11, 0x00,-   0xc1, 0x3c, 0x03, 0x20, 0x0a, 0x00, 0xe8, 0x60, 0x21, 0x00, 0x61, 0x1b,-   0xc1, 0x63, 0x08, 0xf0, 0xc6, 0xc7, 0x21, 0x03, 0xf8, 0x08, 0xe1, 0xcf,-   0x0a, 0xfc, 0x4d, 0x99, 0x43, 0x07, 0x3c, 0x0c, 0xf1, 0x9f, 0x0b, 0xfc,-   0x5b, 0x81, 0x47, 0x02, 0x16, 0x04, 0x31, 0x1c, 0x0b, 0x1f, 0x17, 0x89,-   0x4d, 0x06, 0x1a, 0x04, 0x31, 0x38, 0x02, 0x07, 0x56, 0x89, 0x49, 0x04,-   0x0b, 0x04, 0xb1, 0x72, 0x82, 0xa1, 0x54, 0x9a, 0x49, 0x04, 0x1d, 0x66,-   0x50, 0xe7, 0xc2, 0xf0, 0x54, 0x9a, 0x58, 0x04, 0x0d, 0x62, 0xc1, 0x1f,-   0x44, 0xfc, 0x51, 0x90, 0x90, 0x04, 0x86, 0x63, 0xe0, 0x74, 0x04, 0xef,-   0x31, 0x1a, 0x91, 0x00, 0x02, 0xe2, 0xc1, 0xfd, 0x84, 0xf9, 0x30, 0x0a,-   0x91, 0x00, 0x82, 0xa9, 0xc0, 0xb9, 0x84, 0xf9, 0x31, 0x16, 0x81, 0x00,-   0x42, 0xa9, 0xdb, 0x7f, 0x0c, 0xff, 0x1c, 0x16, 0x11, 0x00, 0x02, 0x28,-   0x0b, 0x07, 0x08, 0x60, 0x1c, 0x02, 0x91, 0x00, 0x46, 0x29, 0x0e, 0x00,-   0x00, 0x00, 0x10, 0x16, 0x11, 0x02, 0x06, 0x29, 0x04, 0x00, 0x00, 0x00,-   0x10, 0x16, 0x91, 0x06, 0xa6, 0x2a, 0x04, 0x00, 0x00, 0x00, 0x18, 0x24,-   0x91, 0x04, 0x86, 0x2a, 0x04, 0x00, 0x00, 0x00, 0x18, 0x27, 0x93, 0x04,-   0x96, 0x4a, 0x04, 0x00, 0x00, 0x00, 0x04, 0x02, 0x91, 0x04, 0x86, 0x4a,-   0x0c, 0x00, 0x00, 0x00, 0x1e, 0x23, 0x93, 0x04, 0x56, 0x88, 0x08, 0x00,-   0x00, 0x00, 0x90, 0x21, 0x93, 0x04, 0x52, 0x0a, 0x09, 0x80, 0x01, 0x00,-   0xd0, 0x21, 0x95, 0x04, 0x57, 0x0a, 0x0f, 0x80, 0x27, 0x00, 0xd8, 0x20,-   0x9d, 0x04, 0x5d, 0x08, 0x1c, 0x80, 0x67, 0x00, 0xe4, 0x01, 0x85, 0x04,-   0x79, 0x8a, 0x3f, 0x00, 0x00, 0x00, 0xf4, 0x11, 0x85, 0x06, 0x39, 0x08,-   0x7d, 0x00, 0x00, 0x18, 0xb7, 0x10, 0x81, 0x03, 0x29, 0x12, 0xcb, 0x00,-   0x7e, 0x30, 0x28, 0x00, 0x85, 0x03, 0x29, 0x10, 0xbe, 0x81, 0xff, 0x27,-   0x0c, 0x10, 0x85, 0x03, 0x29, 0x32, 0xfa, 0xc1, 0xff, 0x27, 0x94, 0x11,-   0x85, 0x03, 0x28, 0x20, 0x6c, 0xe1, 0xff, 0x07, 0x0c, 0x01, 0x85, 0x01,-   0x28, 0x62, 0x5c, 0xe3, 0x8f, 0x03, 0x4e, 0x91, 0x80, 0x05, 0x39, 0x40,-   0xf4, 0xc2, 0xff, 0x00, 0x9f, 0x91, 0x84, 0x05, 0x31, 0xc6, 0xe8, 0x07,-   0x7f, 0x80, 0xcd, 0x00, 0xc4, 0x04, 0x31, 0x06, 0xc9, 0x0e, 0x00, 0xc0,-   0x48, 0x88, 0xe0, 0x04, 0x79, 0x04, 0xdb, 0x12, 0x00, 0x30, 0x0c, 0xc8,-   0xe4, 0x04, 0x6d, 0x06, 0xb6, 0x23, 0x00, 0x18, 0x1c, 0xc0, 0x84, 0x04,-   0x25, 0x0c, 0xff, 0xc2, 0x00, 0x4e, 0x06, 0xb0, 0x80, 0x04, 0x3f, 0x8a,-   0xb3, 0x83, 0xff, 0xc3, 0x03, 0x91, 0x84, 0x04, 0x2e, 0xd8, 0x0f, 0x3f,-   0x00, 0x00, 0x5f, 0x83, 0x84, 0x04, 0x2a, 0x70, 0xfd, 0x7f, 0x00, 0x00,-   0xc8, 0xc0, 0x84, 0x04, 0x4b, 0xe2, 0x2f, 0x01, 0x00, 0x08, 0x58, 0x60,-   0x80, 0x04, 0x5b, 0x82, 0xff, 0x01, 0x00, 0x08, 0xd0, 0xa0, 0x84, 0x04,-   0x72, 0x80, 0xe5, 0x00, 0x00, 0x08, 0xd2, 0x20, 0x44, 0x04, 0xca, 0x02,-   0xff, 0x00, 0x00, 0x08, 0xde, 0xa0, 0x44, 0x04, 0x82, 0x02, 0x6d, 0x00,-   0x00, 0x08, 0xf6, 0xb0, 0x40, 0x02, 0x82, 0x07, 0x3f, 0x00, 0x00, 0x08,-   0x44, 0x58, 0x44, 0x02, 0x93, 0x3f, 0x1f, 0x00, 0x00, 0x30, 0x88, 0x4f,-   0x44, 0x03, 0x83, 0x23, 0x3e, 0x00, 0x00, 0x00, 0x18, 0x60, 0xe0, 0x07,-   0xe3, 0x0f, 0xfe, 0x00, 0x00, 0x00, 0x70, 0x70, 0xe4, 0x07, 0xc7, 0x1b,-   0xfe, 0x01, 0x00, 0x00, 0xe0, 0x3c, 0xe4, 0x07, 0xc7, 0xe3, 0xfe, 0x1f,-   0x00, 0x00, 0xff, 0x1f, 0xfc, 0x07, 0xc7, 0x03, 0xf8, 0x33, 0x00, 0xc0,-   0xf0, 0x07, 0xff, 0x07, 0x87, 0x02, 0xfc, 0x43, 0x00, 0x60, 0xf0, 0xff,-   0xff, 0x07, 0x8f, 0x06, 0xbe, 0x87, 0x00, 0x30, 0xf8, 0xff, 0xff, 0x07,-   0x8f, 0x14, 0x9c, 0x8f, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x07, 0x9f, 0x8d,-   0x8a, 0x0f, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x07, 0xbf, 0x0b, 0x80, 0x1f,-   0x00, 0x00, 0xff, 0xff, 0xff, 0x07, 0x7f, 0x3a, 0x80, 0x3f, 0x00, 0x80,-   0xff, 0xff, 0xff, 0x07, 0xff, 0x20, 0xc0, 0x3f, 0x00, 0x80, 0xff, 0xff,-   0xff, 0x07, 0xff, 0x01, 0xe0, 0x7f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x07,-   0xff, 0x0f, 0xf8, 0xff, 0x40, 0xe0, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff,-   0xff, 0xff, 0x40, 0xf0, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0xff,-   0x41, 0xf0, 0xff, 0xff, 0xff, 0x07-   ]--data ToggleButtons = ToggleButtons {-    leftb :: Ref ToggleButton,-    rightb :: Ref ToggleButton,-    topb :: Ref ToggleButton,-    bottomb :: Ref ToggleButton,-    insideb :: Ref ToggleButton,-    overb :: Ref ToggleButton,-    inactb :: Ref ToggleButton-  }--buttonCb :: IORef (ToggleButtons, Ref Button, Ref DoubleWindow) -> Ref ToggleButton -> IO ()-buttonCb state' _ =-  do-    (toggleButtons', b, win) <- readIORef state'-    i <- newIORef []-    let addIf :: (ToggleButtons -> Ref ToggleButton) -> AlignType -> IO ()-        addIf b' alignType' = do-          v' <- getValue (b' toggleButtons')-          when v' (modifyIORef i ((++) [alignType']))-    addIf leftb AlignTypeLeft-    addIf rightb AlignTypeRight-    addIf topb AlignTypeTop-    addIf bottomb AlignTypeBottom-    addIf insideb AlignTypeInside-    addIf overb AlignTypeTextOverImage-    readIORef i >>= setAlign b . Alignments-    inactbValue <- getValue (inactb toggleButtons')-    if inactbValue then deactivate b-      else activate b-    redraw win--main :: IO ()-main = do-  window <- doubleWindowNew (Size (Width 400) (Height 400)) Nothing Nothing-  begin window-  button <- buttonNew-              (Rectangle-                (Position (X 140) (Y 160))-                (Size (Width 120) (Height 120)))-              (Just "Bitmap")-  bitmap <- bitmapNew-             (BitmapHs-               sorceressBits-               (Size-                 (Width sorceressWidth)-                 (Height sorceressHeight)))-  setImage button (Just bitmap)-  leftb' <- toggleButtonNew (Rectangle (Position (X 25) (Y 50)) (Size (Width 50) (Height 25))) (Just "left")-  rightb' <- toggleButtonNew (Rectangle (Position (X 75) (Y 50)) (Size (Width 50) (Height 25))) (Just "right")-  topb' <- toggleButtonNew (Rectangle (Position (X 125) (Y 50)) (Size (Width 50) (Height 25))) (Just "top")-  bottomb' <- toggleButtonNew (Rectangle (Position (X 175) (Y 50)) (Size (Width 50) (Height 25))) (Just "bottom")-  insideb' <- toggleButtonNew (Rectangle (Position (X 225) (Y 50)) (Size (Width 50) (Height 25))) (Just "inside")-  overb' <- toggleButtonNew (Rectangle (Position (X 25) (Y 75)) (Size (Width 100) (Height 25))) (Just "text over")-  inactb' <- toggleButtonNew (Rectangle (Position (X 125) (Y 75)) (Size (Width 100) (Height 25))) (Just "inactive")-  state' <- newIORef ((ToggleButtons leftb' rightb' topb' bottomb' insideb' overb' inactb'),-                      button,-                      window)-  setCallback leftb' $ buttonCb state'-  setCallback rightb' $ buttonCb state'-  setCallback topb' $ buttonCb state'-  setCallback bottomb' $ buttonCb state'-  setCallback insideb' $ buttonCb state'-  setCallback overb' $ buttonCb state'-  setCallback inactb' $ buttonCb state'-  setResizable window (Just window)-  end window-  showWidget window-  _ <- FL.run-  return ()

@@ -1,97 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Data.IORef-import Control.Monad--windowWidth :: Int-windowWidth = 200-rowHeight :: Int-rowHeight = 50-numRows :: Int-numRows = 14-bt :: IORef Int -> String -> Boxtype -> Bool -> IO ()-bt n label' boxtype' square' = do-  n' <- readIORef n-  let (quotient',remainder') = quotRem n' 4-  modifyIORef n (+ 1)-  b' <- boxNewWithBoxtype-          boxtype'-          (Rectangle-            (Position (X (remainder' * windowWidth + 10)) (Y (quotient' * rowHeight + 10)))-            (Size-             (Width $ if square' then rowHeight - 20 else windowWidth - 20)-             (Height $ rowHeight - 20)))-          label'-  setLabelsize b' (FontSize 11)-  when square' $ setAlign b' alignRight-main :: IO ()-main = do-  window <- doubleWindowNew-             (Size (Width $ windowWidth * 4) (Height $ numRows * rowHeight))-             Nothing-             Nothing-  setBox window FlatBox-  FL.getSystemColors-  setColor window (Color 12)-  n' <- newIORef 0-  begin window-  bt n' "NoBox" NoBox False-  bt n' "FlatBox" FlatBox False-  modifyIORef n' (+ 2)-  bt n' "UpBox" UpBox False-  bt n' "DownBox" DownBox False-  bt n' "UpFrame" UpFrame False-  bt n' "DownFrame" DownFrame False-  bt n' "ThinUpBox" ThinUpBox False-  bt n' "ThinDownBox" ThinDownBox False-  bt n' "ThinUpFrame" ThinUpFrame False-  bt n' "ThinDownFrame" ThinDownFrame False-  bt n' "EngravedBox" EngravedBox False-  bt n' "EmbossedBox" EmbossedBox False-  bt n' "EngravedFrame" EngravedFrame False-  bt n' "EmbossedFrame" EmbossedFrame False-  bt n' "BorderBox" BorderBox False-  bt n' "ShadowBox" ShadowBox False-  bt n' "BorderFrame" BorderFrame False-  bt n' "ShadowFrame" ShadowFrame False-  bt n' "RoundedBox" RoundedBox False-  bt n' "RshadowBox" RshadowBox False-  bt n' "RoundedFrame" RoundedFrame False-  bt n' "RFlatBox" RFlatBox False-  bt n' "RoundUpBox" RoundUpBox False-  bt n' "RoundDownBox" RoundDownBox False-  bt n' "DiamondUpBox" DiamondUpBox False-  bt n' "DiamondDownBox" DiamondDownBox False-  bt n' "OvalBox" OvalBox False-  bt n' "OshadowBox" OshadowBox False-  bt n' "OvalFrame" OvalFrame False-  bt n' "FloatBox" FloatBox False-  bt n' "PlasticUpBox" PlasticUpBox False-  bt n' "PlasticDownBox" PlasticDownBox False-  bt n' "PlasticUpFrame" PlasticUpFrame False-  bt n' "PlasticDownFrame" PlasticDownFrame False-  bt n' "PlasticThinUpBox" PlasticThinUpBox False-  bt n' "PlasticThinDownBox" PlasticThinDownBox False-  modifyIORef n' (+ 2)-  bt n' "PlasticRoundUpBox" PlasticRoundUpBox False-  bt n' "PlasticRoundDownBox" PlasticRoundDownBox False-  modifyIORef n' (+ 2)-  bt n' "GtkUpBox" GtkUpBox False-  bt n' "GtkDownBox" GtkDownBox False-  bt n' "GtkUpFrame" GtkUpFrame False-  bt n' "GtkDownFrame" GtkDownFrame False-  bt n' "GtkThinUpBox" GtkThinUpBox False-  bt n' "GtkThinDownBox" GtkThinDownBox False-  bt n' "GtkThinUpFrame" GtkThinUpFrame False-  bt n' "GtkThinDownFrame" GtkThinDownFrame False-  bt n' "GtkRoundUpBox" GtkRoundUpBox False-  bt n' "GtkRoundDownBox" GtkRoundDownBox False-  bt n' "FreeBoxtype" FreeBoxtype False-  setResizable window (Just window)-  end window-  showWidget window-  _ <- FL.run-  return ()

@@ -1,127 +0,0 @@-{--This is a test of how the browser draws lines.-This is a second line.-This is a third.--That was a blank line above this.--@r@_Right justify-@c@_Center justify-@_Left justify--@bBold text-@iItalic text-@b@iBold Italic-@fFixed width-@f@bBold Fixed-@f@iItalic Fixed-@f@i@bBold Italic Fixed-@lLarge-@l@bLarge bold-@sSmall-@s@bSmall bold-@s@iSmall italic-@s@i@bSmall italic bold-@uunderscore-@C1RED-@C2Green-@C4Blue--	You should try different browser types:-	Fl_Browser-	Fl_Select_Browser-	Fl_Hold_Browser-	Fl_Multi_Browser--}--module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Control.Monad-import System.Environment--data CallbackType = Top | Middle | Bottom | Visible | Browser-bCb :: Ref SelectBrowser -> IO ()-bCb browser' = FL.eventClicks >>= setValue browser'--showCb :: CallbackType -> Ref IntInput -> Ref SelectBrowser -> IO ()-showCb buttontype' field' browser' = do-  line' <- getValue field'-  if (null line')-    then print "Please enter a number in the text field before clicking on the buttons."-    else do-    let lineNumber' = read line'-    case buttontype' of-     Top -> setTopline browser' lineNumber'-     Bottom -> setBottomline browser' lineNumber'-     Middle -> setMiddleline browser' lineNumber'-     _ -> makeVisible browser' lineNumber'--swapCb :: Ref SelectBrowser -> Ref Button -> IO ()-swapCb browser' _ =-  do-    browserSize' <- getSize browser'-    linesSelected' <- filterM (selected browser') [0..(browserSize' - 1)]-    case linesSelected' of-     (l1:l2:_) -> swap browser' l1 l2-     (l1:[]) -> swap browser' l1 (-1)-     _ -> swap browser' (-1) (-1)--sortCb :: Ref SelectBrowser -> Ref Button -> IO ()-sortCb browser' _ = sortWithSortType browser' SortAscending--btypeCb :: Ref SelectBrowser -> Ref Choice -> IO ()-btypeCb browser' btype' = do-  numLines' <- getSize browser'-  forM_ [1..(numLines' - 1)] (\l -> select browser' l False)-  _ <- select browser' 1 False -- leave focus box on first line-  choice' <- getText btype'-  case choice' of-   "Normal" -> setType browser' NormalBrowserType-   "Select" -> setType browser' SelectBrowserType-   "Hold" -> setType browser' HoldBrowserType-   "Multi" -> setType browser' MultiBrowserType-   _ -> return ()-  redraw browser'--main :: IO ()-main = do-  args <- getArgs-  if (null args) then print "Enter the path to a text file as an argument. As an example use this file (./src/Examples/browser.hs) to see what Fl_Browser can do."-    else do-     let fname = head args-     window <- doubleWindowNew (Size (Width 560) (Height 400)) Nothing (Just fname)-     browser' <- selectBrowserNew (Rectangle (Position (X 0) (Y 0)) (Size (Width 560) (Height 350))) Nothing-     setType browser' MultiBrowserType-     setCallback browser' bCb-     loadStatus' <- load browser' fname-     if (loadStatus' == 0)-       then print ("Can't load " ++ fname)-       else do-       setPosition browser' 0-       field <- intInputNew (toRectangle (55,350,505,25)) (Just "Line #:")-       setCallback field (\_ -> showCb Browser field browser')-       top' <- buttonNew (toRectangle (0,375,80,25)) (Just "Top")-       setCallback top' (\_ -> showCb Top field browser')-       bottom' <- buttonNew (toRectangle (80,375,80,25)) (Just "Bottom")-       setCallback bottom' (\_ -> showCb Bottom field browser')-       middle' <- buttonNew (toRectangle (160,375,80,25)) (Just "Middle")-       setCallback middle' (\_ -> showCb Middle field browser')-       visible' <- buttonNew (toRectangle (240,375,80,25)) (Just "Make Vis.")-       setCallback visible' (\_ -> showCb Visible field browser')-       swap' <- buttonNew (toRectangle (320,375,80,25)) (Just "Swap")-       setCallback swap' $ swapCb browser'-       setTooltip swap' "Swaps two selected lines\n(Use CTRL-click to select two lines)"-       sort' <- buttonNew (toRectangle (400,375,80,25)) (Just "Sort")-       setCallback sort' (sortCb browser')-       btype <- choiceNew (toRectangle (480,375,80,25)) Nothing-       addName btype "Normal"-       addName btype "Select"-       addName btype "Hold"-       addName btype "Multi"-       setCallback btype $ btypeCb browser'-       _ <- setValue btype (MenuItemByIndex (MenuItemIndex 3))-       setResizable window (Just browser')-       showWidget window-       _ <- FL.run-       return ()

@@ -1,22 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.FLTKHS--main :: IO ()-main = do-  w1 <- doubleWindowNew (Size (Width 220) (Height 220)) Nothing (Just "clock")-  begin w1-  c1 <- clockNew (toRectangle (0,0,220,220)) Nothing-  setResizable w1 (Just c1)-  end w1-  w2 <- doubleWindowNew (Size (Width 220) (Height 220)) Nothing (Just "Rounded Clock")-  begin w2-  c2 <- clockNew (toRectangle (0,0,220,220)) Nothing-  setResizable w2 (Just c2)-  end w2-  setXclass w1 "Fl_Clock"-  setXclass w2 "Fl_Clock"-  showWidget w1-  showWidget w2-  _ <- FL.run-  return ()

@@ -1,101 +0,0 @@-{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Control.Monad-import Data.IORef--star :: Int -> Int -> Double -> IO ()-star w h n = do-  flcPushMatrix-  flcTranslate (ByXY (ByX (fromIntegral w / 2)) (ByY (fromIntegral h /2)))-  flcScaleWithY (ByXY (ByX (fromIntegral w / 2)) (ByY (fromIntegral h /2)))-  forM_ [0..n] $ \i -> do-    forM_ [(i+1)..n] $ \j -> do-      let i_vertex :: Double =  2 * pi * i/n + 0.1-          j_vertex :: Double =  2 * pi * j/n + 0.1-      flcBeginLine-      flcVertex (ByXY (ByX $ cos i_vertex) (ByY $ sin i_vertex))-      flcVertex (ByXY (ByX $ cos j_vertex) (ByY $ sin j_vertex))-      flcEndLine-  flcPopMatrix--sliderCb :: IORef (Double,Double) -> (Double -> (Double,Double) -> (Double,Double))-> Ref HorSlider -> IO ()-sliderCb sides' sidesf' slider' = do-  v' <- getValue slider'-  modifyIORef sides' (sidesf' v')-  (Just p') <- getParent slider'-  redraw p'--badDraw :: IORef (Double,Double) -> Int -> Int -> ((Double,Double) -> Double) -> IO ()-badDraw sides w h which' = do-  flcSetColor blackColor >> flcRectf (toRectangle (0,0,w,h))-  flcSetColor whiteColor >> readIORef sides >>= star w h . which'---drawWindow :: IORef (Double, Double) ->-              ((Double, Double) -> Double) ->-              Ref Window ->-              IO ()-drawWindow sides' whichf' w' = do-  ww' <- getW w'-  wh' <- getH w'-  badDraw sides' ww' wh' whichf'-  c' <- getChild w' (0 :: Int)-  maybe (return ()) (drawChild w') (c' :: Maybe (Ref Widget))--main :: IO ()-main = do-  visual' <- FL.visual ModeDouble-  if (not visual') then print "Xdbe not supported, faking double buffer with pixmaps.\n" else return ()-  sides' <- newIORef (20,20)-  w01 <- windowNew (toSize (420,420)) Nothing (Just "Fl_Single_Window")-  setBox w01 FlatBox-  begin w01-  w1 <- singleWindowCustom-          (Size (Width 400) (Height 400))-          (Just (Position (X 10) (Y 10)))-          (Just "Single Window")-          (Just (\w -> drawWindow sides' fst (safeCast w)))-          defaultCustomWidgetFuncs-          defaultCustomWindowFuncs-  setBox w1 FlatBox-  setColor w1 blackColor-  setResizable w1 (Just w1)-  begin w1-  slider0 <- horSliderNew (toRectangle (20,370,360,25)) Nothing-  range slider0 2 30-  setStep slider0 1-  _ <- readIORef sides' >>= setValue slider0 . fst-  setCallback slider0 (sliderCb sides' (\v (_,s2) -> (v, s2)))-  end w1-  end w01-  w02 <- windowNew (Size (Width 420) (Height 420)) Nothing (Just "Fl_Double_Window")-  setBox w02 FlatBox-  begin w02-  w2 <- doubleWindowCustom-          (Size (Width 400) (Height 400))-          (Just $ Position (X 10) (Y 10))-          (Just "Fl_Double_Window")-          (Just (\w -> drawWindow sides' snd (safeCast w)))-          defaultCustomWidgetFuncs-          defaultCustomWindowFuncs-  setBox w2 FlatBox-  setColor w2 blackColor-  setResizable w2 (Just w2)-  begin w2-  slider1 <- horSliderNew (toRectangle $ (20,370,360,25)) Nothing-  range slider1 2 30-  setStep slider1 1-  _ <- readIORef sides' >>= setValue slider1 . fst-  setCallback slider1 (sliderCb sides' (\v (s1,_) -> (s1,v)))-  end w2-  end w02-  showWidget w01-  showWidget w1-  showWidget w02-  showWidget w2-  _ <- FL.run-  return ()

@@ -1,21 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Control.Monad--main :: IO ()-main = do-  win' <- windowNew (Size (Width 500) (Height 500)) Nothing (Just "FLTK Tree Window")-  begin win'-  tree' <- treeNew (toRectangle (50,50,200,200)) (Just "Tree")-  rootLabel tree' "Root Label With Items"-  prefs' <- treePrefsNew-  forM_ [0..(9 :: Int)] $ \_ -> do-    item' <- treeItemNew prefs'-    setLabel item' "test"-    addAt tree' "test" item'-  end win'-  showWidget win'-  _ <- FL.run-  return ()

@@ -1,92 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.FLTKHS-import System.Directory-import System.Exit--openFile :: FilePath -> IO ()-openFile fp = print $ "Open '" ++ fp ++ "''"--saveFile :: FilePath -> IO ()-saveFile fp = do-  print $ "Saving '" ++ fp ++ "'"-  exists' <- doesFileExist fp-  if not exists'-    then writeFile fp "Hello world.\n"-    else return ()--openCb :: Ref NativeFileChooser -> Ref MenuItem ->  IO ()-openCb fc _ = do-  setTitle fc "Open"-  res' <- showWidget fc-  case res' of-   NativeFileChooserPicked -> do-     f' <- getFilename fc-     case f' of-      (Just f'') -> do-        setPresetFile fc f''-        openFile f''-      _ -> return ()-   _ -> return ()--saveAsCb :: Ref NativeFileChooser -> Ref MenuItem ->  IO ()-saveAsCb fc _ = do-  setTitle fc "Open"-  res' <- showWidget fc-  case res' of-   NativeFileChooserPicked -> do-     f' <- getFilename fc-     case f' of-      (Just f'') -> do-        setPresetFile fc f''-        saveFile f''-      _ -> return ()-   _ -> return ()--saveCb :: Ref NativeFileChooser -> Ref MenuItem ->  IO ()-saveCb fc w' = do-  f' <- getFilename fc-  case f' of-   Nothing -> saveAsCb fc w'-   (Just f'') -> saveFile f''--quitCb :: Ref MenuItem -> IO ()-quitCb _ = exitSuccess--initializeWindow :: Ref Window -> IO ()-initializeWindow w' = do-  chooser <- nativeFileChooserNew Nothing-  setFilter chooser "Text\t*.txt\n"-  setPresetFile chooser "untitiled.txt"-  begin w'-  menu <- sysMenuBarNew (toRectangle (0,0,400,25)) Nothing-  _ <- add menu "&File/&Open" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'o')))) (Just (openCb chooser)) (MenuItemFlags [])-  _ <- add menu "&File/&Save" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 's')))) (Just (saveCb chooser)) (MenuItemFlags [])-  _ <- add menu "&File/&Save As" Nothing (Just (saveAsCb chooser)) (MenuItemFlags [])-  _ <- add menu "&File/&Quit" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'q')))) (Just quitCb) (MenuItemFlags [])-  w_w' <- getW w'-  w_h' <- getH w'-  box' <- boxNew (toRectangle (20,25+20,w_w'-40,w_h'-40-25)) Nothing-  setColor box' (Color 45)-  setBox box' FlatBox-  setAlign box' (Alignments [AlignTypeCenter, AlignTypeInside, AlignTypeWrap])-  setLabel box' $ "This demo shows an example of implementing " ++-                  "common 'File' menu operations like:\n" ++-                  "    File/Open, File/Save, File/Save As\n" ++-                  "..using the Fl_Native_File_Chooser widget.\n\n" ++-                  "Note 'Save' and 'Save As' really *does* create files! " ++-                  "This is to show how behavior differs when " ++-                  "files exist vs. do not.";-  setLabelsize box' (FontSize 12)-  end w'--main :: IO ()-main = do-  _ <- FL.setScheme "gtk+"-  app <- windowNew (toSize (400,200)) Nothing (Just "Native File Chooser Example")-  initializeWindow app-  showWidget app-  _ <- FL.run-  return ()

@@ -1,73 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.FLTKHS--type_cb :: Ref Scrolled -> Ref Pack -> PackType -> Ref LightButton -> IO ()-type_cb scrolled pack packType _ = do-                      cs <- getArray pack-                      mapM_ (\c -> resize c (toRectangle (0,0,25,25))) cs-                      rect <- getRectangle scrolled-                      resize pack rect-                      getParent pack >>=-                        maybe (return ())-                              (\p' -> redraw p' >> setType pack packType >> redraw pack)--spacing_cb :: Ref Scrolled -> Ref Pack -> Ref HorValueSlider -> IO ()-spacing_cb scrolled pack slider = do-  spacing <- getValue slider-  setSpacing pack (truncate spacing)-  redraw scrolled--main :: IO ()-main = do-  w <- doubleWindowNew (Size (Width 360) (Height 370)) Nothing Nothing-  scrolled <- scrolledNew (toRectangle (10,10,340,285)) Nothing-  begin scrolled-  pack <- packNew (toRectangle $ (10,10,340,285)) Nothing-  setBox pack DownFrame-  begin pack-  _ <- buttonNew (toRectangle (35, 35, 25, 25)) (Just "b1")-  _ <- buttonNew (toRectangle (45, 45, 25, 25)) (Just "b2")-  _ <- buttonNew (toRectangle (55, 55, 25, 25)) (Just "b3")-  _ <- buttonNew (toRectangle (65, 65, 25, 25)) (Just "b4")-  _ <- buttonNew (toRectangle (75, 75, 25, 25)) (Just "b5")-  _ <- buttonNew (toRectangle (85, 85, 25, 25)) (Just "b6")-  _ <- buttonNew (toRectangle (95, 95, 25, 25)) (Just "b7")-  _ <- buttonNew (toRectangle (105, 105, 25, 25)) (Just "b8")-  _ <- buttonNew (toRectangle (115, 115, 25, 25)) (Just "b9")-  _ <- buttonNew (toRectangle (125, 125, 25, 25)) (Just "b10")-  _ <- buttonNew (toRectangle (135, 135, 25, 25)) (Just "b11")-  _ <- buttonNew (toRectangle (145, 145, 25, 25)) (Just "b12")-  _ <- buttonNew (toRectangle (155, 155, 25, 25)) (Just "b13")-  _ <- buttonNew (toRectangle (165, 165, 25, 25)) (Just "b14")-  _ <- buttonNew (toRectangle (175, 175, 25, 25)) (Just "b15")-  _ <- buttonNew (toRectangle (185, 185, 25, 25)) (Just "b16")-  _ <- buttonNew (toRectangle (195, 195, 25, 25)) (Just "b17")-  _ <- buttonNew (toRectangle (205, 205, 25, 25)) (Just "b18")-  _ <- buttonNew (toRectangle (215, 215, 25, 25)) (Just "b19")-  _ <- buttonNew (toRectangle (225, 225, 25, 25)) (Just "b20")-  _ <- buttonNew (toRectangle (235, 235, 25, 25)) (Just "b21")-  _ <- buttonNew (toRectangle (245, 245, 25, 25)) (Just "b22")-  _ <- buttonNew (toRectangle (255, 255, 25, 25)) (Just "b23")-  _ <- buttonNew (toRectangle (265, 265, 25, 25)) (Just "b24")-  end pack-  setResizable w (Just w)-  end scrolled-  lb1 <- lightButtonNew (toRectangle (10, 305, 165, 25)) (Just "HORIZONTAL")-  setType lb1 RadioButtonType-  setCallback lb1 (type_cb scrolled pack PackHorizontal)-  lb2 <- lightButtonNew (toRectangle(185, 305, 165, 25)) (Just "VERTICAL")-  setType lb2 RadioButtonType-  _ <- setValue lb2 True-  setCallback lb2 (type_cb scrolled pack PackVertical)-  vs <- horValueSliderNew (toRectangle (100, 335, 250, 25)) (Just "Spacing: ")-  setAlign vs (Alignments [AlignTypeLeft])-  range vs 0 30-  setStep vs 1-  setCallback vs (spacing_cb scrolled pack)-  end w-  showWidget w-  _ <- FL.run-  return ()

@@ -1,113 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.FLTKHS--buttonCb :: Ref LightButton -> IO ()-buttonCb lightButton = do-  l' <- getLabel lightButton-  print $ "BUTTON: " ++ l'--setTableSize :: Ref Table -> Int -> Int -> IO ()-setTableSize t' nr' nc' = do-  clear t'-  setRows t' nr'-  setCols t' nc'-  begin t'-  let (rowCols :: [(Int,Int)]) = [(r',c') | r' <- [0..(nr'-1)], c' <- [0..(nc'-1)]]-  mapM_-    (\(_r,_c) -> do-        cellRectangle <- findCell t' ContextTable (TableCoordinate (Row _r) (Column _c))-        case cellRectangle of-         Just cellRectangle' ->-           if (odd _c)-           then do-            let s = (show _r) ++ "." ++ (show _c)-            input_ <- inputNew cellRectangle' Nothing Nothing-            _ <- setValue input_ s Nothing-            return ()-           else-             do-               let s = (show _r) ++ "/" ++ (show _c)-               butt <- lightButtonNew cellRectangle' (Just s)-               setAlign butt (Alignments [AlignTypeCenter, AlignTypeInside])-               setCallback butt buttonCb-               _ <- setValue butt ((_r+_c*2) `mod` 4 == 0)-               return ()-         Nothing -> return ()-    )-    rowCols-  end t'--drawCell :: Ref Table -> TableContext -> TableCoordinate -> Rectangle -> IO ()-drawCell t' tcontext' (TableCoordinate (Row tr') (Column tc')) r' =-  case tcontext' of-    ContextStartPage -> flcSetFont helvetica (FontSize 12)-    ContextRCResize -> do-      rows' <- getRows t'-      cols' <- getCols t'-      let (rowCols :: [(Int,Int)]) = [(_r,_c) | _r <- [0..(rows'-1)], _c <- [0..(cols'-1)]]-      mapM_-        (\((i::Int), (_r',_c')) -> do-            children' <- children t'-            if (i >= children')-              then return ()-              else do-                cellRectangle <- findCell t' ContextTable (TableCoordinate (Row _r') (Column _c'))-                case cellRectangle of-                  Just cellRectangle' -> do-                   child' <- getChild t' i-                   maybe (return ()) (\c -> resize c cellRectangle') child'-                  Nothing -> return ()-        )-        (zip [0..] rowCols)-      initSizes t'-    ContextRowHeader -> do-      flcPushClip r'-      let s = "Row " ++ (show tr')-      headerColor <- getRowHeaderColor t'-      flcDrawBox ThinUpBox r' headerColor-      flcSetColor blackColor-      flcDrawInBox s r' (Alignments [AlignTypeCenter]) Nothing Nothing-      flcPopClip-    ContextColHeader -> do-      flcPushClip r'-      let s = "Column " ++ (show tc')-      headerColor <- getColHeaderColor t'-      flcDrawBox ThinUpBox r' headerColor-      flcSetColor blackColor-      flcDrawInBox s r' (Alignments [AlignTypeCenter]) Nothing Nothing-      flcPopClip-    _ -> return ()-initializeTable :: Ref Table -> IO ()-initializeTable t = do-  begin t-  setColHeader t True-  setColResize t True-  setColHeaderHeight t 25-  setRowHeader t True-  setRowResize t True-  setRowHeaderWidth t 80-  end t-main :: IO ()-main = do-  win <- doubleWindowNew (toSize (940,500)) Nothing (Just "table as container")-  win_w <- getW win-  win_h <- getH win-  begin win-  table <- tableCustom-            (toRectangle (20,20,win_w-40,win_h-40))-            (Just "FLTK widget table")-            Nothing-            drawCell-            defaultCustomWidgetFuncs-            defaultCustomTableFuncs-  initializeTable table-  setTableSize table 50 50-  end win-  setResizable win (Just table)-  showWidget win-  _ <- FL.run-  return ()

@@ -1,78 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations--maxRows :: Int-maxRows = 30-maxCols :: Int-maxCols = 26-tableData :: [[Int]]-tableData =-    let rowIndices = [0 .. (maxRows - 1)]-        colIndices = [0 .. (maxCols - 1)]-    in-      map (\r -> map (\c -> 1000 + (r * 1000) + c) colIndices) rowIndices-drawHeader :: Ref Table -> String -> Rectangle -> IO ()-drawHeader table s rectangle = do-  flcPushClip rectangle-  rhc <- getRowHeaderColor table-  flcDrawBox ThinUpBox rectangle rhc-  flcSetColor blackColor-  flcDrawInBox s rectangle alignCenter Nothing Nothing-  flcPopClip-drawData :: Ref Table -> String -> Rectangle -> IO ()-drawData table s rectangle = do-  flcPushClip rectangle-  flcSetColor whiteColor >> flcRectf rectangle-  flcSetColor gray0Color >> flcDrawInBox s rectangle alignCenter Nothing Nothing-  color' <- getColor table-  flcSetColor color' >> flcRect rectangle-  flcPopClip-drawCell :: Ref Table -> TableContext -> TableCoordinate -> Rectangle -> IO ()-drawCell table context (TableCoordinate (Row row) (Column col)) rectangle = do-  case context of-   ContextStartPage -> flcSetFont helvetica (FontSize 16)-   ContextColHeader ->-       let a = fromEnum 'A'-           currentLetter :: Char-           currentLetter = (toEnum $ fromEnum a + col)-       in-       drawHeader table [currentLetter] rectangle-   ContextRowHeader -> drawHeader table (show row) rectangle-   ContextCell -> drawData table (show $ tableData !! row !! col) rectangle-   _ -> return ()-initializeTable :: Ref Table -> IO ()-initializeTable table = do-  begin table-  setRows table maxRows-  setRowHeader table True-  setRowHeightAll table 20-  setRowResize table False-  setCols table maxCols-  setColHeader table True-  setColWidthAll table 80-  setColResize table True-  end table-main :: IO ()-main = do-  window <- doubleWindowNew-              (Size (Width 900) (Height 400))-              Nothing-              (Just "Simple Table")-  begin window-  table <- tableCustom-             (Rectangle-               (Position (X 10) (Y 10))-               (Size (Width 880) (Height 380)))-             Nothing-             Nothing-             drawCell-             defaultCustomWidgetFuncs-             defaultCustomTableFuncs-  initializeTable table-  setResizable window (Just table)-  end window-  showWidget window-  _ <- FL.run-  return ()

@@ -1,241 +0,0 @@-{-# LANGUAGE CPP #-}-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Control.Monad-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Data.IORef-import Data.List-import Data.Function-import System.Process-dirCommand :: ([Char], [[Char]])-dirHeaders :: [[Char]]-#ifdef mingw32_HOST_OS-dirCommand = ("dir", [])-dirHeaders = ["Perms", "#L", "Own", "Group", "Size", "Date", "", "", "Filename"]-#else-dirCommand = ("ls", ["-l"])-dirHeaders = ["Date", "Time", "Size", "Filename", "", "", "", "", ""]-#endif-margin :: Int-margin = 20-headerFontFace :: Font-headerFontFace = helveticaBold-headerFontSize :: FontSize-headerFontSize = FontSize 16-rowFontFace :: Font-rowFontFace = helvetica-rowFontSize :: FontSize-rowFontSize = FontSize 16--data TableState = TableState {-  sortReverse :: IORef Bool,-  sortLastCol :: IORef Int,-  rowData :: IORef [[String]]-  }--drawSortArrow :: Rectangle -> Bool -> IO ()-drawSortArrow (Rectangle (Position (X x') (Y y')) (Size (Width w') (Height h'))) sortReverse' =-  let xlft = x' + (w'-6) - 8-      xctr = x' + (w'-6) - 4-      xrit = x' + (w'-6) - 0-      ytop = y' + (truncate ((fromIntegral h' / 2) :: Double)) - 4-      ybot = y' + (truncate ((fromIntegral h' / 2) :: Double)) + 4-  in-   if sortReverse'-   then do-     flcSetColor whiteColor-     flcLine (Position (X xrit) (Y ytop)) (Position (X xctr) (Y ybot))-     flcSetColorWithC 41-     flcLine (Position (X xlft) (Y ytop)) (Position (X xrit) (Y ytop))-     flcLine (Position (X xlft) (Y ytop)) (Position (X xctr) (Y ybot))-   else do-     flcSetColor whiteColor-     flcLine (Position (X xrit) (Y ybot)) (Position (X xctr) (Y ybot))-     flcLine (Position (X xrit) (Y ybot)) (Position (X xlft) (Y ybot))-     flcSetColorWithC 41-     flcLine (Position (X xlft) (Y ybot)) (Position (X xctr) (Y ytop))--drawCell ::  TableState -> Ref TableRow -> TableContext -> TableCoordinate -> Rectangle -> IO ()-drawCell tableState table tc (TableCoordinate (Row row') (Column col')) rectangle' =-  let (x',y',w',h') = fromRectangle rectangle'-  in do-    sortReverse' <- readIORef (sortReverse tableState)-    sortLastCol' <- readIORef (sortLastCol tableState)-    rowData' <- readIORef (rowData tableState)-    numCols <- getCols table-    numRows <- getRows table-    if (row' < numRows && col' < numCols)-      then case tc of-            ContextColHeader -> do-              flcPushClip rectangle'-              flcDrawBox ThinUpBox rectangle' backgroundColor-              if (col' < 9)-                then do-                  flcSetColor blackColor-                  flcDrawInBox-                    (dirHeaders !! col')-                    (toRectangle ((x'+2),y',w',h'))-                    alignLeft-                    Nothing-                    Nothing-                  if (col' == sortLastCol')-                    then drawSortArrow rectangle' sortReverse'-                    else return ()-                else return ()-              flcPopClip-            ContextCell -> do-              flcPushClip rectangle'-              bgColor <- do-                isSelected' <- getRowSelected table row'-                case isSelected' of-                  Right is' -> if is'-                               then getSelectionColor table-                               else return whiteColor-                  Left _ -> error $ "Row: " ++ (show row') ++ " is out of range."-              flcSetColor bgColor-              flcRectf rectangle'-              flcSetFont rowFontFace rowFontSize-              flcSetColor blackColor-              let currentRow = rowData' !! row'-              flcDrawInBox-                (indexOr "" col' currentRow)-                (toRectangle $ (x'+2,y',w',h'))-                alignLeft-                Nothing-                Nothing-              flcSetColor light2Color-              flcRect rectangle'-              flcPopClip-            _ -> return ()-      else return ()-setIndex :: Int -> [a] -> (a -> a) -> [a]-setIndex idx' xs f =-  map-   (-    \(i,e) -> if (i == idx')-                 then f e-                 else e-   )-   (zip [0..] xs)--indexOr :: a -> Int -> [a] -> a-indexOr fallback idx xs =-  if (idx < length xs)-  then xs !! idx-  else fallback--eventCallback :: TableState -> Ref TableRow -> IO ()-eventCallback tableState table = do-  (Column  col') <- callbackCol table-  context' <- callbackContext table-  case context' of-   ContextColHeader -> do-     event' <- FL.event-     mouseButton' <- FL.eventButton-     if (event' == Release && mouseButton' == Mouse_Left)-       then do-         sortLastCol' <- readIORef (sortLastCol tableState)-         if (sortLastCol' == col')-           then readIORef (sortReverse tableState) >>= writeIORef (sortReverse tableState) . toggle-           else writeIORef (sortReverse tableState) False-         sortReverse' <- readIORef (sortReverse tableState)-         rowData' <- readIORef (rowData tableState) >>= return . zip [(0 :: Int)..]-         let sorted = sortBy (compare `on` (indexOr "" col'. snd)) rowData'-         writeIORef-           (rowData tableState)-           (if sortReverse'-            then (reverse $ map snd sorted)-            else map snd sorted)-         writeIORef (sortLastCol tableState) col'-         redraw table-         else return ()-   _ -> return ()-  where toggle True = False-        toggle False = True--autowidth :: Ref TableRow -> Int -> [[String]] -> IO ()-autowidth table pad rowData' = do-  flcSetFont headerFontFace headerFontSize-  mapM_-    (\(colNum, colName) -> do-        (Size (Width w') _) <- flcMeasure colName True True-        setColWidth table (Column colNum) (w' + pad)-    )-    (zip [0 ..] dirHeaders)-  flcSetFont rowFontFace rowFontSize-  mapM_-    (\row' -> do-      mapM_-        (\(colIdx,col) -> do-            (Size (Width wc') _) <- flcMeasure col True True-            colWidth' <- getColWidth table (Column colIdx)-            if (wc' + pad > colWidth')-              then setColWidth table (Column colIdx) (wc' + pad)-              else return ()-        )-        (zip [0..] row')-    )-    rowData'-  -- need to do { table_resized(); redraw(); }-  -- but table_resized() is unexposed.-  -- setting the row_header flag induces this.-  getRowHeader table >>= setRowHeader table--resize_window :: Ref DoubleWindow -> Ref TableRow -> IO ()-resize_window window table = do-  let width = (4 :: Int)-  numCols <- getCols table-  colWidthTotal <- liftM sum $ mapM (getColWidth table . Column) [0..(numCols - 1)]-  let totalWidth = width + colWidthTotal + (margin * 2)-  appWidth <- FL.w-  if (totalWidth < 200 || totalWidth > appWidth)-    then return ()-    else do-      x' <- getX window-      y' <- getY window-      h' <- getH window-      resize window $ toRectangle (x',y',totalWidth,h')--main :: IO ()-main = do-  window <- doubleWindowNew-              (Size (Width 900) (Height 500))-              Nothing-              (Just "Table Sorting")-  windowW <- getW window-  windowH <- getH window-  rows <- uncurry readProcess dirCommand "" >>= return . map words . lines-  rowData' <- newIORef rows-  sortReverse' <- newIORef False-  sortLastCol' <- newIORef (-1)-  let tableState = TableState sortReverse' sortLastCol' rowData'-  begin window-  table <- tableRowNew-             (Rectangle-               (Position (X margin) (Y margin))-               (Size (Width $ windowW - margin * 2)-                     (Height $ windowH - margin * 2)))-             Nothing-             Nothing-             (drawCell tableState)-             defaultCustomWidgetFuncs-             defaultCustomTableFuncs-  setColHeader table True-  setColResize table True-  setSelectionColor table yellowColor-  setWhen table [WhenRelease]-  readIORef rowData' >>= setRows table . length-  readIORef rowData' >>= setCols table . maximum . map length-  setRowHeightAll table 18-  readIORef rowData' >>= autowidth table 20-  setTooltip table "Click on column headings to toggle column sorting"-  setColor table whiteColor-  setCallback table (eventCallback tableState)-  end window-  setResizable window (Just table)-  resize_window window table-  _ <- showWidget window-  _ <- FL.run-  return ()

@@ -1,292 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module Main where-import           Data.IORef-import qualified Graphics.UI.FLTK.LowLevel.FL              as FL-import           Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import           Graphics.UI.FLTK.LowLevel.Fl_Types-import           Graphics.UI.FLTK.LowLevel.FLTKHS--maxCols, maxRows :: Int-maxCols = 26-maxRows = 500--data SpreadsheetProperties =-  SpreadsheetProperties-  {-    rowEdit      :: Int-  , colEdit      :: Int-  , sLeftTop     :: TableCoordinate-  , sRightBottom :: TableCoordinate-  , values       :: [[Int]]-  }--setIndex :: Int -> (a -> a) -> [a] -> [a]-setIndex idx' f xs =-  map-   (-    \(i,e) -> if (i == idx')-                 then f e-                 else e-   )-   (zip [0..] xs)--setValueHide :: IORef SpreadsheetProperties -> Ref Table -> Ref IntInput -> IO ()-setValueHide sp' table' intInput' = do-  props' <- readIORef sp'-  inputValue' <- getValue intInput' >>= return . read-  let updatedValues' = setIndex-                         (rowEdit props')-                         (setIndex-                           (colEdit props')-                           (const inputValue'))-                         (values props')-      updatedProperties' = props' {-          values = updatedValues'-        }-  writeIORef sp' updatedProperties'-  hide intInput'-  window' <- getWindow table'-  maybe (return ()) (\w' -> setCursor w' CursorDefault ) window'--startEditing :: IORef SpreadsheetProperties -> Ref IntInput -> Ref Table -> Int -> Int -> IO ()-startEditing props' intInput' table' row' col' = do-  modifyIORef props' (\p' -> p' {rowEdit = row', colEdit = col'})-  _p <- readIORef props'-  setSelection table' (rowEdit _p) (colEdit _p) (rowEdit _p) (colEdit _p)-  rectangle' <- findCell table' ContextCell (TableCoordinate (Row (rowEdit _p)) (Column  (colEdit _p)))-  case rectangle' of-    Just rect' -> do-      resize intInput' rect'-      let cellContents = (values _p) !! (rowEdit _p) !! (colEdit _p)-      _ <- setValue intInput' (show cellContents) Nothing-      _ <- setPosition intInput' 0 (Just (length $ show cellContents))-      showWidget intInput'-      _ <- takeFocus intInput'-      return ()-    _ -> return ()--doneEditing :: IORef SpreadsheetProperties -> Ref IntInput -> Ref Table -> IO ()-doneEditing props' intInput' table' = do-  _p <- readIORef props'-  visible' <- getVisible intInput'-  if visible'-   then setValueHide props' table' intInput'-   else return ()--eventCallback :: IORef SpreadsheetProperties -> Ref IntInput -> Ref Table -> IO ()-eventCallback props' intInput' table' = do-  _p <- readIORef props'-  (Row r') <- callbackRow table'-  (Column c') <- callbackCol table'-  context' <- callbackContext table'-  numRows' <- getRows table'-  numCols' <- getCols table'-  case context' of-    ContextCell -> do-      event' <- FL.event-      case event' of-        Push -> do-          doneEditing props' intInput' table'-          if (r' /= (numRows' -1) && c' /= (numCols' -1))-            then startEditing props' intInput' table' r' c'-            else return ()-          return ()-        Keydown -> do-          eventKey' <- FL.eventKey-          if (eventKey' == (SpecialKeyType Kb_Escape))-            then return ()-            else if (r' == numRows' - 1 || c' == numCols' -1)-                 then return ()-                 else do-                   doneEditing props' intInput' table'-                   setSelection table' r' c' r' c'-                   startEditing props' intInput' table' r' c'-                   newEvent <- FL.event-                   if (newEvent == Keydown)-                     then handle intInput' newEvent >> return ()-                     else return ()-                   return ()-        _  -> return ()-    _c -> if (any (== _c) [ContextTable, ContextRowHeader, ContextColHeader])-          then doneEditing props' intInput' table'-          else return ()--setBySlider :: Ref ValueSlider -> Ref Table -> (Ref Table -> Int -> IO ()) -> IO ()-setBySlider slider' table' f = do-  v' <- getValue slider'-  f table' (truncate $ v'+1)-  redraw table'--setColsCb :: Ref Table -> Ref ValueSlider -> IO ()-setColsCb table' slider' = setBySlider slider' table' setCols--setRowsCb :: Ref Table -> Ref ValueSlider -> IO ()-setRowsCb table' slider' = setBySlider slider' table' setRows--drawCell :: IORef SpreadsheetProperties -> Ref IntInput -> Ref Table -> TableContext -> TableCoordinate -> Rectangle -> IO ()-drawCell props' intInput' table' context' (TableCoordinate (Row row') (Column col')) rectangle' = do-  _p <- readIORef props'-  numRows' <- getRows table'-  numCols' <- getCols table'-  case context' of-   ContextStartPage -> do-     (p1,p2) <- getSelection table'-     modifyIORef props' (\p -> p {sLeftTop = p1, sRightBottom = p2})-   ContextColHeader -> do-     flcSetFont helveticaBold (FontSize 14)-     flcPushClip rectangle'-     getColHeaderColor table' >>= flcDrawBox ThinUpBox rectangle'-     flcSetColor blackColor-     if (col' == numCols' - 1)-       then flcDrawInBox "TOTAL" rectangle' alignCenter Nothing Nothing-       else flcDrawInBox [toEnum $ fromEnum 'A' + col'] rectangle' alignCenter Nothing Nothing-     flcPopClip-   ContextRowHeader -> do-     flcSetFont helveticaBold (FontSize 14)-     flcPushClip rectangle'-     getRowHeaderColor table' >>= flcDrawBox ThinUpBox rectangle'-     flcSetColor blackColor-     if (row' == numRows' - 1)-       then flcDrawInBox "TOTAL" rectangle' alignCenter Nothing Nothing-       else flcDrawInBox (show $ row' + 1) rectangle' alignCenter Nothing Nothing-     flcPopClip-   ContextCell-> do-     visible' <- getVisible intInput'-     let (TableCoordinate (Row sTop') (Column sLeft')) = sLeftTop _p-         (TableCoordinate (Row sBottom') (Column sRight')) = sRightBottom _p-     if (row' == (rowEdit _p) && col' == (colEdit _p) && visible')-       then return ()-       else do-            if (row' >= sTop' && row' <= sBottom' && col' >= sLeft' && col' <= sRight')-              then flcDrawBox ThinUpBox rectangle' yellowColor-              else if (col' < numCols' - 1 && row' < numRows' - 1)-                   then do-                     selected' <- isSelected table' (TableCoordinate (Row row') (Column col'))-                     flcDrawBox ThinUpBox rectangle' (if selected' then yellowColor else whiteColor)-                   else flcDrawBox ThinUpBox rectangle' (Color 0xbbddbb00)-            flcPushClip rectangle'-            flcSetColor blackColor-            if (col' == numCols' - 1 || row' == numRows' - 1)-              then do-                flcSetFont helveticaBold (FontSize 14)-                let shownValues = map (take (numCols'- 1)) $ take (numRows' -1) (values _p)-                let s' = if (col' == numCols' - 1 && row' == numRows' - 1)-                         then (show . sum . map sum) shownValues-                         else if (col' == numCols' - 1)-                              then (show $ sum $ shownValues !! row')-                              else if (row' == numRows' - 1)-                                   then (show . sum . map (\r -> r !! col')) shownValues-                                   else ""-                let (x',y',w',h') = fromRectangle rectangle'-                flcDrawInBox s' (toRectangle (x'+3,y'+3,w'-6,h'-6)) alignRight Nothing Nothing-              else do-                flcSetFont helvetica (FontSize 14)-                let s' = show $ (values _p) !! row' !! col'-                let (x',y',w',h') = fromRectangle rectangle'-                flcDrawInBox s' (toRectangle (x'+3,y'+3,w'-6,h'-6)) alignRight Nothing Nothing-            flcPopClip-   ContextRCResize -> do-     visible' <- getVisible intInput'-     if (not visible')-       then return ()-       else do-         cellRectangle' <- findCell table' ContextTable (TableCoordinate (Row row') (Column  col'))-         case cellRectangle' of-           Just cr' -> if (cr' == rectangle')-                       then return ()-                       else resize intInput' cr'-           Nothing -> return ()-   _  -> return ()--main :: IO ()-main = do-  FL.setOption FL.OptionArrowFocus True-  win' <- doubleWindowNew-           (Size (Width 922) (Height 382))-           Nothing-           (Just "Fl_Table Spreadsheet with Keyboard Navigation")-  winWidth' <- getW win'-  winHeight' <- getH win'-  let values' =-        map-          (\r' ->-            map-             (\c' -> (r'+2) * (c'+3))-             [0 .. (maxCols -1)]-          )-          [0.. (maxRows - 1)]-  props' <- newIORef $-              SpreadsheetProperties-                0-                0-                (TableCoordinate (Row 0) (Column 0))-                (TableCoordinate (Row 0) (Column 0))-                values'-  let tableWidth' = winWidth' - 80-      tableHeight' = winHeight' - 80-  intInput' <- intInputNew-                (toRectangle-                 (-                  (truncate $ ((fromIntegral tableWidth' / 2) :: Double)),-                  (truncate $ ((fromIntegral tableHeight' / 2) :: Double)),-                  0,-                  0-                 )-                )-                Nothing-  hide intInput'-  setWhen intInput' [WhenEnterKeyAlways]-  setMaximumSize intInput' 5--  spreadsheet' <- tableCustom-                    (toRectangle (20,20,tableWidth', tableHeight'))-                    Nothing-                    Nothing-                    (drawCell props' intInput')-                    defaultCustomWidgetFuncs-                    defaultCustomTableFuncs-  whens' <- getWhen spreadsheet'-  setWhen spreadsheet' $ [WhenNotChanged] ++ whens'-  setSelection spreadsheet' 0 0 0 0-  setCallback intInput' (setValueHide props' spreadsheet')-  setCallback spreadsheet' (eventCallback props' intInput')-  setTooltip spreadsheet' "Use keyboard to navigate cells:\n Arrow keys or Tab/Shift-Tab"-  -- Table rows-  setRowHeader spreadsheet' True-  setRowHeaderWidth spreadsheet' 70-  setRowResize spreadsheet' True-  setRows spreadsheet' 11-  setRowHeightAll spreadsheet' 25-  -- Table cols-  setColHeader spreadsheet' True-  setColHeaderHeight spreadsheet' 25-  setColResize spreadsheet' True-  setCols spreadsheet' 11-  setColWidthAll spreadsheet' 70--  begin win'-  -- Rows slider-  setRows' <- valueSliderNew (toRectangle (winWidth'-40,20,20,winHeight'-80)) Nothing-  setType setRows' VertNiceSliderType-  bounds setRows' 2 (fromIntegral maxRows)-  setStep setRows' 1-  numRows' <- getRows spreadsheet'-  _ <- setValue setRows' (fromIntegral $ numRows'-1)-  setCallback setRows' (setRowsCb spreadsheet')-  setWhen setRows' [WhenChanged]-  clearVisibleFocus setRows'-   -- Cols slider-  setCols' <- valueSliderNew (toRectangle (20,winHeight'-40,winWidth'-80,20)) Nothing-  setType setCols' HorNiceSliderType-  bounds setCols' 2 (fromIntegral maxCols)-  setStep setCols' 1-  numCols' <- getCols spreadsheet'-  _ <- setValue setCols' (fromIntegral $ numCols'-1)-  setCallback setCols' (setColsCb spreadsheet')-  setWhen setCols' [WhenChanged]-  clearVisibleFocus setCols'-  end win'-  setResizable win' (Just spreadsheet')-  showWidget win'-  _ <- FL.run-  return ()

@@ -1,23 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations-import Graphics.UI.FLTK.LowLevel.FLTKHS-main :: IO ()-main = do-  let stes = [(StyleTableEntry (Just redColor) (Just courier) (Just $ FontSize 18)),-              (StyleTableEntry (Just darkYellowColor) (Just courier) (Just $ FontSize 18)),-              (StyleTableEntry (Just darkGreenColor) (Just courier) (Just $ FontSize 18)),-              (StyleTableEntry (Just blueColor) (Just courier) (Just $ FontSize 18))]-  win <- windowNew (toSize (640,480)) Nothing (Just $ "Simple Text Display With Colors")-  disp <- textDisplayNew (toRectangle (20,20,640-40,480-40)) Nothing-  tbuff <- textBufferNew Nothing Nothing-  sbuff <- textBufferNew Nothing Nothing-  setBuffer disp (Just tbuff)-  highlightData disp sbuff (indexStyleTableEntries stes) Nothing-  setText tbuff "Red Line 1\nYel Line 2\nGrn Line 3\nBlu Line 4\nRed Line 5\nYel Line 6\nGrn Line 7\nBlu Line 8\n"-  setText sbuff "AAAAAAAAAA\nBBBBBBBBBB\nCCCCCCCCCC\nDDDDDDDDDD\nAAAAAAAAAA\nBBBBBBBBBB\nCCCCCCCCCC\nDDDDDDDDDD\n"-  setResizable win (Just disp)-  showWidget win-  _ <- FL.run-  return ()

@@ -1,15 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.FLTKHS--main :: IO ()-main = do-  win <- doubleWindowNew (toSize (640,480)) Nothing (Just "Simple Fl_Text_Editor")-  buff <- textBufferNew Nothing Nothing-  edit <- textEditorNew (toRectangle (20,20,(640-40),(480-40))) Nothing-  setBuffer edit (Just buff)-  showWidget win-  setText buff "line 0\nline 1\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8\nline 9\nline 10\nline 11\nline 12\nline 13\nline 14\nline 15\nline 16\nline 17\nline 18\nline 19\nline 20\nline 21\nline 22\nline 23\n"-  _ <- FL.run-  return ()

@@ -1,69 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.FLTKHS-import Graphics.UI.FLTK.LowLevel.Fl_Enumerations--main :: IO ()-main = do-  window <- doubleWindowNew (Size (Width 300) (Height 300)) Nothing Nothing-  setBox window NoBox-  _ <- setResizable window (Just window)-  tile <- tileNew (toRectangle (0,0,300,300)) Nothing-  box0 <- boxNew (toRectangle (0,0,150,150)) (Just "0")-  setBox box0 DownBox-  setColor box0 (Color 9)-  setLabelsize box0 (FontSize 36)-  setAlign box0 (Alignments [AlignTypeClip])--  w1 <- doubleWindowNew (Size (Width 150) (Height 150)) (Just (Position (X 150) (Y 0))) Nothing-  begin w1-  setBox w1 NoBox-  box1 <- boxNew (toRectangle (0,0,150,150)) (Just "1\nThis is a child window")-  setBox box1 DownBox-  setColor box1 (Color 19)-  setLabelsize box1 (FontSize 18)-  setAlign box1 (Alignments [AlignTypeClip, AlignTypeInside, AlignTypeWrap])-  _ <- setResizable w1 (Just box1)-  end w1--  box2a <- boxNew (toRectangle (0,150,70,150)) (Just "2a")-  setBox box2a DownBox-  setColor box2a (Color 12)-  setLabelsize box2a (FontSize 36)-  setAlign box2a (Alignments [AlignTypeClip])--  box2b <- boxNew (toRectangle (70,150,80,150)) (Just "2b")-  setBox box2b DownBox-  setColor box2b (Color 13)-  setLabelsize box2b (FontSize 36)-  setAlign box2b (Alignments [AlignTypeClip])--  box3a <- boxNew (toRectangle (150,150,150,70)) (Just "3a")-  setBox box3a DownBox-  setColor box3a (Color 12)-  setLabelsize box3a (FontSize 36)-  setAlign box3a (Alignments [AlignTypeClip])--  box3b <- boxNew (toRectangle (150,(150+70),150,80)) (Just "3b")-  setBox box3b DownBox-  setColor box3b (Color 13)-  setLabelsize box3b (FontSize 36)-  setAlign box3b (Alignments [AlignTypeClip])--  -- create the symmetrical resize box with dx and dy pixels distance, resp.-  -- from the borders of the Fl_Tile widget-  let dx = 20-  let dy = 20-  tileX <- getX tile-  tileY <- getY tile-  tileW <- getW tile-  tileH <- getH tile-  r <- boxNew (toRectangle ((tileX+dx), (tileY+dy), (tileW-(2*dx)), (tileH-(2*dy)))) Nothing-  _ <- setResizable tile (Just r)-  end tile-  end window--  _ <- showWidget w1-  _ <- showWidget window-  _ <- FL.run-  return ()

@@ -1,48 +0,0 @@-module Main where-import qualified Graphics.UI.FLTK.LowLevel.FL as FL-import Graphics.UI.FLTK.LowLevel.Fl_Types-import Graphics.UI.FLTK.LowLevel.FLTKHS--treeCallback :: Ref Tree -> IO ()-treeCallback tree' = do-  (Just item') <- getCallbackItem tree'-  reason' <- getCallbackReason tree'-  label' <- getLabel item'-  case reason' of-    TreeReasonSelected -> do-      (Just path') <- itemPathname tree' item'-      print $ "TreeCallback: Item selected =" ++ label' ++ "Full pathname=" ++ path' ++ "\n"-    TreeReasonDeselected ->-      print $ "TreeCallback: Item deselected =" ++ label' ++ "\n"-    TreeReasonOpened ->-      print $ "TreeCallback: Item opened =" ++ label' ++ "\n"-    TreeReasonClosed ->-      print $ "TreeCallback: Item closed =" ++ label' ++ "\n"-    _ -> print ""-main :: IO ()-main = do-  _ <- FL.setScheme "gtk+"-  window <- windowNew (toSize (250,400)) Nothing (Just "Simple Tree")-  begin window-  windowWidth' <- getW window-  windowHeight' <- getH window-  tree <- treeNew (toRectangle (10,10,windowWidth' - 20,windowHeight' - 20)) Nothing-  setShowroot tree False-  _ <- add tree "Flintstones/Fred"-  _ <- add tree "Flintstones/Wilma"-  _ <- add tree "Flintstones/Pebbles"-  _ <- add tree "Simpsons/Homer"-  _ <- add tree "Simpsons/Marge"-  _ <- add tree "Simpsons/Bart"-  _ <- add tree "Simpsons/Lisa"-  _ <- add tree "Pathnames/\\/bin"-  _ <- add tree "Pathnames/\\/usr\\/sbin"-  _ <- add tree "Pathnames/C:\\\\Program Files"-  _ <- add tree "Pathnames/C:\\\\Documents and Settings"-  close tree (TreeItemNameLocator (TreeItemName "Simpsons"))-  close tree (TreeItemNameLocator (TreeItemName "Pathnames"))-  setCallback tree treeCallback-  end window-  showWidget window-  _ <- FL.run-  return ()

@@ -26,7 +26,7 @@   checkImage ref'  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -34,3 +34,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.BMPImage"+-- @

@@ -40,6 +40,10 @@          --          -- $Compilation +         -- * Cabal REPL Issues+         --+         -- $CabalREPLIssues+          -- * Core Types          module Graphics.UI.FLTK.LowLevel.Fl_Types,          -- * Widgets@@ -259,11 +263,13 @@ -- (1) provides full coverage of the toolkit allowing the user to write GUI's in pure Haskell. -- (2) feels like it has polymorphic dispatch, meaning a single function dispatches to the right implementation based on the type of widget it is given -- (3) is /not/ monolithic, meaning new widgets can be incorporated the user's application without needing to recompile this library--- (4) is conservative on the extensions so that older GHC's (and perhaps non-GHC compilers) can use it--- (5) is easy to install. This library has a minimum of dependencies and <http://fltk.org FLTK> itself compiles cleanly on most architectures--- (6) allows the user to produce statically linked binaries with no external dependencies--- (7) includes a lot of complete working demos so that the user can get up and running faster--- (8) comes with GUI builder support to alleviate the tedium of laying out widgets by hand+-- (4) is easy to install. This library has a minimum of dependencies and <http://fltk.org FLTK> itself compiles cleanly on most architectures+-- (5) allows the user to produce statically linked binaries with no external dependencies+-- (6) includes a lot of complete working demos so that the user can get up and running faster. (see note below)+-- (7) comes with GUI builder support to alleviate the tedium of laying out widgets by hand+--+-- _Note_: As of version 0.4.0.1, the demos have been moved into their own package <http://hackage.haskell.org/fltkhs-demos fltkhs-demos> for reasons outlined in the =Demos= section of+-- this document.  -- $FluidSupport --@@ -340,14 +346,14 @@ -- - The recommended way of installing FLTK on Linux is from source. The reason is that some package managers seem to put the headers and libraries in a non-standard locations which will cause the Haskell bindings to throw compilation errors. On OSX and Linux it should build and install smoothly using the standard: -- -- @--- > ./configure+-- > ./configure --enable-shared -- > make -- > make install -- @ -- -- If you are customizing your `configure` step it is important to at least enable OpenGL and Cairo like so: -----     > > ./configure --enable-gl --enable-cairo+--     > > ./configure --enable-shared --enable-gl --enable-cairo -- -- If you didn't install FLTK from source you will need to ensure that the FLTK headers are in the include path and, along with the standard FLTK library, `fltk_gl`, and `fltk_cairo` are also in the library path. You will also need the `make`, `autoconf`, and `autoheader` tools to build the Haskell bindings. --@@ -364,13 +370,15 @@ -- -- __Note:__ If this step produces a flood of `undefined reference` errors please ensure that you have the right version of FLTK (1.3.3) installed and that the headers are in the expected locations. It seems as though some package managers put the libraries and headers in non-standard places. ----- - Test that the build completed successfully by invoking+-- - Test that the build completed successfully by invoking incredibly unimpressive -----     > > fltkhs-hello-world+--     > > fltkhs-buttons --  -- $InstallationWindows --+-- _UPDATE_: This installation guide only works with MinGHC. Within the last month (January 2016) MinGHC has been deprecated and is no longer supported. If you have GHC 7.10.x, MinGHC will probably work for you but will not work for GHC 8. We are currently working on instructions for building on Windows with Stack.+-- -- Note: Currently this package only works on 64-bit Windows. -- -- This install guide has been tested on Windows 7 64-bit with 8GB of RAM.@@ -471,51 +479,31 @@ -- -- Please note that compared to the Linux and Mac installs the compilation process takes a very long time. The reason for this is the MinGW gcc/g++ compilers are much slower. ----- Once this has completed, you can test it by:+-- Once this has completed, you can test it by invoking the incredibly unimpressive: -- -- @--- > fltkhs-hello-world+-- > fltkhs-buttons -- @  -- $Demos ----- There are currently two sets of FLTKHS demos, the ones that ship with this package--- and ones that show off <http://hackage.haskell.org/package/fltkhs-fluid-examples Fluid> support.------ The demos shipped with this package are listed in `fltkhs.cabal` as separate `Executable` components.--- Once the package is installed they are installed to Cabal's standard /bin/ directory (usually /~\/.cabal\/bin).------ Note that the executables install prefixed with \"fltkhs-\". Typing:------     > > fltkhs-<TAB>------ at the command line should show a list of available demos.------ Alternatively you can do:------     > > ls ~/.cabal/bin/fltkhs-*--------- Most of the demos are exact ports of those shipped in the /test/ directory of the <http://fltk.org FLTK> distribution.--- It is hoped the user will study the Haskell demo code side-by-side with the C++ demo code in order to understand the API.--- The section __API Guide__ covers this in more detail.------ == Why is the demo code so un-Haskelly?--- For being written in Haskell, the demo code is horrifyingly\/amazingly imperative and stateful. Although it may repulse those--- who used to pure Haskell idioms it is that way for a reason.------ The demo code was never meant to be idiomatic Haskell code but a way of showing as much of the API as possible. The API itself--- closely resembles the underlying C++ code which is imperative and stateful. This has the advantage of making the API easier--- to learn.+-- _Update_: As of version 0.4.0.1 all the demos have been moved to their own+-- package <http://hackage.haskell.org/fltkhs-demos fltkhs-demos>. This speeds up installation of this package+-- significantly and also allows the examples to be run interactively with `cabal+-- repl`. This was an issue pre-0.4.0.1 because the REPL needed to link against the+-- C library containing the C++ bindings and was having trouble finding it because+-- it was just created by the Cabal build step but not yet installed. This seems+-- like a better solution than hacking `Setup.hs` to make the library visible. ----- For instance, assuming FLTK was installed from source compare /src\/Examples\/arc.hs with /test\/arc.cxx in the FLTK--- source directory. There is quite a bit of correspondence and it is easy to see how the Haskell API functions map to the C++ ones.+-- There are currently two sets of FLTKHS demos, the ones that are part of the <http://hackage.haskell.org/fltkhs-demos fltkhs-demos> package+-- and ones that show off <http://hackage.haskell.org/package/fltkhs-fluid-examples Fluid> support. --+-- Please see the README in the <http://hackage.haskell.org/fltkhs-demos fltkhs-demos> package for more information. --  -- $GettingStarted ----- It is assumed that by this point the user has successfully installed this library and examples.+-- It is assumed that by this point the user has successfully installed this library and demos in <http://hackage.haskell.org/fltkhs-demos fltkhs-demos> (see above). -- -- -- = Quick Start@@ -583,7 +571,7 @@ -- takes an argument while the getter does not. Since Haskell does not support overloading this convention is used. -- -- (2) in many cases C++ uses overloading to provide default values to arguments. Since Haskell does--- not support overloading these arguments are 'Maybe' types eg. the `hotspot` function in "Graphics.UI.FLTK.LowLevel.Window".+-- not support overloading, these arguments are 'Maybe' types eg. the `hotspot` function in "Graphics.UI.FLTK.LowLevel.Window". -- In other cases where the common use case leaves the default arguments unspecified the binding provides two functions, -- a longer less-convenient-to-type one that takes the default argument and a short one that does not -- eg. `drawBox` and `drawBoxWithBoxtype`, also in "Graphics.UI.FLTK.LowLevel.Window".@@ -661,15 +649,13 @@  -- $Compilation ----- As described above, the API emulates multiple dispatch using type-level programming and typeclasseses. While this is makes for a nice API it has also--- slowed down compilation of executables much more than expected. This is especially true in the GHC 7.10.x series in which the step where GHC specialises typeclass--- function calls to concrete types has apparently taken a *huge* compile-time performance hit.+-- As described above, the API emulates multiple dispatch using type-level programming, closed type families and typeclasses. While this is makes for a nice API it has also+-- slowed down compilation of executables much more than expected. -- -- To clarify the time taken to compile the library itself has not changed, but applications that use the library to create executables are taking a lot--- longer (almost 3x compared to GHC 7.8.x) to compile. To further emphasize, there does not appear to be any runtime performance issues. This is only a--- compile time problem.+-- longer to compile. To further emphasize, there does not appear to be any runtime performance issues. This is only a compile time problem. ----- To preserve the user's and the author's sanity a flag `fastCompile` has been introduced to this package and to the <http://hackage.haskell.org/fltkhs-fluid-examples fltkhs-fluid-examples>.+-- To preserve the user's and the author's sanity a flag `fastCompile` has been introduced to the <http://hackage.haskell.org/fltkhs-demos fltkhs-demos> and to the <http://hackage.haskell.org/fltkhs-fluid-examples fltkhs-fluid-examples>. -- This flag which tells the compiler to skip the specialising step when compiling executables, dramatically decreases compile time but also bloats the resulting executable size and -- probably makes runtime performance much slower. In this package and <http://hackage.haskell.org/fltkhs-fluid-examples fltkhs-fluid-examples> it is enabled by default, since the executables are just -- demos that are not meant to show off performance. To disable this flag, tell Cabal to ignore it during the `configure` step:@@ -685,6 +671,10 @@ -- cabal configure -f fastCompile -- @ +-- $CabalREPLIssues+--+-- The recommended way to running the REPL in a `fltkhs` application is `cabal repl`. It works in GHC 7.8.x, but unfortunately will not work in GHC 7.10.x to due to a <https://ghc.haskell.org/trac/ghc/ticket/10568 regression>+--  -- =File Layout -- @@@ -692,7 +682,6 @@ --   - c-src            -- The C bindings --   - c-examples       -- demos written using the C bindings (not installed) --   - src---     - Examples       -- Haskell demos --     - TestPrograms   -- Haskell test programs --     - Fluid          -- The Fluid file to Haskell conversion utility --     - Graphics

@@ -26,7 +26,7 @@   checkImage ref'  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -34,3 +34,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.GIFImage"+-- @

@@ -31,7 +31,7 @@   jpegImageNewWithData' l' (castPtr jpeg') >>= toRef >>= checkImage  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -39,3 +39,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.JPEGImage"+-- @

@@ -31,7 +31,7 @@   pngImageNewWithData' l' (castPtr png') (B.length data') >>= toRef >>= checkImage  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -39,3 +39,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.PNGImage"+-- @

@@ -26,7 +26,7 @@   checkImage ref'  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -34,3 +34,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.PNMImage"+-- @

@@ -117,15 +117,15 @@   runOp _ _ image = withRef image $ \imagePtr -> uncache' imagePtr  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v -- "Graphics.UI.FLTK.LowLevel.RGBImage"---+-- @  -- $functions---+-- @ -- colorAverage :: 'Ref' 'RGBImage' -> 'Color' -> 'Float' -> 'IO' () -- -- copy:: ('Parent' a 'RGBImage') => 'Ref' 'RGBImage' -> 'Maybe' 'Size' -> 'IO' ('Maybe' ('Ref' a))@@ -151,3 +151,4 @@ -- inactive :: 'Ref' 'RGBImage' -> 'IO' () -- -- uncache :: 'Ref' 'RGBImage' -> 'IO' ()+-- @

@@ -26,7 +26,7 @@   checkImage ref'  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -34,3 +34,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.XBMImage"+-- @

@@ -26,7 +26,7 @@   checkImage ref'  -- $hierarchy---+-- @ -- "Graphics.UI.FLTK.LowLevel.Image" --  | --  v@@ -34,3 +34,4 @@ --  | --  v -- "Graphics.UI.FLTK.LowLevel.XPMImage"+-- @