diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -19,6 +19,7 @@ , greencardProgram, cpphsProgram, hsc2hsProgram, c2hsProgram , happyProgram, alexProgram, ghcProgram, gccProgram, requireProgram, arProgram) import Distribution.Simple.Program.Db +import Distribution.Simple.Configure(findDistPrefOrDefault) import Distribution.Simple.PreProcess import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) import qualified Distribution.Simple.Register as Register @@ -28,11 +29,9 @@ import qualified Distribution.Simple.Program.Ar as Ar import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.BuildPaths -import System.Directory(getCurrentDirectory, getDirectoryContents, withCurrentDirectory, doesDirectoryExist, makeAbsolute, doesFileExist) +import System.Directory(getCurrentDirectory, copyFile, createDirectoryIfMissing, listDirectory, withCurrentDirectory, doesDirectoryExist, makeAbsolute, doesFileExist) import System.FilePath ( (), (<.>), takeExtension, combine, takeBaseName, takeDirectory) import qualified Distribution.Simple.GHC as GHC -import qualified Distribution.Simple.JHC as JHC -import qualified Distribution.Simple.LHC as LHC import qualified Distribution.Simple.UHC as UHC import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.PackageDescription as PD @@ -46,15 +45,15 @@ -- cabal >=2.0.0.2 #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,0) -_FlagName = mkFlagName +_FlagName = mkFlagName #else -_FlagName = FlagName +_FlagName = FlagName #endif -- cabal >=2.0.1.1 #if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(2,0,1) -_registerPackage verbosity lbi packageDbs installedPkgInfo - = registerPackage verbosity (compiler lbi) (withPrograms lbi) packageDbs installedPkgInfo Register.defaultRegisterOptions +_registerPackage verbosity lbi packageDbs installedPkgInfo + = registerPackage verbosity (compiler lbi) (withPrograms lbi) packageDbs installedPkgInfo Register.defaultRegisterOptions #else _registerPackage verbosity lbi packageDbs installedPkgInfo = registerPackage verbosity (compiler lbi) (withPrograms lbi) False {- multiinstance -} packageDbs installedPkgInfo @@ -72,19 +71,22 @@ regHook = registerHook } -fltkSource = "fltk-1.3.4-1" +fltkSource = "fltk-master" +temporaryWorkaround = "temporary-workaround" -runMake :: [String] -> IO () -runMake args = - case buildOS of +runMake :: FilePath -> [String] -> IO () +runMake p args = + withCurrentDirectory p + (case buildOS of Windows -> rawSystemExit normal "make" args os | os `elem` [FreeBSD, OpenBSD, NetBSD, DragonFly] -> rawSystemExit normal "gmake" args - _ -> rawSystemExit normal "make" args + _ -> rawSystemExit normal "make" args) buildFltk :: IO FilePath -> Bool -> IO () buildFltk prefix openGL = do - rawSystemExit normal "tar" ["-zxf", fltkSource ++ "-source.tar.gz"] + rawSystemExit normal "rm" ["-rf", fltkSource] + rawSystemExit normal "unzip" [fltkSource ++ ".zip"] projectRoot <- getCurrentDirectory prefix' <- prefix let fltkDir = projectRoot fltkSource @@ -94,22 +96,24 @@ "--enable-localjpeg", "--enable-localzlib", "--enable-localpng", + "--enable-xft", ("--prefix=" ++ prefix') ] withCurrentDirectory fltkDir ( - let make = runMake [] >> runMake ["install"] + let make = runMake fltkDir [] >> runMake fltkDir ["install"] in case buildOS of Windows -> do + rawSystemExit normal "sh" ([(fltkDir "autogen.sh")] ++ fltkFlags) rawSystemExit normal "sh" ([(fltkDir "configure")] ++ fltkFlags) make - updateEnv "PATH" (windowsFriendlyPaths (prefix' "bin")) _ -> do + updateEnv "PATH" (projectRoot temporaryWorkaround) + rawSystemExit normal (fltkDir "autogen.sh") fltkFlags rawSystemExit normal (fltkDir "configure") fltkFlags make - updateEnv "PATH" (prefix' "bin") ) myPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo @@ -120,13 +124,12 @@ prefix <- bundlePrefix flags "" fltkBuilt <- doesDirectoryExist prefix if (not fltkBuilt) - then do - buildFltk (case buildOS of { Windows -> cygpath "-u" prefix; _ -> return prefix;}) (openGLSupport flags) - case buildOS of - Windows -> updateEnv "PATH" (windowsFriendlyPaths (prefix "bin")) - _ -> updateEnv "PATH" (prefix "bin") + then buildFltk (case buildOS of { Windows -> cygpath "-u" prefix; _ -> return prefix;}) (openGLSupport flags) else putStrLn "FLTK already built." - else return () + case buildOS of + Windows -> updateEnv "PATH" (windowsFriendlyPaths (prefix "bin")) + _ -> updateEnv "PATH" (prefix "bin") + else return () putStrLn "Running autoconf ..." case buildOS of Windows -> rawSystemExit normal "sh" ["autoconf"] @@ -141,12 +144,11 @@ myPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () myPostConf args flags pd lbi = do + (major, minor, patch) <- getFltkVersion let confFlags = if (openGLSupport flags) then (flags{ configConfigureArgs = (configConfigureArgs flags) ++ ["--enable-gl"]}) else flags - (major, minor, patch) <- getFltkVersion - apiVersion <- getApiVersion - let confFlagsWithVersion = + confFlagsWithVersion = confFlags { configConfigureArgs = (configConfigureArgs confFlags) ++ [ @@ -155,12 +157,18 @@ ("--with-fltk-patch-version=" ++ patch) ] } - postConf autoconfUserHooks args confFlagsWithVersion (addApiVersion pd apiVersion) lbi + baseDir lbi' = + case (cabalFilePath lbi') of + Nothing -> "" + Just p -> takeDirectory p + basedir = baseDir lbi + csrc = basedir "c-src" + distBuild <- fmap (\d -> d "build") (findDistPrefOrDefault (configDistPref flags)) + srcFiles <- listDirectory csrc + createDirectoryIfMissing False (distBuild "c-src") + mapM_ (\f -> copyFile (csrc f) (distBuild "c-src" f)) srcFiles + postConf autoconfUserHooks args confFlagsWithVersion pd lbi -fltkcdir :: FilePath -fltkcdir = unsafePerformIO $ do - d <- getCurrentDirectory - return (d "c-lib") fltkclib = "fltkc" getFltkVersion :: IO (String, String, String) @@ -178,20 +186,8 @@ in (major, minor, patch) flagIsSet :: PD.FlagName -> ConfigFlags -> Bool -flagIsSet flag configFlags = maybe False id (lookup flag (configConfigurationsFlags configFlags)) +flagIsSet flag configFlags = maybe False id (lookupFlagAssignment flag (configConfigurationsFlags configFlags)) -addFltkcDir :: PackageDescription -> PackageDescription -addFltkcDir pkg_descr = - pkg_descr { - library = fmap (\l' -> l' { - libBuildInfo = - (libBuildInfo l') { - extraLibDirs = (extraLibDirs (libBuildInfo l')) ++ [fltkcdir] - } - } - ) - (library pkg_descr) - } updateEnv :: String -> String -> IO () updateEnv env value = do @@ -259,20 +255,36 @@ in pkg_descr{ library = fixedLib } +getFltkcdir :: LocalBuildInfo -> FilePath +getFltkcdir lbi = (buildDir lbi) fltkclib + myBuildHook pkg_descr local_bld_info user_hooks bld_flags = do let confFlags = configFlags local_bld_info + addFltkcDir :: FilePath -> PackageDescription -> PackageDescription + addFltkcDir p pkg_descr = + pkg_descr { + library = fmap (\l' -> l' { + libBuildInfo = + (libBuildInfo l') { + extraLibDirs = (extraLibDirs (libBuildInfo l')) ++ [p] + } + } + ) + (library pkg_descr) + } if (bundledBuild confFlags) then bundlePrefix confFlags "bin" >>= case buildOS of Windows -> updateEnv "PATH" . windowsFriendlyPaths _ -> updateEnv "PATH" else return () - let compileC = putStrLn "==Compiling C bindings==" >> runMake [] + let compileC = putStrLn "==Compiling C bindings==" >> runMake (buildDir local_bld_info) [] + let fltkcdir = (buildDir local_bld_info) "c-lib" cdirexists <- doesDirectoryExist fltkcdir if cdirexists then do - clibraries <- getDirectoryContents fltkcdir + clibraries <- listDirectory fltkcdir when (null $ filter (Data.List.isInfixOf "fltkc") clibraries) compileC else compileC apiVersion <- getApiVersion @@ -294,10 +306,10 @@ ghcPath <- rawSystemStdout normal "sh" ["-c", "which ghc"] cppGccPthreadPaths <- mapM (cygpath "-w") (stdCppGccPthreadPaths ghcPath) bundledInclude <- if (bundledBuild confFlags) - then (bundlePrefix confFlags) "include" >>= \p -> return [p] + then fmap (\p -> [p]) ((bundlePrefix confFlags) "include") else return [] bundledLib <- if (bundledBuild confFlags) - then (bundlePrefix confFlags) "lib" >>= \p -> return [p] + then fmap (\p -> [p]) ((bundlePrefix confFlags) "lib") else return [] let fixedLib = maybe Nothing (\(ld, incDirs) -> @@ -305,7 +317,7 @@ libBuildInfo = (libBuildInfo l') { PD.ldOptions = fmap windowsFriendlyPaths ld, - includeDirs = fmap windowsFriendlyPaths (incDirs ++ bundledInclude), + includeDirs = fmap windowsFriendlyPaths (incDirs ++ bundledInclude ++ [(buildDir local_bld_info) "c-src"]), extraLibDirs = cppGccPthreadPaths ++ (extraLibDirs (libBuildInfo l')) ++ bundledLib, extraLibs = ["stdc++", "gcc", "pthread"] } @@ -315,14 +327,16 @@ ld_incdirs return (pkg_descr {library = fixedLib}) in do - fixedPkgDescr <- rewritePaths apiVersionAddedPkgDescription >>= return . addFltkcDir + fixedPkgDescr <- rewritePaths apiVersionAddedPkgDescription >>= return . (addFltkcDir fltkcdir) buildHook autoconfUserHooks fixedPkgDescr local_bld_info user_hooks bld_flags Linux -> do + updateEnv "C_INCLUDE_PATH" ((buildDir local_bld_info) "c-src") updateEnv "LIBRARY_PATH" fltkcdir buildHook autoconfUserHooks apiVersionAddedPkgDescription local_bld_info user_hooks bld_flags _ -> do + updateEnv "C_INCLUDE_PATH" ((buildDir local_bld_info) "c-src") updateEnv "DYLD_LIBRARY_PATH" fltkcdir - updateEnv "LIBRARY_PATH" fltkcdir + updateEnv "LIBRARY_PATH" fltkcdir buildHook autoconfUserHooks apiVersionAddedPkgDescription local_bld_info user_hooks bld_flags copyCBindingsAndBundledExecutables :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO () @@ -332,8 +346,9 @@ . fromFlag . copyDest $ flags libPref = libdir installDirs + let p = (buildDir lbi) "c-lib" rawSystemExit (fromFlag $ copyVerbosity flags) "cp" - [fltkcdir "libfltkc.a" , libPref] + [p "libfltkc.a" , libPref] case buildOS of OSX -> do updateEnv "DYLD_LIBRARY_PATH" (takeDirectory libPref) @@ -341,7 +356,7 @@ (fromFlag $ copyVerbosity flags) "cp" [ - "c-lib" "libfltkc-dyn.dylib" + p "libfltkc-dyn.dylib" , libPref ] _ -> do @@ -349,15 +364,13 @@ rawSystemExit (fromFlag $ copyVerbosity flags) "cp" [ - "c-lib" "libfltkc-dyn.so" + p "libfltkc-dyn.so" , libPref ] if (bundledBuild (configFlags lbi)) then do executableDir <- (bundlePrefix (configFlags lbi)) "bin" - projectRoot <- getCurrentDirectory let binPref = bindir installDirs - let fltkDir = projectRoot fltkSource fluidExists <- doesFileExist (binPref "fluid") fltkConfigExists <- doesFileExist (binPref "fltk-config") if (not fluidExists) diff --git a/c-src/Fl_BrowserC.cpp b/c-src/Fl_BrowserC.cpp --- a/c-src/Fl_BrowserC.cpp +++ b/c-src/Fl_BrowserC.cpp @@ -26,6 +26,9 @@ Fl_Browser::draw(); } } +void Fl_DerivedBrowser::draw_super(){ + Fl_Browser::draw(); +} void Fl_DerivedBrowser::draw_box(){ Fl_Browser::draw_box(); } @@ -60,6 +63,9 @@ } return i; } +int Fl_DerivedBrowser::handle_super(int event){ + return Fl_Browser::handle(event); +} void Fl_DerivedBrowser::resize_super(int x, int y, int w, int h){ Fl_Browser::resize(x,y,w,h); } @@ -334,6 +340,12 @@ FL_EXPORT_C(void,Fl_Browser_hide_super)(fl_Browser browser){ return (static_cast(browser))->Fl_Browser::hide(); } + FL_EXPORT_C(void,Fl_Browser_draw_super)(fl_Browser browser){ + (static_cast(browser))->draw_super(); + } + FL_EXPORT_C(int,Fl_Browser_handle_super)(fl_Browser browser, int e){ + return (static_cast(browser))->handle_super(e); + } FL_EXPORT_C(void,Fl_Browser_clear_visible)(fl_Browser browser){ (static_cast(browser))->clear_visible(); } @@ -686,6 +698,18 @@ } FL_EXPORT_C(void,Fl_Browser_sort_with_flags)(fl_Browser browser,int flags){ (static_cast(browser))->sort(flags); + } + FL_EXPORT_C(void, Fl_Browser_set_scrollbar_color)(fl_Browser browser,Fl_Color col){ + ((static_cast(browser))->hscrollbar).color(col); + ((static_cast(browser))->scrollbar).color(col); + } + FL_EXPORT_C(void, Fl_Browser_set_scrollbar_box)(fl_Browser browser,Fl_Boxtype box){ + ((static_cast(browser))->hscrollbar).box(box); + ((static_cast(browser))->scrollbar).box(box); + } + FL_EXPORT_C(void, Fl_Browser_set_scrollbar_selection_color)(fl_Browser browser,Fl_Color col){ + ((static_cast(browser))->hscrollbar).selection_color(col); + ((static_cast(browser))->scrollbar).selection_color(col); } #ifdef __cplusplus } diff --git a/c-src/Fl_BrowserC.h b/c-src/Fl_BrowserC.h --- a/c-src/Fl_BrowserC.h +++ b/c-src/Fl_BrowserC.h @@ -23,7 +23,9 @@ void draw_label(); void draw_label(int x,int y,int w,int h,Fl_Align alignment); virtual void draw(); + void draw_super(); virtual int handle(int event); + int handle_super(int event); void resize_super(int x, int y, int w, int h); virtual void resize(int x, int y, int w, int h); virtual void show(); @@ -216,26 +218,31 @@ FL_EXPORT_C_HEADER(int,Fl_Browser_select_only_with_docallbacks,(fl_Browser browser,void *item,int docallbacks)); FL_EXPORT_C_HEADER(int,Fl_Browser_deselect,(fl_Browser browser)); FL_EXPORT_C_HEADER(int,Fl_Browser_deselect_with_docallbacks,(fl_Browser browser,int docallbacks)); - FL_EXPORT_C(int, Fl_Browser_position)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_position)(fl_Browser browser,int pos); // scroll to here - FL_EXPORT_C(int, Fl_Browser_hposition)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_hposition)(fl_Browser browser,int); // pan to here + FL_EXPORT_C_HEADER(int, Fl_Browser_position,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_position,(fl_Browser browser,int pos)); // scroll to here + FL_EXPORT_C_HEADER(int, Fl_Browser_hposition,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_hposition,(fl_Browser browser,int)); // pan to here FL_EXPORT_C_HEADER(uchar,Fl_Browser_has_scrollbar,(fl_Browser browser)); - FL_EXPORT_C(void, Fl_Browser_set_has_scrollbar)(fl_Browser browser,uchar mode); - FL_EXPORT_C(Fl_Font, Fl_Browser_textfont)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_textfont)(fl_Browser browser,Fl_Font font); - FL_EXPORT_C(Fl_Fontsize, Fl_Browser_textsize)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_textsize)(fl_Browser browser,Fl_Fontsize newSize); - FL_EXPORT_C(Fl_Color, Fl_Browser_textcolor)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_textcolor)(fl_Browser browser,Fl_Color col); - FL_EXPORT_C(int, Fl_Browser_scrollbar_size)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_scrollbar_size)(fl_Browser browser,int newSize); - FL_EXPORT_C(int, Fl_Browser_scrollbar_width)(fl_Browser browser); - FL_EXPORT_C(void, Fl_Browser_set_scrollbar_width)(fl_Browser browser,int width); - FL_EXPORT_C(void, Fl_Browser_scrollbar_right)(fl_Browser browser); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_has_scrollbar,(fl_Browser browser,uchar mode)); + FL_EXPORT_C_HEADER(Fl_Font, Fl_Browser_textfont,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_textfont,(fl_Browser browser,Fl_Font font)); + FL_EXPORT_C_HEADER(Fl_Fontsize, Fl_Browser_textsize,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_textsize,(fl_Browser browser,Fl_Fontsize newSize)); + FL_EXPORT_C_HEADER(Fl_Color, Fl_Browser_textcolor,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_textcolor,(fl_Browser browser,Fl_Color col)); + FL_EXPORT_C_HEADER(int, Fl_Browser_scrollbar_size,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_scrollbar_size,(fl_Browser browser,int newSize)); + FL_EXPORT_C_HEADER(int, Fl_Browser_scrollbar_width,(fl_Browser browser)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_scrollbar_width,(fl_Browser browser,int width)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_scrollbar_color,(fl_Browser browser,Fl_Color col)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_scrollbar_box,(fl_Browser browser,Fl_Boxtype box)); + FL_EXPORT_C_HEADER(void, Fl_Browser_set_scrollbar_selection_color,(fl_Browser browser,Fl_Color col)); + FL_EXPORT_C_HEADER(void, Fl_Browser_scrollbar_right,(fl_Browser browser)); FL_EXPORT_C_HEADER(void,Fl_Browser_set_scrollbar_left,(fl_Browser browser)); FL_EXPORT_C_HEADER(void,Fl_Browser_sort,(fl_Browser browser)); FL_EXPORT_C_HEADER(void,Fl_Browser_sort_with_flags,(fl_Browser browser,int flags)); + FL_EXPORT_C_HEADER(void,Fl_Browser_draw_super,(fl_Browser browser)); + FL_EXPORT_C_HEADER(int,Fl_Browser_handle_super,(fl_Browser browser, int e)); #ifdef __cplusplus } #endif diff --git a/c-src/Fl_C.cpp b/c-src/Fl_C.cpp --- a/c-src/Fl_C.cpp +++ b/c-src/Fl_C.cpp @@ -649,6 +649,29 @@ } #endif +#if FL_API_VERSION >= 10400 + FL_EXPORT_C(void, Fl_insertion_point_location)( int x, int y, int height ){ + Fl::insertion_point_location( x, y, height ); + } + FL_EXPORT_C(void, Fl_reset_marked_text)( ){ + Fl::reset_marked_text( ); + } + FL_EXPORT_C(void, Fl_run_checks)( ){ + Fl::run_checks( ); + } + FL_EXPORT_C(void*, Fl_screen_driver)( ){ + return Fl::screen_driver( ); + } + FL_EXPORT_C(void*, Fl_system_driver)( ){ + return Fl::system_driver( ); + } + FL_EXPORT_C(void, Fl_set_program_should_quit)(int should_i) { + Fl::program_should_quit(should_i); + }; + FL_EXPORT_C(int, Fl_get_program_should_quit)(){ + return Fl::program_should_quit(); + }; +#endif #ifdef __cplusplus } #endif diff --git a/c-src/Fl_C.h b/c-src/Fl_C.h --- a/c-src/Fl_C.h +++ b/c-src/Fl_C.h @@ -3,8 +3,11 @@ #include #include "Fl_ExportMacros.h" #include "Fl_Types.h" -#include "Fl_EnumerationsC.h" #include "../config.h" +#include "Fl_EnumerationsC.h" +#if FL_API_VERSION >= 10400 +#include "FL/platform_types.h" +#endif #ifdef __cplusplus #include "FL/Fl.H" #include "Fl_EnumerationsC.h" @@ -41,17 +44,6 @@ OPTION_SHOW_TOOLTIPS, OPTION_LAST } Fl_Option; -#ifndef INTERNAL_LINKAGE -#if defined(WIN32) && !defined(__CYGWIN__) -# if defined(_WIN64) -# define FL_SOCKET unsigned __int64 -# else -# define FL_SOCKET int -# endif -#else -# define FL_SOCKET int -#endif -#endif #if !defined(__APPLE__) && HAVE_GL FL_EXPORT_C_HEADER(int,Fl_gl_visual,(int mode)); FL_EXPORT_C_HEADER(int,Fl_gl_visual_with_alist,(int mode, int *alist)); @@ -275,6 +267,15 @@ FL_EXPORT_C_HEADER(const char* ,Fl_local_shift,()); FL_EXPORT_C_HEADER(void ,Fl_set_use_high_res_GL,(int val)); FL_EXPORT_C_HEADER(int ,Fl_use_high_res_GL,()); +#endif +#if FL_API_VERSION >= 10400 + FL_EXPORT_C_HEADER(void, Fl_insertion_point_location, ( int x, int y, int height )); + FL_EXPORT_C_HEADER(void, Fl_reset_marked_text,()); + FL_EXPORT_C_HEADER(void, Fl_run_checks,()); + FL_EXPORT_C_HEADER(void*, Fl_screen_driver,()); + FL_EXPORT_C_HEADER(void*, Fl_system_driver,()); + FL_EXPORT_C_HEADER(void, Fl_set_program_should_quit, (int should_i)); + FL_EXPORT_C_HEADER(int, Fl_get_program_should_quit, ()); #endif #ifdef __cplusplus } diff --git a/c-src/Fl_ClockC.cpp b/c-src/Fl_ClockC.cpp --- a/c-src/Fl_ClockC.cpp +++ b/c-src/Fl_ClockC.cpp @@ -410,6 +410,12 @@ Fl_DerivedClock* w = new Fl_DerivedClock(X,Y,W,H,label,fs); return (fl_Clock)w; } + FL_EXPORT_C(void,Fl_Clock_set_shadow)(fl_Clock o, int shadow){ + (static_cast(o)->shadow(shadow)); + } + FL_EXPORT_C(int, Fl_Clock_get_shadow)(fl_Clock o) { + return (static_cast(o)->shadow()); + } #ifdef __cplusplus } #endif diff --git a/c-src/Fl_ClockC.h b/c-src/Fl_ClockC.h --- a/c-src/Fl_ClockC.h +++ b/c-src/Fl_ClockC.h @@ -138,7 +138,8 @@ FL_EXPORT_C_HEADER(void,Fl_Clock_show_super,(fl_Clock o)); FL_EXPORT_C_HEADER(void,Fl_Clock_hide,(fl_Clock o)); FL_EXPORT_C_HEADER(void,Fl_Clock_hide_super,(fl_Clock o)); - + FL_EXPORT_C_HEADER(void,Fl_Clock_set_shadow,(fl_Clock o, int shadow)); + FL_EXPORT_C_HEADER(int,Fl_Clock_get_shadow,(fl_Clock o)); #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Color_ChooserC.cpp b/c-src/Fl_Color_ChooserC.cpp --- a/c-src/Fl_Color_ChooserC.cpp +++ b/c-src/Fl_Color_ChooserC.cpp @@ -1,12 +1,14 @@ #include "Fl_Color_ChooserC.h" #ifdef __cplusplus EXPORT { - Fl_DerivedColor_Chooser::Fl_DerivedColor_Chooser(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs) : Fl_Color_Chooser(X,Y,W,H,l){ + Fl_DerivedColor_Chooser::Fl_DerivedColor_Chooser(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs, fl_Color_Chooser_Virtual_Funcs* cfs) : Fl_Color_Chooser(X,Y,W,H,l){ overriddenFuncs = funcs; + cOverriddenFuncs = cfs; other_data = (void*)0; } - Fl_DerivedColor_Chooser::Fl_DerivedColor_Chooser(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs):Fl_Color_Chooser(X,Y,W,H){ + Fl_DerivedColor_Chooser::Fl_DerivedColor_Chooser(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs, fl_Color_Chooser_Virtual_Funcs* cfs):Fl_Color_Chooser(X,Y,W,H){ overriddenFuncs = funcs; + cOverriddenFuncs = cfs; other_data = (void*)0; } Fl_DerivedColor_Chooser::~Fl_DerivedColor_Chooser(){ @@ -75,6 +77,86 @@ Fl_Color_Chooser::hide(); } + int Fl_DerivedColor_Chooser::mode() { + if (this->cOverriddenFuncs && this->cOverriddenFuncs->get_mode) { + return this->cOverriddenFuncs->get_mode((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::mode(); + } + }; + void Fl_DerivedColor_Chooser::mode(int newMode){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->set_mode) { + this->cOverriddenFuncs->set_mode((fl_Color_Chooser) this, newMode); + } + else { + Fl_Color_Chooser::mode(newMode); + } + } + double Fl_DerivedColor_Chooser::hue(){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->hue) { + return this->cOverriddenFuncs->hue((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::hue(); + } + }; + double Fl_DerivedColor_Chooser::saturation(){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->saturation) { + return this->cOverriddenFuncs->saturation((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::saturation(); + } + }; + double Fl_DerivedColor_Chooser::value(){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->value) { + return this->cOverriddenFuncs->value((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::value(); + } + }; + double Fl_DerivedColor_Chooser::r(){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->r) { + return this->cOverriddenFuncs->r((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::r(); + } + } + double Fl_DerivedColor_Chooser::g(){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->g) { + return this->cOverriddenFuncs->g((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::g(); + } + }; + double Fl_DerivedColor_Chooser::b(){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->b) { + return this->cOverriddenFuncs->b((fl_Color_Chooser) this); + } + else { + return Fl_Color_Chooser::b(); + } + }; + int Fl_DerivedColor_Chooser::hsv(double H, double S, double V){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->hsv) { + return this->cOverriddenFuncs->hsv((fl_Color_Chooser) this, H, S, V); + } + else { + return Fl_Color_Chooser::hsv(H,S,V); + } + }; + int Fl_DerivedColor_Chooser::rgb(double R, double G, double B){ + if (this->cOverriddenFuncs && this->cOverriddenFuncs->rgb) { + return this->cOverriddenFuncs->rgb((fl_Color_Chooser) this, R, G, B); + } + else { + return Fl_Color_Chooser::rgb(R,G,B); + } + }; #endif FL_EXPORT_C(int,Fl_Color_Chooser_handle)(fl_Color_Chooser color_chooser, int event){ @@ -402,20 +484,20 @@ } FL_EXPORT_C(fl_Color_Chooser, Fl_Color_Chooser_New)(int X, int Y, int W, int H){ fl_Widget_Virtual_Funcs* fs = Fl_Widget_default_virtual_funcs(); - Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,fs); + Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,fs,0); return (fl_Color_Chooser)w; } FL_EXPORT_C(fl_Color_Chooser, Fl_Color_Chooser_New_WithLabel)(int X, int Y, int W, int H, const char* label){ fl_Widget_Virtual_Funcs* fs = Fl_Widget_default_virtual_funcs(); - Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,label,fs); + Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,label,fs,0); return (fl_Color_Chooser)w; } - FL_EXPORT_C(fl_Color_Chooser, Fl_OverriddenColor_Chooser_New)(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs){ - Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,fs); + FL_EXPORT_C(fl_Color_Chooser, Fl_OverriddenColor_Chooser_New)(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs, fl_Color_Chooser_Virtual_Funcs* cfs){ + Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,fs,cfs); return (fl_Color_Chooser)w; } - FL_EXPORT_C(fl_Color_Chooser, Fl_OverriddenColor_Chooser_New_WithLabel)(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs){ - Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,label,fs); + FL_EXPORT_C(fl_Color_Chooser, Fl_OverriddenColor_Chooser_New_WithLabel)(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs, fl_Color_Chooser_Virtual_Funcs* cfs){ + Fl_DerivedColor_Chooser* w = new Fl_DerivedColor_Chooser(X,Y,W,H,label,fs,cfs); return (fl_Color_Chooser)w; } diff --git a/c-src/Fl_Color_ChooserC.h b/c-src/Fl_Color_ChooserC.h --- a/c-src/Fl_Color_ChooserC.h +++ b/c-src/Fl_Color_ChooserC.h @@ -11,8 +11,20 @@ EXPORT { class Fl_DerivedColor_Chooser : public Fl_Color_Chooser { fl_Widget_Virtual_Funcs* overriddenFuncs; + fl_Color_Chooser_Virtual_Funcs* cOverriddenFuncs; void* other_data; public: + int mode(); + void mode(int newMode); + double hue(); + double saturation(); + double value(); + double r(); + double g(); + double b(); + int hsv(double H, double S, double V); + int rgb(double R, double G, double B); + virtual void draw(); void draw_super(); virtual int handle(int event); @@ -23,8 +35,8 @@ void show_super(); virtual void hide(); void hide_super(); - Fl_DerivedColor_Chooser(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs); - Fl_DerivedColor_Chooser(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs); + Fl_DerivedColor_Chooser(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs, fl_Color_Chooser_Virtual_Funcs* cfs); + Fl_DerivedColor_Chooser(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs, fl_Color_Chooser_Virtual_Funcs* cfs); ~Fl_DerivedColor_Chooser(); }; #endif @@ -160,8 +172,8 @@ FL_EXPORT_C_HEADER(int,flc_color_chooser,(const char* name, double* r, double* g, double* b)); FL_EXPORT_C_HEADER(fl_Color_Chooser,Fl_Color_Chooser_New,(int X, int Y, int W, int H)); FL_EXPORT_C_HEADER(fl_Color_Chooser,Fl_Color_Chooser_New_WithLabel,(int X, int Y, int W, int H, const char* label)); - FL_EXPORT_C_HEADER(fl_Color_Chooser,Fl_OverriddenColor_Chooser_New,(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs)); - FL_EXPORT_C_HEADER(fl_Color_Chooser,Fl_OverriddenColor_Chooser_New_WithLabel,(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs)); + FL_EXPORT_C_HEADER(fl_Color_Chooser,Fl_OverriddenColor_Chooser_New,(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs, fl_Color_Chooser_Virtual_Funcs* cfs)); + FL_EXPORT_C_HEADER(fl_Color_Chooser,Fl_OverriddenColor_Chooser_New_WithLabel,(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs, fl_Color_Chooser_Virtual_Funcs* cfs)); FL_EXPORT_C_HEADER(int,flc_color_chooser_with_m,(const char* name, double* r, double* g, double* b, int m)); FL_EXPORT_C_HEADER(int,flc_color_chooser_with_uchar,(const char* name, uchar* r, uchar* g, uchar* b)); diff --git a/c-src/Fl_Copy_SurfaceC.cpp b/c-src/Fl_Copy_SurfaceC.cpp --- a/c-src/Fl_Copy_SurfaceC.cpp +++ b/c-src/Fl_Copy_SurfaceC.cpp @@ -2,9 +2,6 @@ #ifdef __cplusplus EXPORT { #endif - FL_EXPORT_C(const char*,Fl_Copy_Surface_class_name)(fl_Copy_Surface copy_surface){ - return (static_cast(copy_surface))->class_name(); - } FL_EXPORT_C(void,Fl_Copy_Surface_set_current)(fl_Copy_Surface copy_surface){ (static_cast(copy_surface))->set_current(); } diff --git a/c-src/Fl_Copy_SurfaceC.h b/c-src/Fl_Copy_SurfaceC.h --- a/c-src/Fl_Copy_SurfaceC.h +++ b/c-src/Fl_Copy_SurfaceC.h @@ -10,7 +10,6 @@ #include "FL/Fl_Copy_Surface.H" EXPORT { #endif - FL_EXPORT_C_HEADER(const char* ,Fl_Copy_Surface_class_name,(fl_Copy_Surface copy_surface)); FL_EXPORT_C_HEADER(void ,Fl_Copy_Surface_set_current,(fl_Copy_Surface copy_surface)); FL_EXPORT_C_HEADER(void ,Fl_Copy_Surface_draw,(fl_Copy_Surface copy_surface, fl_Widget widget, int delta_x, int delta_y)); FL_EXPORT_C_HEADER(fl_Copy_Surface,Fl_Copy_Surface_New,(int w, int h)); diff --git a/c-src/Fl_CounterC.cpp b/c-src/Fl_CounterC.cpp --- a/c-src/Fl_CounterC.cpp +++ b/c-src/Fl_CounterC.cpp @@ -75,7 +75,6 @@ Fl_Counter::hide(); } - #endif FL_EXPORT_C(fl_Group,Fl_Counter_parent)(fl_Counter counter){ return (static_cast(counter))->parent(); diff --git a/c-src/Fl_CounterC.h b/c-src/Fl_CounterC.h --- a/c-src/Fl_CounterC.h +++ b/c-src/Fl_CounterC.h @@ -16,6 +16,7 @@ public: virtual void draw(); void draw_super(); + uchar get_mouseobj(); virtual int handle(int event); int handle_super(int event); virtual void resize(int x, int y, int w, int h); diff --git a/c-src/Fl_DeviceC.cpp b/c-src/Fl_DeviceC.cpp --- a/c-src/Fl_DeviceC.cpp +++ b/c-src/Fl_DeviceC.cpp @@ -2,12 +2,6 @@ #ifdef __cplusplus EXPORT { #endif -FL_EXPORT_C(const char*,Fl_Graphics_Driver_class_id)( ){ - return Fl_Graphics_Driver::class_id; -} -FL_EXPORT_C(const char*,Fl_Graphics_Driver_class_name)(fl_Graphics_Driver graphics_driver){ - return (static_cast(graphics_driver))->class_name(); -} FL_EXPORT_C(void,Fl_Graphics_Driver_set_font)(fl_Graphics_Driver graphics_driver,Fl_Font face,Fl_Fontsize fsize){ return (static_cast(graphics_driver))->font(face,fsize); } @@ -51,12 +45,6 @@ #endif FL_EXPORT_C(void,Fl_Graphics_Driver_Destroy)(fl_Graphics_Driver graphics_driver){ delete (static_cast(graphics_driver)); -} -FL_EXPORT_C(const char*,Fl_Surface_Device_class_id)( ){ - return Fl_Surface_Device::class_id; -} -FL_EXPORT_C(const char*,Fl_Surface_Device_class_name)(fl_Surface_Device surface_device){ - return (static_cast(surface_device))->class_name(); } FL_EXPORT_C(void,Fl_Surface_Device_set_current)(fl_Surface_Device surface_device){ return (static_cast(surface_device))->set_current(); diff --git a/c-src/Fl_DeviceC.h b/c-src/Fl_DeviceC.h --- a/c-src/Fl_DeviceC.h +++ b/c-src/Fl_DeviceC.h @@ -10,10 +10,6 @@ EXPORT { #endif //Fl_Graphics_Driver - FL_EXPORT_C_HEADER(const char*,Fl_Graphics_Driver_class_id,()); - FL_EXPORT_C_HEADER(const char*,Fl_Graphics_Driver_class_name,(fl_Graphics_Driver graphics_driver)); - FL_EXPORT_C_HEADER(const char*,Fl_Graphics_Driver_class_id,()); - FL_EXPORT_C_HEADER(const char*,Fl_Graphics_Driver_class_name,(fl_Graphics_Driver graphics_driver)); FL_EXPORT_C_HEADER(void,Fl_Graphics_Driver_set_font,(fl_Graphics_Driver graphics_driver,Fl_Font face, Fl_Fontsize fsize)); FL_EXPORT_C_HEADER(Fl_Font,Fl_Graphics_Driver_font,(fl_Graphics_Driver graphics_driver)); FL_EXPORT_C_HEADER(Fl_Fontsize,Fl_Graphics_Driver_size,(fl_Graphics_Driver graphics_driver)); @@ -31,10 +27,6 @@ FL_EXPORT_C_HEADER(void,Fl_Graphics_Driver_Destroy,(fl_Graphics_Driver graphics_driver)); // Fl_Surface_Device - FL_EXPORT_C_HEADER(const char*,Fl_Surface_Device_class_id,()); - FL_EXPORT_C_HEADER(const char*,Fl_Surface_Device_class_name,(fl_Surface_Device surface_device)); - FL_EXPORT_C_HEADER(const char*,Fl_Surface_Device_class_id,()); - FL_EXPORT_C_HEADER(const char*,Fl_Surface_Device_class_name,(fl_Surface_Device surface_device)); FL_EXPORT_C_HEADER(void,Fl_Surface_Device_set_current,(fl_Surface_Device surface_device)); FL_EXPORT_C_HEADER(void,Fl_Surface_Device_set_driver,(fl_Surface_Device surface_device,fl_Graphics_Driver graphics_driver)); FL_EXPORT_C_HEADER(fl_Graphics_Driver,Fl_Surface_Device_driver,(fl_Surface_Device surface_device)); diff --git a/c-src/Fl_DrawC.cpp b/c-src/Fl_DrawC.cpp --- a/c-src/Fl_DrawC.cpp +++ b/c-src/Fl_DrawC.cpp @@ -27,6 +27,10 @@ return fl_not_clipped(x,y,w,h); } FL_EXPORT_C(int,flc_clip_box)(int x,int y,int w,int h,int* X,int* Y,int* W,int* H){ + *X = 0; + *Y = 0; + *W = 0; + *H = 0; return fl_clip_box(x,y,w,h,*X,*Y,*W,*H); } FL_EXPORT_C(void,flc_restore_clip)( ){ @@ -219,9 +223,17 @@ return fl_width(c); } FL_EXPORT_C(void,flc_text_extents)(const char* t,int* dx,int* dy,int* w,int* h){ + *dx = 0; + *dy = 0; + *w = 0; + *h = 0; fl_text_extents(t,*dx,*dy,*w,*h); } FL_EXPORT_C(void,flc_text_extents_with_n)(const char *t,int n,int* dx,int* dy,int* w,int* h){ + *dx = 0; + *dy = 0; + *w = 0; + *h = 0; fl_text_extents(t,n,*dx,*dy,*w,*h); } FL_EXPORT_C(const char*,flc_latin1_to_local)(const char *t){ @@ -264,9 +276,13 @@ fl_rtl_draw(str,n,x,y); } FL_EXPORT_C(void,flc_measure)(const char* str,int* x,int* y){ + *x = 0; + *y = 0; fl_measure(str,*x,*y); } FL_EXPORT_C(void,flc_measure_with_draw_symbols)(const char* str,int* x,int* y,int draw_symbols){ + *x = 0; + *y = 0; fl_measure(str,*x,*y,draw_symbols); } FL_EXPORT_C(void,flc_draw_with_img_draw_symbols)(const char* str,int x,int y,int w,int h,Fl_Align align,fl_Image img,int draw_symbols){ @@ -360,10 +376,14 @@ return fl_draw_pixmap(cdata,x,y); } FL_EXPORT_C(int,flc_measure_pixmap)(char* const* data,int *w,int *h){ + *w = 0; + *h = 0; return fl_measure_pixmap(data,*w,*h); } FL_EXPORT_C(int,flc_measure_pixmap_with_cdata)(const char* const* cdata,int *w,int *h){ + *w = 0; + *h = 0; return fl_measure_pixmap(cdata,*w,*h); } FL_EXPORT_C(void,flc_scroll)(int X, int Y, int W, int H, int dx, int dy, void (*draw_area)(void*, int,int,int,int), void* data){ @@ -397,9 +417,13 @@ fl_cursor(cursor); } FL_EXPORT_C(const char*,flc_expand_text_with_draw_symbols)(const char* from,char* buf,int maxbuf,double maxw,int* n,double *width,int wrap,int draw_symbols){ + *n = 0; + *width = 0; return fl_expand_text(from,buf,maxbuf,maxw,*n,*width,wrap,draw_symbols); } FL_EXPORT_C(const char*,flc_expand_text)(const char* from,char* buf,int maxbuf,double maxw,int* n,double *width,int wrap){ + *n = 0; + *width = 0; return fl_expand_text(from,buf,maxbuf,maxw,*n,*width,wrap); } FL_EXPORT_C(void,flc_set_status)(int X,int Y,int W,int H){ @@ -420,6 +444,32 @@ FL_EXPORT_C(int,flc_add_symbol)(const char* name, void (*drawit)(Fl_Color), int scalable){ return fl_add_symbol(name, drawit, scalable); } +#if FL_API_VERSION >= 10400 + FL_EXPORT_C(Fl_Offscreen ,flc_create_offscreen)(int w, int h){ + return fl_create_offscreen(w,h); + } + FL_EXPORT_C(void ,flc_begin_offscreen)(Fl_Offscreen ctx){ + fl_begin_offscreen(ctx); + } + FL_EXPORT_C(void ,flc_end_offscreen)(){ + fl_end_offscreen(); + } + FL_EXPORT_C(void ,flc_delete_offscreen)(Fl_Offscreen ctx){ + fl_delete_offscreen(ctx); + } + FL_EXPORT_C(char,flc_get_draw_shortcut)(){ + return fl_draw_shortcut; + }; + FL_EXPORT_C(void,flc_set_draw_shortcut)(char c){ + fl_draw_shortcut = c; + }; + FL_EXPORT_C(void ,flc_rescale_offscreen)(Fl_Offscreen* ctx){ + fl_rescale_offscreen(*ctx); + }; + FL_EXPORT_C(void ,flc_copy_offscreen)(int x, int y, int w, int h, Fl_Offscreen pixmap, int srcx, int srcy){ + fl_copy_offscreen(x,y,w,h,pixmap,srcx,srcy); + }; +#endif #ifdef __cplusplus } #endif diff --git a/c-src/Fl_DrawC.h b/c-src/Fl_DrawC.h --- a/c-src/Fl_DrawC.h +++ b/c-src/Fl_DrawC.h @@ -168,6 +168,16 @@ FL_EXPORT_C_HEADER(void ,flc_reset_spot,()); FL_EXPORT_C_HEADER(int ,flc_draw_symbol,(const char* label,int x,int y,int w,int h, Fl_Color color)); FL_EXPORT_C_HEADER(int ,flc_add_symbol,(const char* name, void (*drawit)(Fl_Color), int scalable)); + FL_EXPORT_C_HEADER(char ,flc_get_draw_shortcut,()); + FL_EXPORT_C_HEADER(void ,flc_set_draw_shortcut,(char c)); +#if FL_API_VERSION >= 10400 + FL_EXPORT_C_HEADER(Fl_Offscreen ,flc_create_offscreen,(int w, int h)); + FL_EXPORT_C_HEADER(void ,flc_begin_offscreen,(Fl_Offscreen ctx)); + FL_EXPORT_C_HEADER(void ,flc_end_offscreen,()); + FL_EXPORT_C_HEADER(void ,flc_delete_offscreen,(Fl_Offscreen ctx)); + FL_EXPORT_C_HEADER(void ,flc_rescale_offscreen,(Fl_Offscreen* ctx)); + FL_EXPORT_C_HEADER(void ,flc_copy_offscreen,(int x, int y, int w, int h, Fl_Offscreen pixmap, int srcx, int srcy)); +#endif #ifdef __cplusplus } #endif diff --git a/c-src/Fl_EnumerationsC.cpp b/c-src/Fl_EnumerationsC.cpp --- a/c-src/Fl_EnumerationsC.cpp +++ b/c-src/Fl_EnumerationsC.cpp @@ -20,6 +20,9 @@ FL_EXPORT_C(Fl_Labeltype, fl_define_FL_SHADOW_LABELC)() { return fl_define_FL_SHADOW_LABEL();} FL_EXPORT_C(Fl_Labeltype, fl_define_FL_ENGRAVED_LABELC)() { return fl_define_FL_ENGRAVED_LABEL();} FL_EXPORT_C(Fl_Labeltype, fl_define_FL_EMBOSSED_LABELC)() { return fl_define_FL_EMBOSSED_LABEL();} + FL_EXPORT_C(Fl_Labeltype, fl_define_FL_ICON_LABELC)() { return fl_define_FL_ICON_LABEL();} + FL_EXPORT_C(Fl_Labeltype, fl_define_FL_MULTI_LABELC)() { return fl_define_FL_MULTI_LABEL();} + FL_EXPORT_C(Fl_Labeltype, fl_define_FL_IMAGE_LABELC)() { return fl_define_FL_IMAGE_LABEL();} FL_EXPORT_C(Fl_Align, FL_ALIGN_TOP_LEFTC)(){ return FL_ALIGN_TOP | FL_ALIGN_LEFT;} FL_EXPORT_C(Fl_Align, FL_ALIGN_TOP_RIGHTC)(){ return FL_ALIGN_TOP | FL_ALIGN_RIGHT;} FL_EXPORT_C(Fl_Align, FL_ALIGN_BOTTOM_LEFTC)(){ return FL_ALIGN_BOTTOM | FL_ALIGN_LEFT;} diff --git a/c-src/Fl_EnumerationsC.h b/c-src/Fl_EnumerationsC.h --- a/c-src/Fl_EnumerationsC.h +++ b/c-src/Fl_EnumerationsC.h @@ -12,8 +12,8 @@ #define FL_MAJOR_VERSION FLTK_MAJOR_VERSION #define FL_MINOR_VERSION FLTK_MINOR_VERSION #define FL_PATCH_VERSION FLTK_PATCH_VERSION -#define FL_VERSION ((double)FL_MAJOR_VERSION + \ - (double)FL_MINOR_VERSION * 0.01 + \ +#define FL_VERSION ((double)FL_MAJOR_VERSION + \ + (double)FL_MINOR_VERSION * 0.01 + \ (double)FL_PATCH_VERSION * 0.0001) #define FL_API_VERSION (FL_MAJOR_VERSION*10000 + FL_MINOR_VERSION*100 + FL_PATCH_VERSION) #ifndef FL_ABI_VERSION @@ -46,7 +46,8 @@ FL_DND_LEAVE = 22, FL_DND_RELEASE = 23, FL_SCREEN_CONFIGURATION_CHANGED = 24, - FL_FULLSCREEN = 25 + FL_FULLSCREEN = 25, + FL_ZOOM_GESTURE = 26 } Fl_Event; typedef enum Fl_When { @@ -75,7 +76,6 @@ FL_TREE_SELECT_MULTI=2, FL_TREE_SELECT_SINGLE_DRAGGABLE=3 }Fl_Tree_Select; -#if FLTK_ABI_VERSION >= 10302 typedef enum Fl_Tree_Item_Reselect_Mode{ FL_TREE_SELECTABLE_ONCE=0, FL_TREE_SELECTABLE_ALWAYS, @@ -85,7 +85,6 @@ FL_TREE_ITEM_DRAW_LABEL_AND_WIDGET=1, FL_TREE_ITEM_HEIGHT_FROM_WIDGET=2 }Fl_Tree_Item_Draw_Mode; -#endif /*FLTK_ABI_VERSION*/ #define FL_Button 0xfee8 #define FL_Clear 0xff0b #define FL_BackSpace 0xff08 @@ -273,23 +272,25 @@ #define FL_FRAME_BOX FL_ENGRAVED_BOX #define FL_CIRCLE_BOX FL_ROUND_DOWN_BOX #define FL_DIAMOND_BOX FL_DIAMOND_DOWN_BOX - typedef enum Fl_Labeltype { - FL_NORMAL_LABEL = 0, - FL_NO_LABEL, - _FL_SHADOW_LABEL, - _FL_ENGRAVED_LABEL, - _FL_EMBOSSED_LABEL, - _FL_MULTI_LABEL, - _FL_ICON_LABEL, - _FL_IMAGE_LABEL, - - FL_FREE_LABELTYPE - } Fl_Labeltype; +typedef enum Fl_Labeltype { + FL_NORMAL_LABEL = 0, + FL_NO_LABEL, + _FL_SHADOW_LABEL, + _FL_ENGRAVED_LABEL, + _FL_EMBOSSED_LABEL, + _FL_MULTI_LABEL, + _FL_ICON_LABEL, + _FL_IMAGE_LABEL, + FL_FREE_LABELTYPE +} Fl_Labeltype; #define FL_SYMBOL_LABEL FL_NORMAL_LABEL #define FL_SHADOW_LABEL fl_define_FL_SHADOW_LABELC() #define FL_ENGRAVED_LABEL fl_define_FL_ENGRAVED_LABELC() #define FL_EMBOSSED_LABEL fl_define_FL_EMBOSSED_LABELC() +#define FL_ICON_LABEL fl_define_FL_ICON_LABELC() +#define FL_IMAGE_LABEL fl_define_FL_IMAGE_LABELC() +#define FL_MULTI_LABEL fl_define_FL_MULTI_LABELC() typedef unsigned Fl_Align; Fl_Align FL_ALIGN_CENTER = (Fl_Align)0; @@ -457,12 +458,15 @@ FL_EXPORT_C_HEADER(Fl_Boxtype,fl_define_FL_PLASTIC_UP_BOXC,()); FL_EXPORT_C_HEADER(Fl_Boxtype,fl_define_FL_GTK_UP_BOXC,()); FL_EXPORT_C_HEADER(Fl_Boxtype,fl_define_FL_GLEAM_UP_BOXC,()); - FL_EXPORT_C_HEADER(Fl_Boxtype,fl_boxC,(Fl_Boxtype b) ); - FL_EXPORT_C_HEADER(Fl_Boxtype,fl_downC,(Fl_Boxtype b) ); - FL_EXPORT_C_HEADER(Fl_Boxtype,fl_frameC,(Fl_Boxtype b) ); - FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_SHADOW_LABELC,() ); - FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_ENGRAVED_LABELC,() ); - FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_EMBOSSED_LABELC,() ); + FL_EXPORT_C_HEADER(Fl_Boxtype,fl_boxC,(Fl_Boxtype b)); + FL_EXPORT_C_HEADER(Fl_Boxtype,fl_downC,(Fl_Boxtype b)); + FL_EXPORT_C_HEADER(Fl_Boxtype,fl_frameC,(Fl_Boxtype b)); + FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_SHADOW_LABELC,()); + FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_ENGRAVED_LABELC,()); + FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_EMBOSSED_LABELC,()); + FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_ICON_LABELC,()); + FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_IMAGE_LABELC,()); + FL_EXPORT_C_HEADER(Fl_Labeltype,fl_define_FL_MULTI_LABELC,()); FL_EXPORT_C_HEADER(Fl_Align,FL_ALIGN_TOP_LEFTC,()); FL_EXPORT_C_HEADER(Fl_Align,FL_ALIGN_TOP_RIGHTC,()); FL_EXPORT_C_HEADER(Fl_Align,FL_ALIGN_BOTTOM_LEFTC,()); diff --git a/c-src/Fl_Gl_WindowC.cpp b/c-src/Fl_Gl_WindowC.cpp --- a/c-src/Fl_Gl_WindowC.cpp +++ b/c-src/Fl_Gl_WindowC.cpp @@ -807,13 +807,13 @@ FL_EXPORT_C(int,Fl_Gl_Window_set_mode)(fl_Gl_Window win,int a){ return (static_cast(win))->mode(a); } - FL_EXPORT_C(void*,Fl_Gl_Window_context)(fl_Gl_Window win){ + FL_EXPORT_C(GLContext,Fl_Gl_Window_context)(fl_Gl_Window win){ return (static_cast(win))->context(); } - FL_EXPORT_C(void,Fl_Gl_Window_set_context)(fl_Gl_Window win,void* context){ + FL_EXPORT_C(void,Fl_Gl_Window_set_context)(fl_Gl_Window win,GLContext context){ (static_cast(win))->context(context); } - FL_EXPORT_C(void,Fl_Gl_Window_set_context_with_destroy_flag)(fl_Gl_Window win,void* context, int flag){ + FL_EXPORT_C(void,Fl_Gl_Window_set_context_with_destroy_flag)(fl_Gl_Window win,GLContext context, int flag){ (static_cast(win))->context(context, flag); } FL_EXPORT_C(void,Fl_Gl_Window_swap_buffers)(fl_Gl_Window win){ diff --git a/c-src/Fl_Gl_WindowC.h b/c-src/Fl_Gl_WindowC.h --- a/c-src/Fl_Gl_WindowC.h +++ b/c-src/Fl_Gl_WindowC.h @@ -9,6 +9,7 @@ // Fl_Widget is included transitively and needed for // the callback mechanism included below to work. #include "Fl_CallbackC.h" +#include "FL/platform_types.h" EXPORT { #endif /* Inherited from Fl_Widget */ @@ -253,9 +254,9 @@ FL_EXPORT_C_HEADER(int,Fl_Gl_Window_can_do,(fl_Gl_Window win)); FL_EXPORT_C_HEADER(Fl_Mode,Fl_Gl_Window_mode,(fl_Gl_Window win)); FL_EXPORT_C_HEADER(int,Fl_Gl_Window_set_mode,(fl_Gl_Window win,int a)); - FL_EXPORT_C_HEADER(void*,Fl_Gl_Window_context,(fl_Gl_Window win)); - FL_EXPORT_C_HEADER(void,Fl_Gl_Window_set_context,(fl_Gl_Window win,void* context)); - FL_EXPORT_C_HEADER(void,Fl_Gl_Window_set_context_with_destroy_flag,(fl_Gl_Window win,void* context, int destroy_flag)); + FL_EXPORT_C_HEADER(GLContext ,Fl_Gl_Window_context,(fl_Gl_Window win)); + FL_EXPORT_C_HEADER(void,Fl_Gl_Window_set_context,(fl_Gl_Window win,GLContext context)); + FL_EXPORT_C_HEADER(void,Fl_Gl_Window_set_context_with_destroy_flag,(fl_Gl_Window win,GLContext context, int destroy_flag)); FL_EXPORT_C_HEADER(void,Fl_Gl_Window_swap_buffers,(fl_Gl_Window win)); FL_EXPORT_C_HEADER(void,Fl_Gl_Window_ortho,(fl_Gl_Window win)); FL_EXPORT_C_HEADER(int,Fl_Gl_Window_can_do_overlay,(fl_Gl_Window win)); diff --git a/c-src/Fl_ImageC.cpp b/c-src/Fl_ImageC.cpp --- a/c-src/Fl_ImageC.cpp +++ b/c-src/Fl_ImageC.cpp @@ -151,6 +151,15 @@ FL_EXPORT_C(int, Fl_Image_fail)(fl_Image image){ return (static_cast(image))->fail(); } + FL_EXPORT_C(void,Fl_Image_scale)(fl_Image image, int w, int h, int proportional, int can_expand){ + (static_cast(image))->scale(w,h,proportional,can_expand); + }; + FL_EXPORT_C(int,Fl_Image_data_w)(fl_Image image){ + return (static_cast(image))->data_w(); + }; + FL_EXPORT_C(int,Fl_Image_data_h)(fl_Image image){ + return (static_cast(image))->data_h(); + }; #endif #ifdef __cplusplus diff --git a/c-src/Fl_ImageC.h b/c-src/Fl_ImageC.h --- a/c-src/Fl_ImageC.h +++ b/c-src/Fl_ImageC.h @@ -62,6 +62,9 @@ FL_EXPORT_C_HEADER(void,Fl_Image_draw,(fl_Image image,int X, int Y)); FL_EXPORT_C_HEADER(void,Fl_Image_uncache,(fl_Image image)); #if FL_API_VERSION >= 10304 + FL_EXPORT_C_HEADER(void,Fl_Image_scale,(fl_Image image, int w, int h, int proportional, int can_expand)); + FL_EXPORT_C_HEADER(int,Fl_Image_data_w,(fl_Image image)); + FL_EXPORT_C_HEADER(int,Fl_Image_data_h,(fl_Image image)); FL_EXPORT_C_HEADER(int,Fl_Image_fail,(fl_Image image)); #endif #ifdef __cplusplus diff --git a/c-src/Fl_Image_SurfaceC.cpp b/c-src/Fl_Image_SurfaceC.cpp --- a/c-src/Fl_Image_SurfaceC.cpp +++ b/c-src/Fl_Image_SurfaceC.cpp @@ -2,9 +2,6 @@ #ifdef __cplusplus EXPORT { #endif - FL_EXPORT_C(const char*,Fl_Image_Surface_class_name)(fl_Image_Surface image_surface){ - return (static_cast(image_surface))->class_name(); - } FL_EXPORT_C(void,Fl_Image_Surface_set_current)(fl_Image_Surface image_surface){ (static_cast(image_surface))->set_current(); } @@ -21,6 +18,25 @@ FL_EXPORT_C(fl_RGB_Image, Fl_Image_Surface_image)(fl_Image_Surface image_surface) { return (fl_RGB_Image)(static_cast(image_surface))->image(); } +#if FL_API_VERSION >= 10400 + FL_EXPORT_C(void ,Fl_Image_Surface_get_origin)(fl_Image_Surface i, int* x, int* y){ + (static_cast(i))->origin(*x,*y); + } + FL_EXPORT_C(void ,Fl_Image_Surface_set_origin)(fl_Image_Surface i, int x, int y){ + (static_cast(i))->origin(x,y); + } + FL_EXPORT_C(int,Fl_Image_Surface_printable_rect)(fl_Image_Surface i, int* w, int* h){ + return (static_cast(i))->printable_rect(w, h); + } + FL_EXPORT_C(Fl_Offscreen,Fl_Image_Surface_offscreen)(fl_Image_Surface i){ + return (static_cast(i))->offscreen(); + } + FL_EXPORT_C(void, Fl_Image_Surface_rescale)(fl_Image_Surface i){ + Fl_Image_Surface* s = static_cast(i); + s->rescale(); + } +#endif + #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Image_SurfaceC.h b/c-src/Fl_Image_SurfaceC.h --- a/c-src/Fl_Image_SurfaceC.h +++ b/c-src/Fl_Image_SurfaceC.h @@ -1,21 +1,31 @@ #ifndef __FL_IMAGE_SURFACE_C__ #define __FL_IMAGE_SURFACE_C__ +#include "Fl_Types.h" +#include "Fl_EnumerationsC.h" +#if FL_API_VERSION >= 10400 +#include "FL/platform_types.h" +#endif #ifdef __cplusplus // always include the FL/*.H headers before local headers // Fl_Widget is included transitively and needed for // the callback mechanism included below to work. #include "FL/Fl.H" #include "Fl_ExportMacros.h" -#include "Fl_Types.h" #include "FL/Fl_Image_Surface.H" EXPORT { #endif - FL_EXPORT_C_HEADER(const char* ,Fl_Image_Surface_class_name,(fl_Image_Surface image_surface)); - FL_EXPORT_C_HEADER(void ,Fl_Image_Surface_set_current,(fl_Image_Surface image_surface)); - FL_EXPORT_C_HEADER(void ,Fl_Image_Surface_draw,(fl_Image_Surface image_surface, fl_Widget widget, int x, int y)); FL_EXPORT_C_HEADER(fl_Image_Surface,Fl_Image_Surface_New,(int w, int h)); FL_EXPORT_C_HEADER(void,Fl_Image_Surface_Destroy,(fl_Image_Surface image_surface)); - FL_EXPORT_C_HEADER(fl_Image,Fl_Image_Surface_image,(fl_Image_Surface image_surface)); + FL_EXPORT_C_HEADER(void ,Fl_Image_Surface_set_current,(fl_Image_Surface image_surface)); + FL_EXPORT_C_HEADER(void ,Fl_Image_Surface_draw,(fl_Image_Surface image_surface, fl_Widget widget, int x, int y)); + FL_EXPORT_C_HEADER(fl_RGB_Image,Fl_Image_Surface_image,(fl_Image_Surface image_surface)); +#if FL_API_VERSION >= 10400 + FL_EXPORT_C_HEADER(void ,Fl_Image_Surface_get_origin,(fl_Image_Surface i, int* x, int* y)); + FL_EXPORT_C_HEADER(void ,Fl_Image_Surface_set_origin,(fl_Image_Surface i, int x, int y)); + FL_EXPORT_C_HEADER(int,Fl_Image_Surface_printable_rect,(fl_Image_Surface i, int* w, int* h)); + FL_EXPORT_C_HEADER(Fl_Offscreen,Fl_Image_Surface_offscreen,(fl_Image_Surface i)); + FL_EXPORT_C_HEADER(void, Fl_Image_Surface_rescale,(fl_Image_Surface i)); +#endif #ifdef __cplusplus } #endif diff --git a/c-src/Fl_InputC.cpp b/c-src/Fl_InputC.cpp --- a/c-src/Fl_InputC.cpp +++ b/c-src/Fl_InputC.cpp @@ -75,6 +75,9 @@ void Fl_DerivedInput::hide_super(){ Fl_Input::hide(); } + void Fl_DerivedInput::drawtext(int x, int y, int w, int h){ + Fl_Input::drawtext(x,y,w,h); + } #endif /* Inherited from Fl_Widget */ FL_EXPORT_C(fl_Group,Fl_Input_parent)(fl_Input input){ @@ -518,7 +521,9 @@ Fl_DerivedInput* w = new Fl_DerivedInput(X,Y,W,H,label,fs); return (fl_Input)w; } - + FL_EXPORT_C(void, Fl_Input_drawtext)(fl_Input o, int x, int y, int w, int h){ + (static_cast(o))->drawtext(x,y,w,h); + } #ifdef __cplusplus } #endif diff --git a/c-src/Fl_InputC.h b/c-src/Fl_InputC.h --- a/c-src/Fl_InputC.h +++ b/c-src/Fl_InputC.h @@ -23,6 +23,7 @@ void show_super(); virtual void hide(); void hide_super(); + void drawtext(int,int,int,int); Fl_DerivedInput(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs); Fl_DerivedInput(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs); ~Fl_DerivedInput(); @@ -175,6 +176,7 @@ FL_EXPORT_C_HEADER(void,Fl_Input_show_super,(fl_Input o)); FL_EXPORT_C_HEADER(void,Fl_Input_hide,(fl_Input o)); FL_EXPORT_C_HEADER(void,Fl_Input_hide_super,(fl_Input o)); + FL_EXPORT_C_HEADER(void,Fl_Input_drawtext,(fl_Input o,int x,int y,int w,int h)); #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Menu_ItemC.cpp b/c-src/Fl_Menu_ItemC.cpp --- a/c-src/Fl_Menu_ItemC.cpp +++ b/c-src/Fl_Menu_ItemC.cpp @@ -2,60 +2,68 @@ #ifdef __cplusplus EXPORT { +void FlDerivedMenu_Item::draw(int x, int y, int w, int h, Fl_Menu_* m, int selected) { + if (this->drawF != NULL) { + this->drawF((fl_Menu_Item)this, x,y,w,h,(fl_Menu) m, selected); + } + else { + Fl_Menu_Item::draw(x,y,w,h,m,selected); + } +} #endif FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_next_with_step)(fl_Menu_Item menu_item,int step){ - return (fl_Menu_Item)(static_cast(menu_item))->next(step); + return (fl_Menu_Item)(static_cast(menu_item))->next(step); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_next)(fl_Menu_Item menu_item){ - return (fl_Menu_Item)(static_cast(menu_item))->next(); + return (fl_Menu_Item)(static_cast(menu_item))->next(); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_first)(fl_Menu_Item menu_item){ - return (fl_Menu_Item)(static_cast(menu_item))->first(); + return (fl_Menu_Item)(static_cast(menu_item))->first(); } FL_EXPORT_C(const char*,Fl_Menu_Item_label)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->label(); + return (static_cast(menu_item))->label(); } FL_EXPORT_C(void,Fl_Menu_Item_set_label)(fl_Menu_Item menu_item,const char* a){ - return (static_cast(menu_item))->label(a); + return (static_cast(menu_item))->label(a); } FL_EXPORT_C(void,Fl_Menu_Item_set_label_with_labeltype)(fl_Menu_Item menu_item,Fl_Labeltype labeltype,const char* b){ - return (static_cast(menu_item))->label(labeltype,b); + return (static_cast(menu_item))->label(labeltype,b); } FL_EXPORT_C(Fl_Labeltype,Fl_Menu_Item_labeltype)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->labeltype(); + return (static_cast(menu_item))->labeltype(); } FL_EXPORT_C(void,Fl_Menu_Item_set_labeltype)(fl_Menu_Item menu_item,Fl_Labeltype a){ - return (static_cast(menu_item))->labeltype(a); + return (static_cast(menu_item))->labeltype(a); } FL_EXPORT_C(void,Fl_Menu_Item_set_labelcolor)(fl_Menu_Item menu_item, Fl_Color c){ - (static_cast(menu_item))->labelcolor(c); + (static_cast(menu_item))->labelcolor(c); } FL_EXPORT_C(Fl_Color,Fl_Menu_Item_labelcolor)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->labelcolor(); + return (static_cast(menu_item))->labelcolor(); } FL_EXPORT_C(Fl_Font,Fl_Menu_Item_labelfont)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->labelfont(); + return (static_cast(menu_item))->labelfont(); } FL_EXPORT_C(void,Fl_Menu_Item_set_labelfont)(fl_Menu_Item menu_item,Fl_Font a){ - return (static_cast(menu_item))->labelfont(a); + return (static_cast(menu_item))->labelfont(a); } FL_EXPORT_C(Fl_Fontsize,Fl_Menu_Item_labelsize)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->labelsize(); + return (static_cast(menu_item))->labelsize(); } FL_EXPORT_C(void,Fl_Menu_Item_set_labelsize)(fl_Menu_Item menu_item,Fl_Fontsize a){ - return (static_cast(menu_item))->labelsize(a); + return (static_cast(menu_item))->labelsize(a); } FL_EXPORT_C(void,Fl_Menu_Item_set_callback_with_user_data)(fl_Menu_Item menu_item,fl_Callback* c,void* user_data){ C_to_Fl_Callback* callback = new C_to_Fl_Callback(c, user_data); - callback->set_callback(static_cast(menu_item)); + callback->set_callback(static_cast(menu_item)); } FL_EXPORT_C(void,Fl_Menu_Item_set_callback)(fl_Menu_Item menu_item,fl_Callback* c){ C_to_Fl_Callback* callback = new C_to_Fl_Callback(c); - callback->set_callback(static_cast(menu_item)); + callback->set_callback(static_cast(menu_item)); } FL_EXPORT_C(int, Fl_Menu_Item_has_callback)(fl_Menu_Item menu_item){ void* p = 0; - p = (void*)(static_cast(menu_item)->callback()); + p = (void*)(static_cast(menu_item)->callback()); if (p == NULL) { return 0; } @@ -64,178 +72,182 @@ } } FL_EXPORT_C(void*,Fl_Menu_Item_user_data)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->user_data(); + return (static_cast(menu_item))->user_data(); } FL_EXPORT_C(void,Fl_Menu_Item_set_user_data)(fl_Menu_Item menu_item,void* v){ - C_to_Fl_Callback* stored_cb = (static_cast((static_cast(menu_item))->user_data())); + C_to_Fl_Callback* stored_cb = (static_cast((static_cast(menu_item))->user_data())); if (stored_cb) { stored_cb->set_user_data(v); - (static_cast(menu_item))->user_data(stored_cb); + (static_cast(menu_item))->user_data(stored_cb); } else { - (static_cast(menu_item))->user_data(v); + (static_cast(menu_item))->user_data(v); } } FL_EXPORT_C(long,Fl_Menu_Item_argument)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->argument(); + return (static_cast(menu_item))->argument(); } FL_EXPORT_C(void,Fl_Menu_Item_set_argument)(fl_Menu_Item menu_item,long v){ - return (static_cast(menu_item))->argument(v); + return (static_cast(menu_item))->argument(v); } FL_EXPORT_C(int,Fl_Menu_Item_shortcut)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->shortcut(); + return (static_cast(menu_item))->shortcut(); } FL_EXPORT_C(void,Fl_Menu_Item_set_shortcut)(fl_Menu_Item menu_item,int s){ - return (static_cast(menu_item))->shortcut(s); + return (static_cast(menu_item))->shortcut(s); } FL_EXPORT_C(int,Fl_Menu_Item_submenu)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->submenu(); + return (static_cast(menu_item))->submenu(); } FL_EXPORT_C(int,Fl_Menu_Item_checkbox)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->checkbox(); + return (static_cast(menu_item))->checkbox(); } FL_EXPORT_C(int,Fl_Menu_Item_radio)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->radio(); + return (static_cast(menu_item))->radio(); } FL_EXPORT_C(int,Fl_Menu_Item_value)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->value(); + return (static_cast(menu_item))->value(); } FL_EXPORT_C(void,Fl_Menu_Item_set)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->set(); + return (static_cast(menu_item))->set(); } FL_EXPORT_C(void,Fl_Menu_Item_clear)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->clear(); + return (static_cast(menu_item))->clear(); } FL_EXPORT_C(void,Fl_Menu_Item_setonly)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->setonly(); + return (static_cast(menu_item))->setonly(); } FL_EXPORT_C(int,Fl_Menu_Item_visible)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->visible(); + return (static_cast(menu_item))->visible(); } FL_EXPORT_C(void,Fl_Menu_Item_show)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->show(); + return (static_cast(menu_item))->show(); } FL_EXPORT_C(void,Fl_Menu_Item_hide)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->hide(); + return (static_cast(menu_item))->hide(); } FL_EXPORT_C(int,Fl_Menu_Item_active)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->active(); + return (static_cast(menu_item))->active(); } FL_EXPORT_C(void,Fl_Menu_Item_activate)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->activate(); + return (static_cast(menu_item))->activate(); } FL_EXPORT_C(void,Fl_Menu_Item_deactivate)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->deactivate(); + return (static_cast(menu_item))->deactivate(); } FL_EXPORT_C(int,Fl_Menu_Item_activevisible)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->activevisible(); + return (static_cast(menu_item))->activevisible(); } FL_EXPORT_C(void,Fl_Menu_Item_image)(fl_Menu_Item menu_item,fl_Image a){ - return (static_cast(menu_item))->image((static_cast(a))); + return (static_cast(menu_item))->image((static_cast(a))); } FL_EXPORT_C(int,Fl_Menu_Item_measure)(fl_Menu_Item menu_item,int* h,fl_Menu_ menu){ - return (static_cast(menu_item))->measure(h,(static_cast(menu))); + return (static_cast(menu_item))->measure(h,(static_cast(menu))); } FL_EXPORT_C(void,Fl_Menu_Item_draw_with_t)(fl_Menu_Item menu_item,int x,int y,int w,int h,fl_Menu_ menu ,int t){ - return (static_cast(menu_item))->draw(x,y,w,h,(static_cast(menu)),t); + return (static_cast(menu_item))->draw(x,y,w,h,(static_cast(menu)),t); } FL_EXPORT_C(void,Fl_Menu_Item_draw)(fl_Menu_Item menu_item,int x,int y,int w,int h,fl_Menu_ menu){ - return (static_cast(menu_item))->draw(x,y,w,h,(static_cast(menu))); + return (static_cast(menu_item))->draw(x,y,w,h,(static_cast(menu)), 0); } FL_EXPORT_C(int, Fl_Menu_Item_flags)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->flags; + return (static_cast(menu_item))->flags; } FL_EXPORT_C(void, Fl_Menu_Item_set_flags)(fl_Menu_Item menu_item, int flags){ - (static_cast(menu_item))->flags = flags; + (static_cast(menu_item))->flags = flags; } FL_EXPORT_C(char*, Fl_Menu_Item_text)(fl_Menu_Item menu_item){ - return (char*)(static_cast(menu_item))->text; + return (char*)(static_cast(menu_item))->text; } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_popup)(fl_Menu_Item menu_item,int X,int Y){ - return (fl_Menu_Item)(static_cast(menu_item))->popup(X,Y); + return (fl_Menu_Item)(static_cast(menu_item))->popup(X,Y); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_pulldown)(fl_Menu_Item menu_item,int X,int Y,int W,int H){ - return (fl_Menu_Item)(static_cast(menu_item))->pulldown(X,Y,W,H); + return (fl_Menu_Item)(static_cast(menu_item))->pulldown(X,Y,W,H); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_popup_with_args)(fl_Menu_Item menu_item,int X,int Y, char* title, fl_Menu_Item picked, fl_Menu_ menu){ - return (fl_Menu_Item)(static_cast(menu_item))->popup(X,Y,title, (static_cast(picked)), (static_cast(menu))); + return (fl_Menu_Item)(static_cast(menu_item))->popup(X,Y,title, (static_cast(picked)), (static_cast(menu))); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_pulldown_with_args)(fl_Menu_Item menu_item,int X,int Y,int W, int H, fl_Menu_Item picked, fl_Menu_ menu, fl_Menu_Item title, int menubar){ - return (fl_Menu_Item)(static_cast(menu_item))->pulldown(X,Y,W,H,(static_cast(picked)), (static_cast(menu)), (static_cast(title)), menubar); + return (fl_Menu_Item)(static_cast(menu_item))->pulldown(X,Y,W,H,(static_cast(picked)), (static_cast(menu)), (static_cast(title)), menubar); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_test_shortcut)(fl_Menu_Item menu_item){ - return (fl_Menu_Item)(static_cast(menu_item))->test_shortcut(); + return (fl_Menu_Item)(static_cast(menu_item))->test_shortcut(); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_find_shortcut_with_ip_require_alt)(fl_Menu_Item menu_item,int* ip,int require_alt){ - return (fl_Menu_Item)(static_cast(menu_item))->find_shortcut(ip,require_alt ? true : false); + return (fl_Menu_Item)(static_cast(menu_item))->find_shortcut(ip,require_alt ? true : false); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_find_shortcut_with_ip)(fl_Menu_Item menu_item,int* ip){ - return (fl_Menu_Item)(static_cast(menu_item))->find_shortcut(ip); + return (fl_Menu_Item)(static_cast(menu_item))->find_shortcut(ip); } FL_EXPORT_C(fl_Menu_Item,Fl_Menu_Item_find_shortcut_with_require_alt)(fl_Menu_Item menu_item,int require_alt){ - return (fl_Menu_Item)(static_cast(menu_item))->find_shortcut(0,require_alt ? true : false); + return (fl_Menu_Item)(static_cast(menu_item))->find_shortcut(0,require_alt ? true : false); } FL_EXPORT_C(void,Fl_Menu_Item_do_callback)(fl_Menu_Item menu_item,fl_Widget o){ - return (static_cast(menu_item))->do_callback((static_cast(o))); + return (static_cast(menu_item))->do_callback((static_cast(o))); } FL_EXPORT_C(void,Fl_Menu_Item_do_callback_with_user_data)(fl_Menu_Item menu_item,fl_Widget o,void* arg){ - return (static_cast(menu_item))->do_callback((static_cast(o)),arg); + return (static_cast(menu_item))->do_callback((static_cast(o)),arg); } FL_EXPORT_C(int,Fl_Menu_Item_checked)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->checked(); + return (static_cast(menu_item))->checked(); } FL_EXPORT_C(void,Fl_Menu_Item_check)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->check(); + return (static_cast(menu_item))->check(); } FL_EXPORT_C(void,Fl_Menu_Item_uncheck)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->uncheck(); + return (static_cast(menu_item))->uncheck(); } FL_EXPORT_C(int,Fl_Menu_Item_insert)(fl_Menu_Item menu_item,int index,char* name,int shortcut,fl_Callback* cb){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb); - return callback_interceptor->menu_insert((static_cast(menu_item)),index,name,shortcut,0); + return callback_interceptor->menu_insert((static_cast(menu_item)),index,name,shortcut,0); } FL_EXPORT_C(int,Fl_Menu_Item_insert_with_flags)(fl_Menu_Item menu_item,int index,char* name,int shortcut,fl_Callback* cb,int flags){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb); - return callback_interceptor->menu_insert((static_cast(menu_item)),index,name,shortcut, flags); + return callback_interceptor->menu_insert((static_cast(menu_item)),index,name,shortcut, flags); } FL_EXPORT_C(int,Fl_Menu_Item_insert_with_user_data_flags)(fl_Menu_Item menu_item,int index,char* name,int shortcut,fl_Callback* cb,void* user_data,int flags){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data); - return callback_interceptor->menu_insert((static_cast(menu_item)),index,name,shortcut,flags); + return callback_interceptor->menu_insert((static_cast(menu_item)),index,name,shortcut,flags); } FL_EXPORT_C(int,Fl_Menu_Item_add_with_user_data)(fl_Menu_Item menu_item,char* name,int shortcut,fl_Callback* cb,void* user_data){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data); - return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,0); + return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,0); } FL_EXPORT_C(int,Fl_Menu_Item_add_with_flags)(fl_Menu_Item menu_item,char* name,int shortcut,fl_Callback* cb,int flags){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb); - return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); + return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); } FL_EXPORT_C(int,Fl_Menu_Item_add_with_user_data_flags)(fl_Menu_Item menu_item,char* name,int shortcut,fl_Callback* cb,void* user_data,int flags){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data); - return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); + return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); } FL_EXPORT_C(int,Fl_Menu_Item_add_with_shortcutname_user_data)(fl_Menu_Item menu_item,char* name,char* shortcut,fl_Callback* cb,void* user_data){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data); - return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,0); + return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,0); } FL_EXPORT_C(int,Fl_Menu_Item_add_with_shortcutname_flags)(fl_Menu_Item menu_item,char* name,char* shortcut,fl_Callback* cb,int flags){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb); - return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); + return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); } FL_EXPORT_C(int,Fl_Menu_Item_add_with_shortcutname_user_data_flags)(fl_Menu_Item menu_item,char* name,char* shortcut,fl_Callback* cb,void* user_data,int flags){ C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data); - return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); + return callback_interceptor->menu_add((static_cast(menu_item)),name,shortcut,flags); } FL_EXPORT_C(int, Fl_Menu_Item_size)(fl_Menu_Item menu_item){ - return (static_cast(menu_item))->size(); + return (static_cast(menu_item))->size(); } FL_EXPORT_C(fl_Menu_Item, Fl_Menu_Item_New)(){ - Fl_Menu_Item* i = new Fl_Menu_Item(); + FlDerivedMenu_Item* i = new FlDerivedMenu_Item(NULL); return (fl_Menu_Item)i; } + FL_EXPORT_C(fl_Menu_Item, Fl_Menu_Item_New_With_Draw)(fl_Menu_Item_Draw* f){ + FlDerivedMenu_Item* i = new FlDerivedMenu_Item(f); + return (fl_Menu_Item)i; + } FL_EXPORT_C(void, Fl_Menu_Item_Destroy)(fl_Menu_Item menu_item){ - delete (static_cast(menu_item)); + delete (static_cast(menu_item)); } #ifdef __cplusplus } diff --git a/c-src/Fl_Menu_ItemC.h b/c-src/Fl_Menu_ItemC.h --- a/c-src/Fl_Menu_ItemC.h +++ b/c-src/Fl_Menu_ItemC.h @@ -8,6 +8,13 @@ #include "FL/Fl_Menu_Item.H" #include "Fl_CallbackC.h" EXPORT { + struct FlDerivedMenu_Item : Fl_Menu_Item { + fl_Menu_Item_Draw* drawF; + FlDerivedMenu_Item(fl_Menu_Item_Draw* f){ + drawF = f; + }; + void draw(int x, int y, int w, int h, Fl_Menu_* m, int selected); + }; #endif FL_EXPORT_C_HEADER(fl_Menu_Item,Fl_Menu_Item_next_with_step,(fl_Menu_Item menu_item, int step)); FL_EXPORT_C_HEADER(fl_Menu_Item,Fl_Menu_Item_next,(fl_Menu_Item menu_item)); @@ -80,6 +87,7 @@ FL_EXPORT_C_HEADER(int,Fl_Menu_Item_add_with_shortcutname_user_data_flags,(fl_Menu_Item menu_item, char* name, char* shortcut, fl_Callback* cb, void* user_data, int flags)); FL_EXPORT_C_HEADER(int,Fl_Menu_Item_size,(fl_Menu_Item menu_item)); FL_EXPORT_C_HEADER(fl_Menu_Item,Fl_Menu_Item_New,()); + FL_EXPORT_C_HEADER(fl_Menu_Item,Fl_Menu_Item_New_With_Draw,(fl_Menu_Item_Draw* f)); FL_EXPORT_C_HEADER(void,Fl_Menu_Item_Destroy,(fl_Menu_Item menu_item)); #ifdef __cplusplus } diff --git a/c-src/Fl_Multi_LabelC.cpp b/c-src/Fl_Multi_LabelC.cpp new file mode 100644 --- /dev/null +++ b/c-src/Fl_Multi_LabelC.cpp @@ -0,0 +1,45 @@ +#include "Fl_Multi_LabelC.h" +#ifdef __cplusplus +EXPORT { +#endif + FL_EXPORT_C(const char*,Fl_Multi_Label_labela)(fl_Multi_Label label){ + return (static_cast(label))->labela; + }; + FL_EXPORT_C(void,Fl_Multi_Label_set_labela)(fl_Multi_Label label, const char* text){ + (static_cast(label))->labela = text; + }; + FL_EXPORT_C(const char*,Fl_Multi_Label_labelb)(fl_Multi_Label label){ + return (static_cast(label))->labelb; + }; + FL_EXPORT_C(void,Fl_Multi_Label_set_labelb)(fl_Multi_Label label, const char* text){ + (static_cast(label))->labelb = text; + }; + FL_EXPORT_C(uchar,Fl_Multi_Label_typea)(fl_Multi_Label label){ + return (static_cast(label))->typea; + }; + FL_EXPORT_C(void,Fl_Multi_Label_set_typea)(fl_Multi_Label label, uchar typea){ + (static_cast(label))->typea = typea; + }; + FL_EXPORT_C(uchar,Fl_Multi_Label_typeb)(fl_Multi_Label label){ + return (static_cast(label))->typeb; + }; + FL_EXPORT_C(void,Fl_Multi_Label_set_typeb)(fl_Multi_Label label, uchar typeb){ + (static_cast(label))->typeb = typeb; + }; + FL_EXPORT_C(fl_Multi_Label,Fl_Multi_Label_New)(const char* labela, const char* labelb, uchar typea, uchar typeb){ + Fl_Multi_Label *l = new Fl_Multi_Label(); + l->labela = labela; + l->labelb = labelb; + l->typea = typea; + l->typeb = typeb; + return (fl_Multi_Label)l; + }; + FL_EXPORT_C(void, Fl_Multi_Label_label_widget)(fl_Multi_Label l, fl_Widget w){ + (static_cast(l))->label((static_cast(w))); + }; + FL_EXPORT_C(void, Fl_Multi_Label_label_menu_item)(fl_Multi_Label l, fl_Menu_Item i){ + (static_cast(l))->label((static_cast(i))); + }; +#ifdef __cplusplus +} +#endif diff --git a/c-src/Fl_Multi_LabelC.h b/c-src/Fl_Multi_LabelC.h new file mode 100644 --- /dev/null +++ b/c-src/Fl_Multi_LabelC.h @@ -0,0 +1,23 @@ +#ifndef __FL_MULTI_LABEL_C__ +#define __FL_MULTI_LABEL_C__ +#ifdef __cplusplus +#include "FL/Fl.H" +#include "FL/Fl_Multi_Label.H" +#include "Fl_CallbackC.h" +EXPORT { +#endif + FL_EXPORT_C_HEADER(const char*,Fl_Multi_Label_labela,(fl_Multi_Label label)); + FL_EXPORT_C_HEADER(void,Fl_Multi_Label_set_labela,(fl_Multi_Label label, const char* text)); + FL_EXPORT_C_HEADER(const char*,Fl_Multi_Label_labelb,(fl_Multi_Label label)); + FL_EXPORT_C_HEADER(void,Fl_Multi_Label_set_labelb,(fl_Multi_Label label, const char* text)); + FL_EXPORT_C_HEADER(uchar,Fl_Multi_Label_typea,(fl_Multi_Label label)); + FL_EXPORT_C_HEADER(void,Fl_Multi_Label_set_typea,(fl_Multi_Label label, uchar typea)); + FL_EXPORT_C_HEADER(uchar,Fl_Multi_Label_typeb,(fl_Multi_Label label)); + FL_EXPORT_C_HEADER(void,Fl_Multi_Label_set_typeb,(fl_Multi_Label label, uchar typeb)); + FL_EXPORT_C_HEADER(fl_Multi_Label,Fl_Multi_Label_New,(const char* labela, const char* labelb, uchar typea, uchar typeb)); + FL_EXPORT_C_HEADER(void, Fl_Multi_Label_label_widget, (fl_Multi_Label l, fl_Widget w)); + FL_EXPORT_C_HEADER(void, Fl_Multi_Label_label_menu_item, (fl_Multi_Label l, fl_Menu_Item i)); +#ifdef __cplusplus +} +#endif +#endif diff --git a/c-src/Fl_Paged_DeviceC.cpp b/c-src/Fl_Paged_DeviceC.cpp --- a/c-src/Fl_Paged_DeviceC.cpp +++ b/c-src/Fl_Paged_DeviceC.cpp @@ -2,12 +2,6 @@ #ifdef __cplusplus EXPORT { #endif - FL_EXPORT_C(const char*,Fl_Paged_Device_class_id)( ){ - return Fl_Surface_Device::class_id; - } - FL_EXPORT_C(const char*,Fl_Paged_Device_class_name)(fl_Paged_Device paged_device){ - return (static_cast(paged_device))->class_name(); - } FL_EXPORT_C(void,Fl_Paged_Device_set_current)(fl_Paged_Device paged_device){ return (static_cast(paged_device))->set_current(); } diff --git a/c-src/Fl_Paged_DeviceC.h b/c-src/Fl_Paged_DeviceC.h --- a/c-src/Fl_Paged_DeviceC.h +++ b/c-src/Fl_Paged_DeviceC.h @@ -10,8 +10,6 @@ EXPORT { #endif // Inherited from Fl_Surface_Driver - FL_EXPORT_C_HEADER(const char*,Fl_Paged_Device_class_id,()); - FL_EXPORT_C_HEADER(const char*,Fl_Paged_Device_class_name,(fl_Paged_Device paged_device)); FL_EXPORT_C_HEADER(void,Fl_Paged_Device_set_current,(fl_Paged_Device paged_device)); FL_EXPORT_C_HEADER(void,Fl_Paged_Device_set_driver,(fl_Paged_Device paged_device,fl_Graphics_Driver graphics_driver)); FL_EXPORT_C_HEADER(fl_Graphics_Driver,Fl_Paged_Device_driver,(fl_Paged_Device paged_device)); diff --git a/c-src/Fl_PrinterC.cpp b/c-src/Fl_PrinterC.cpp --- a/c-src/Fl_PrinterC.cpp +++ b/c-src/Fl_PrinterC.cpp @@ -2,12 +2,6 @@ #ifdef __cplusplus EXPORT { #endif - FL_EXPORT_C(const char*,Fl_Printer_class_id)( ){ - return Fl_Surface_Device::class_id; - } - FL_EXPORT_C(const char*,Fl_Printer_class_name)(fl_Printer printer){ - return (static_cast(printer))->class_name(); - } FL_EXPORT_C(void,Fl_Printer_set_current)(fl_Printer printer){ return (static_cast(printer))->set_current(); } diff --git a/c-src/Fl_PrinterC.h b/c-src/Fl_PrinterC.h --- a/c-src/Fl_PrinterC.h +++ b/c-src/Fl_PrinterC.h @@ -10,8 +10,6 @@ EXPORT { #endif // Inherited from Fl_Surface_Driver - FL_EXPORT_C_HEADER(const char*,Fl_Printer_class_id,()); - FL_EXPORT_C_HEADER(const char*,Fl_Printer_class_name,(fl_Printer printer)); FL_EXPORT_C_HEADER(void,Fl_Printer_set_current,(fl_Printer printer)); FL_EXPORT_C_HEADER(fl_Graphics_Driver,Fl_Printer_driver,(fl_Printer printer)); FL_EXPORT_C_HEADER(fl_Surface_Device,Fl_Printer_surface,()); diff --git a/c-src/Fl_SVG_ImageC.cpp b/c-src/Fl_SVG_ImageC.cpp new file mode 100644 --- /dev/null +++ b/c-src/Fl_SVG_ImageC.cpp @@ -0,0 +1,41 @@ +#include "Fl_SVG_ImageC.h" +#ifdef __cplusplus +EXPORT { +#endif + FL_EXPORT_C(fl_SVG_Image,Fl_SVG_Image_New_WithData)(const char* name, const char* data){ + Fl_SVG_Image* image = new Fl_SVG_Image(name, data); + return (static_cast(image)); + } + FL_EXPORT_C(void, Fl_SVG_Image_Destroy)(fl_SVG_Image image){ + delete (static_cast(image)); + } + FL_EXPORT_C(fl_SVG_Image,Fl_SVG_Image_copy_with_w_h)(fl_SVG_Image image,int W,int H){ + return (fl_SVG_Image)(static_cast(image))->copy(W,H); + } + FL_EXPORT_C(void,Fl_SVG_Image_color_average)(fl_SVG_Image image,Fl_Color c,float i){ + return (static_cast(image))->color_average(c,i); + } + FL_EXPORT_C(void,Fl_SVG_Image_desaturate)(fl_SVG_Image image){ + return (static_cast(image))->desaturate(); + } + FL_EXPORT_C(void,Fl_SVG_Image_draw_with_cx_cy)(fl_SVG_Image image,int X,int Y,int W,int H,int cx,int cy){ + return (static_cast(image))->draw(X,Y,W,H,cx,cy); + } + FL_EXPORT_C(void,Fl_SVG_Image_draw_with_cx)(fl_SVG_Image image,int X,int Y,int W,int H,int cx){ + return (static_cast(image))->draw(X,Y,W,H,cx); + } + FL_EXPORT_C(void,Fl_SVG_Image_draw_with_cy)(fl_SVG_Image image,int X,int Y,int W,int H,int cy){ + return (static_cast(image))->draw(X,Y,W,H,0,cy); + } + FL_EXPORT_C(void,Fl_SVG_Image_draw_with)(fl_Image image,int X,int Y,int W,int H){ + return (static_cast(image))->draw(X,Y,W,H); + } + FL_EXPORT_C(void,Fl_SVG_Image_draw)(fl_SVG_Image image,int X,int Y){ + return (static_cast(image))->draw(X,Y); + } + FL_EXPORT_C(void, Fl_SVG_Image_resize)(fl_SVG_Image image, int width, int height) { + (static_cast(image))->resize(width,height); + } +#ifdef __cplusplus +} +#endif diff --git a/c-src/Fl_SVG_ImageC.h b/c-src/Fl_SVG_ImageC.h new file mode 100644 --- /dev/null +++ b/c-src/Fl_SVG_ImageC.h @@ -0,0 +1,23 @@ +#ifndef __FL_SVG_IMAGE_C__ +#define __FL_SVG_IMAGE_C__ +#ifdef __cplusplus +#include "FL/Fl.H" +#include "FL/Fl_SVG_Image.H" +#include "Fl_CallbackC.h" +EXPORT { +#endif + FL_EXPORT_C_HEADER(fl_SVG_Image,Fl_SVG_Image_New_WithData,(const char* name, const char* data)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_Destroy,(fl_PNM_Image image)); + FL_EXPORT_C_HEADER(fl_SVG_Image,Fl_SVG_Image_copy_with_w_h,(fl_SVG_Image image,int W, int H)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_color_average,(fl_SVG_Image image,Fl_Color c, float i)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_desaturate,(fl_SVG_Image image)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_draw_with_cx_cy,(fl_SVG_Image image,int X, int Y, int W, int H, int cx, int cy)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_draw_with_cx,(fl_SVG_Image image,int X, int Y, int W, int H, int cx)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_draw_with_cy,(fl_SVG_Image image,int X, int Y, int W, int H, int cy)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_draw_with,(fl_Image image,int X,int Y,int W,int H)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_draw,(fl_SVG_Image image,int X, int Y)); + FL_EXPORT_C_HEADER(void,Fl_SVG_Image_resize,(fl_SVG_Image image,int width, int height)); +#ifdef __cplusplus +} +#endif +#endif diff --git a/c-src/Fl_Simple_TerminalC.cpp b/c-src/Fl_Simple_TerminalC.cpp new file mode 100644 --- /dev/null +++ b/c-src/Fl_Simple_TerminalC.cpp @@ -0,0 +1,168 @@ +#include "Fl_Simple_TerminalC.h" +#ifdef __cplusplus +EXPORT { + Fl_DerivedSimple_Terminal::Fl_DerivedSimple_Terminal(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs) : Fl_Simple_Terminal(X,Y,W,H,l){ + overriddenFuncs = funcs; + other_data = (void*)0; + } + Fl_DerivedSimple_Terminal::Fl_DerivedSimple_Terminal(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs):Fl_Simple_Terminal(X,Y,W,H){ + overriddenFuncs = funcs; + other_data = (void*)0; + } + Fl_DerivedSimple_Terminal::~Fl_DerivedSimple_Terminal(){ + free(overriddenFuncs); + } + void Fl_DerivedSimple_Terminal::draw(){ + if (this->overriddenFuncs->draw != NULL) { + this->overriddenFuncs->draw((fl_Simple_Terminal) this); + } + else { + Fl_Simple_Terminal::draw(); + } + } + void Fl_DerivedSimple_Terminal::draw_super(){ + Fl_Simple_Terminal::draw(); + } + int Fl_DerivedSimple_Terminal::handle(int event){ + int i; + if (this->overriddenFuncs->handle != NULL) { + i = this->overriddenFuncs->handle((fl_Simple_Terminal) this,event); + } + else { + i = Fl_Simple_Terminal::handle(event); + } + return i; + } + int Fl_DerivedSimple_Terminal::handle_super(int event){ + return Fl_Simple_Terminal::handle(event); + } + + void Fl_DerivedSimple_Terminal::resize(int x, int y, int w, int h){ + if (this->overriddenFuncs->resize != NULL) { + this->overriddenFuncs->resize((fl_Simple_Terminal) this,x,y,w,h); + } + else { + Fl_Simple_Terminal::resize(x,y,w,h); + } + } + + void Fl_DerivedSimple_Terminal::resize_super(int x, int y, int w, int h){ + Fl_Simple_Terminal::resize(x,y,w,h); + } + void Fl_DerivedSimple_Terminal::show(){ + if (this->overriddenFuncs->show != NULL) { + this->overriddenFuncs->show((fl_Simple_Terminal) this); + } + else { + Fl_Simple_Terminal::show(); + } + } + void Fl_DerivedSimple_Terminal::show_super(){ + Fl_Simple_Terminal::show(); + } + + void Fl_DerivedSimple_Terminal::hide(){ + if (this->overriddenFuncs->hide != NULL) { + this->overriddenFuncs->hide((fl_Simple_Terminal) this); + } + else { + Fl_Simple_Terminal::hide(); + } + } + void Fl_DerivedSimple_Terminal::hide_super(){ + Fl_Simple_Terminal::hide(); + } +#endif + FL_EXPORT_C(void, Fl_Simple_Terminal_set_stay_at_bottom)(fl_Simple_Terminal t, int b) { + (static_cast(t))->stay_at_bottom(b > 0); + }; + FL_EXPORT_C(int, Fl_Simple_Terminal_get_stay_at_bottom)(fl_Simple_Terminal t) { + bool ret = (static_cast(t))->stay_at_bottom(); + if (ret) { return 1; } else { return 0; } + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_set_ansi)(fl_Simple_Terminal t, int b) { + (static_cast(t))->ansi(b > 0); + }; + FL_EXPORT_C(int, Fl_Simple_Terminal_get_ansi)(fl_Simple_Terminal t) { + bool ret = (static_cast(t))->ansi(); + if (ret) { return 1; } else { return 0; } + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_set_history_lines)(fl_Simple_Terminal t, int i) { + (static_cast(t))->history_lines(i); + }; + FL_EXPORT_C(int, Fl_Simple_Terminal_get_history_lines)(fl_Simple_Terminal t) { + return (static_cast(t))->history_lines(); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_set_normal_style_index)(fl_Simple_Terminal t, int i) { + (static_cast(t))->normal_style_index(i); + }; + FL_EXPORT_C(int, Fl_Simple_Terminal_get_normal_style_index)(fl_Simple_Terminal t) { + return (static_cast(t))->normal_style_index(); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_set_current_style_index)(fl_Simple_Terminal t, int i) { + (static_cast(t))->current_style_index(i); + }; + FL_EXPORT_C(int, Fl_Simple_Terminal_get_current_style_index)(fl_Simple_Terminal t) { + return (static_cast(t))->current_style_index(); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_set_style_table)(fl_Simple_Terminal t, Style_Table_Entry *styleTable, int stable_size, int normal_style_index){ + (static_cast(t))->style_table((static_cast((void*)styleTable)), stable_size, normal_style_index); + }; + FL_EXPORT_C(Style_Table_Entry*, Fl_Simple_Terminal_get_style_table)(fl_Simple_Terminal t) { + const Fl_Text_Display::Style_Table_Entry* s = (static_cast(t))->style_table(); + return (Style_Table_Entry*)s; + }; + FL_EXPORT_C(int, Fl_Simple_Terminal_get_style_table_size)(fl_Simple_Terminal t) { + return (static_cast(t))->style_table_size(); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_append)(fl_Simple_Terminal t, const char *s){ + (static_cast(t))->append(s); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_set_text)(fl_Simple_Terminal t, const char *s){ + (static_cast(t))->text(s); + }; + FL_EXPORT_C(const char*, Fl_Simple_Terminal_get_text)(fl_Simple_Terminal t) { + return (static_cast(t))->text(); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_clear)(fl_Simple_Terminal t) { + (static_cast(t))->clear(); + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_remove_lines)(fl_Simple_Terminal t, int start, int count){ + (static_cast(t))->remove_lines(start,count); + }; + FL_EXPORT_C(fl_Simple_Terminal, Fl_Simple_Terminal_New)(int X, int Y, int W, int H){ + fl_Widget_Virtual_Funcs* fs = Fl_Widget_default_virtual_funcs(); + Fl_DerivedSimple_Terminal* w = new Fl_DerivedSimple_Terminal(X,Y,W,H,fs); + return (fl_Simple_Terminal)w; + }; + FL_EXPORT_C(fl_Simple_Terminal, Fl_Simple_Terminal_New_WithLabel)(int X, int Y, int W, int H, const char* label){ + fl_Widget_Virtual_Funcs* fs = Fl_Widget_default_virtual_funcs(); + Fl_DerivedSimple_Terminal* w = new Fl_DerivedSimple_Terminal(X,Y,W,H,label,fs); + return (fl_Simple_Terminal)w; + }; + FL_EXPORT_C(fl_Simple_Terminal, Fl_OverriddenSimple_Terminal_New)(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs){ + Fl_DerivedSimple_Terminal* w = new Fl_DerivedSimple_Terminal(X,Y,W,H,fs); + return (fl_Simple_Terminal)w; + }; + FL_EXPORT_C(fl_Simple_Terminal, Fl_OverriddenSimple_Terminal_New_WithLabel)(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs){ + Fl_DerivedSimple_Terminal* w = new Fl_DerivedSimple_Terminal(X,Y,W,H,label,fs); + return (fl_Simple_Terminal)w; + }; + FL_EXPORT_C(void, Fl_Simple_Terminal_draw_super)(fl_Simple_Terminal o){ + (static_cast(o))->draw_super(); + } + FL_EXPORT_C(int, Fl_Simple_Terminal_handle_super)(fl_Simple_Terminal o, int event){ + return (static_cast(o))->handle_super(event); + } + FL_EXPORT_C(void, Fl_Simple_Terminal_resize_super)(fl_Simple_Terminal o, int x, int y, int w, int h){ + (static_cast(o))->resize_super(x,y,w,h); + } + FL_EXPORT_C(void, Fl_Simple_Terminal_show_super)(fl_Simple_Terminal o){ + (static_cast(o))->show_super(); + } + FL_EXPORT_C(void, Fl_Simple_Terminal_hide_super)(fl_Simple_Terminal o){ + (static_cast(o))->hide_super(); + } +#ifdef __cplusplus +} +#endif diff --git a/c-src/Fl_Simple_TerminalC.h b/c-src/Fl_Simple_TerminalC.h new file mode 100644 --- /dev/null +++ b/c-src/Fl_Simple_TerminalC.h @@ -0,0 +1,61 @@ +#ifndef __FL_SIMPLE_TERMINAL_C__ +#define __FL_SIMPLE_TERMINAL_C__ +#ifdef __cplusplus +// always include the FL/*.H headers before local headers +// Fl_Widget is included transitively and needed for +// the callback mechanism included below to work. +#include "FL/Fl.H" +#include "FL/Fl_Simple_Terminal.H" +#include "Fl_CallbackC.h" +#include "Fl_WidgetC.h" +EXPORT { + class Fl_DerivedSimple_Terminal : public Fl_Simple_Terminal { + fl_Widget_Virtual_Funcs* overriddenFuncs; + void* other_data; + public: + virtual void draw(); + void draw_super(); + virtual int handle(int event); + int handle_super(int event); + virtual void resize(int x, int y, int w, int h); + void resize_super(int x, int y, int w, int h); + virtual void show(); + void show_super(); + virtual void hide(); + void hide_super(); + Fl_DerivedSimple_Terminal(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs); + Fl_DerivedSimple_Terminal(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs); + ~Fl_DerivedSimple_Terminal(); + }; +#endif + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_stay_at_bottom, (fl_Simple_Terminal t, int)); + FL_EXPORT_C_HEADER(int, Fl_Simple_Terminal_get_stay_at_bottom, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_history_lines, (fl_Simple_Terminal t, int)); + FL_EXPORT_C_HEADER(int, Fl_Simple_Terminal_get_history_lines, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_ansi, (fl_Simple_Terminal t, int val)); + FL_EXPORT_C_HEADER(int, Fl_Simple_Terminal_get_ansi, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_style_table, (fl_Simple_Terminal t, Style_Table_Entry *styleTable, int stable_size, int normal_style_index)); + FL_EXPORT_C_HEADER(Style_Table_Entry*, Fl_Simple_Terminal_get_style_table, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(int, Fl_Simple_Terminal_get_style_table_size, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_normal_style_index, (fl_Simple_Terminal t, int)); + FL_EXPORT_C_HEADER(int, Fl_Simple_Terminal_get_normal_style_index, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_current_style_index, (fl_Simple_Terminal t, int)); + FL_EXPORT_C_HEADER(int, Fl_Simple_Terminal_get_current_style_index, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_append, (fl_Simple_Terminal t, const char *s)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_set_text, (fl_Simple_Terminal t, const char *s)); + FL_EXPORT_C_HEADER(const char*, Fl_Simple_Terminal_get_text, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_clear, (fl_Simple_Terminal t)); + FL_EXPORT_C_HEADER(void, Fl_Simple_Terminal_remove_lines, (fl_Simple_Terminal t, int start, int count)); + FL_EXPORT_C_HEADER(fl_Simple_Terminal,Fl_Simple_Terminal_New_WithLabel,(int x, int y, int w, int h, const char* label)); + FL_EXPORT_C_HEADER(fl_Simple_Terminal,Fl_Simple_Terminal_New,(int x, int y, int w, int h)); + FL_EXPORT_C_HEADER(fl_Simple_Terminal,Fl_OverriddenSimple_Terminal_New_WithLabel,(int x, int y, int w, int h, const char* label, fl_Widget_Virtual_Funcs* funcs)); + FL_EXPORT_C_HEADER(fl_Simple_Terminal,Fl_OverriddenSimple_Terminal_New,(int x, int y, int w, int h, fl_Widget_Virtual_Funcs* funcs)); + FL_EXPORT_C_HEADER(void,Fl_Simple_Terminal_draw_super,(fl_Simple_Terminal o)); + FL_EXPORT_C_HEADER(int,Fl_Simple_Terminal_handle_super,(fl_Simple_Terminal o, int event)); + FL_EXPORT_C_HEADER(void,Fl_Simple_Terminal_resize_super,(fl_Simple_Terminal o, int x, int y, int w, int h)); + FL_EXPORT_C_HEADER(void,Fl_Simple_Terminal_show_super,(fl_Simple_Terminal o)); + FL_EXPORT_C_HEADER(void,Fl_Simple_Terminal_hide_super,(fl_Simple_Terminal o)); +#ifdef __cplusplus +} +#endif +#endif /* __FL_SIMPLE_TERMINAL_C__ */ diff --git a/c-src/Fl_SpinnerC.cpp b/c-src/Fl_SpinnerC.cpp --- a/c-src/Fl_SpinnerC.cpp +++ b/c-src/Fl_SpinnerC.cpp @@ -114,6 +114,12 @@ FL_EXPORT_C(double,Fl_Spinner_step)(fl_Spinner spinner){ return (static_cast(spinner))->step(); } + FL_EXPORT_C(void,Fl_Spinner_set_wrap)(fl_Spinner spinner,int s){ + (static_cast(spinner))->wrap(s); + } + FL_EXPORT_C(int,Fl_Spinner_wrap)(fl_Spinner spinner){ + return (static_cast(spinner))->wrap(); + } FL_EXPORT_C(double,Fl_Spinner_value)(fl_Spinner spinner){ return (static_cast(spinner))->value(); } diff --git a/c-src/Fl_SpinnerC.h b/c-src/Fl_SpinnerC.h --- a/c-src/Fl_SpinnerC.h +++ b/c-src/Fl_SpinnerC.h @@ -50,6 +50,8 @@ FL_EXPORT_C_HEADER(void,Fl_Spinner_range,(fl_Spinner spinner, double a, double b)); FL_EXPORT_C_HEADER(void,Fl_Spinner_set_step,(fl_Spinner spinner, double a)); FL_EXPORT_C_HEADER(double,Fl_Spinner_step,(fl_Spinner spinner)); + FL_EXPORT_C_HEADER(void,Fl_Spinner_set_wrap,(fl_Spinner spinner, int a)); + FL_EXPORT_C_HEADER(int,Fl_Spinner_wrap,(fl_Spinner spinner)); FL_EXPORT_C_HEADER(double,Fl_Spinner_value,(fl_Spinner spinner)); FL_EXPORT_C_HEADER(void,Fl_Spinner_set_value,(fl_Spinner spinner, double v)); FL_EXPORT_C_HEADER(void,Fl_Spinner_set_format,(fl_Spinner spinner, const char* format)); diff --git a/c-src/Fl_TableC.cpp b/c-src/Fl_TableC.cpp --- a/c-src/Fl_TableC.cpp +++ b/c-src/Fl_TableC.cpp @@ -741,14 +741,12 @@ } (static_cast(table))->do_callback(c, row, col); } -#if FLTK_ABI_VERSION >= 10303 FL_EXPORT_C(void, Fl_Table_set_tab_cell_nav)(fl_Table table, int val){ (static_cast(table))->tab_cell_nav(val); } FL_EXPORT_C(int, Fl_Table_tab_cell_nav)(fl_Table table){ return (static_cast(table))->tab_cell_nav(); } -#endif FL_EXPORT_C(int, Fl_Table_find_cell)(fl_Table table, TableContextC context, int R, int C, int *X, int *Y, int *W, int *H){ Fl_Table::TableContext c = (Fl_Table::TableContext)-1; switch(context){ diff --git a/c-src/Fl_TableC.h b/c-src/Fl_TableC.h --- a/c-src/Fl_TableC.h +++ b/c-src/Fl_TableC.h @@ -235,10 +235,8 @@ FL_EXPORT_C_HEADER(int,Fl_Table_callback_col,(fl_Table table)); FL_EXPORT_C_HEADER(TableContextC,Fl_Table_callback_context,(fl_Table table)); FL_EXPORT_C_HEADER(void,Fl_Table_do_callback,(fl_Table table, TableContextC tableContext, int row, int col)); -#if FLTK_ABI_VERSION >= 10303 FL_EXPORT_C_HEADER(void,Fl_Table_set_tab_cell_nav,(fl_Table table, int val)); FL_EXPORT_C_HEADER(int,Fl_Table_tab_cell_nav,(fl_Table table)); -#endif FL_EXPORT_C_HEADER(int,Fl_Table_find_cell,(fl_Table table, TableContextC context, int R, int C, int* X, int* Y, int* W, int* H)); #ifdef __cplusplus } diff --git a/c-src/Fl_Table_RowC.cpp b/c-src/Fl_Table_RowC.cpp --- a/c-src/Fl_Table_RowC.cpp +++ b/c-src/Fl_Table_RowC.cpp @@ -736,14 +736,12 @@ } (static_cast(table_row))->do_callback(c, row, col); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(void, Fl_Table_Row_set_tab_cell_nav)(fl_Table_Row table_row, int val){ (static_cast(table_row))->tab_cell_nav(val); } FL_EXPORT_C(int, Fl_Table_Row_tab_cell_nav)(fl_Table_Row table_row){ return (static_cast(table_row))->tab_cell_nav(); } -#endif FL_EXPORT_C(int, Fl_Table_Row_find_cell)(fl_Table_Row table_row, TableContextC context, int R, int C, int *X, int *Y, int *W, int *H){ Fl_Table::TableContext c = (Fl_Table::TableContext)-1; switch(context){ diff --git a/c-src/Fl_Table_RowC.h b/c-src/Fl_Table_RowC.h --- a/c-src/Fl_Table_RowC.h +++ b/c-src/Fl_Table_RowC.h @@ -229,10 +229,8 @@ FL_EXPORT_C_HEADER(int,Fl_Table_Row_callback_col,(fl_Table_Row table)); FL_EXPORT_C_HEADER(TableContextC,Fl_Table_Row_callback_context,(fl_Table_Row table)); FL_EXPORT_C_HEADER(void,Fl_Table_Row_do_callback,(fl_Table_Row table, TableContextC tableContext, int row, int col)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(void,Fl_Table_Row_set_tab_cell_nav,(fl_Table_Row table, int val)); FL_EXPORT_C_HEADER(int,Fl_Table_Row_tab_cell_nav,(fl_Table_Row table)); -#endif FL_EXPORT_C_HEADER(int,Fl_Table_Row_find_cell,(fl_Table_Row table, TableContextC context, int R, int C, int *X, int *Y, int *W, int *H)); /* Fl_Table_Row specific */ diff --git a/c-src/Fl_TabsC.cpp b/c-src/Fl_TabsC.cpp --- a/c-src/Fl_TabsC.cpp +++ b/c-src/Fl_TabsC.cpp @@ -1,16 +1,19 @@ #include "Fl_TabsC.h" #ifdef __cplusplus EXPORT { - Fl_DerivedTabs::Fl_DerivedTabs(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs) : Fl_Tabs(X,Y,W,H,l){ + Fl_DerivedTabs::Fl_DerivedTabs(int X, int Y, int W, int H, const char *l, fl_Tab_Virtual_Funcs* fs, fl_Widget_Virtual_Funcs* funcs) : Fl_Tabs(X,Y,W,H,l){ overriddenFuncs = funcs; other_data = (void*)0; + this->fs = fs; } - Fl_DerivedTabs::Fl_DerivedTabs(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs):Fl_Tabs(X,Y,W,H){ + Fl_DerivedTabs::Fl_DerivedTabs(int X, int Y, int W, int H, fl_Tab_Virtual_Funcs* fs, fl_Widget_Virtual_Funcs* funcs):Fl_Tabs(X,Y,W,H){ overriddenFuncs = funcs; other_data = (void*)0; + this->fs = fs; } Fl_DerivedTabs::~Fl_DerivedTabs(){ free(overriddenFuncs); + free(fs); } void Fl_DerivedTabs::draw(){ if (this->overriddenFuncs->draw != NULL) { @@ -25,6 +28,42 @@ Fl_Tabs::draw(); } + Fl_Widget* Fl_DerivedTabs::which(int event_x, int event_y) { + if (this->fs->tab_which != NULL) { + return (Fl_Widget*)(this->fs->tab_which((fl_Tabs)this, event_x, event_y)); + } + else { + return Fl_Tabs::which(event_x,event_y); + } + } + + int Fl_DerivedTabs::tab_positions(){ + if (this->fs->tab_positions != NULL) { + const int nc = children(); + if (nc != tab_count) { + clear_tab_positions(); + if (nc) { + tab_pos = (int*)malloc((nc+1)*sizeof(int)); + tab_width = (int*)malloc((nc+1)*sizeof(int)); + } + tab_count = nc; + } + return this->fs->tab_positions((fl_Tabs)this, tab_pos, tab_width); + } + else { + return Fl_Tabs::tab_positions(); + } + } + + int Fl_DerivedTabs::tab_height() { + if (this->fs->tab_height != NULL) { + return this->fs->tab_height((fl_Tabs)this); + } + else { + return Fl_Tabs::tab_height(); + } + } + int Fl_DerivedTabs::handle(int event){ int i; if (this->overriddenFuncs->handle != NULL) { @@ -75,320 +114,345 @@ Fl_Tabs::hide(); } + void Fl_DerivedTabs::redraw_tabs(){ + if (this->fs->redraw_tabs != NULL) { + this->fs->redraw_tabs((fl_Tabs)this); + } + else { + Fl_Tabs::redraw_tabs(); + } + } + void Fl_DerivedTabs::client_area(int &rx, int &ry, int &rw, int &rh, int tabh){ + if (this->fs->tab_client_area != NULL) { + this->fs->tab_client_area((fl_Tabs)this, &rx,&ry,&rw,&rh,tabh); + } + else { + Fl_Tabs::client_area(rx,ry,rw,rh,tabh); + } + } #endif + FL_EXPORT_C(fl_Tab_Virtual_Funcs*, Fl_Tab_default_virtual_funcs)() { + fl_Tab_Virtual_Funcs* ptr = (fl_Tab_Virtual_Funcs*)malloc(sizeof(fl_Tab_Virtual_Funcs)); + ptr->tab_draw = NULL; + ptr->tab_positions = NULL; + ptr->tab_height = NULL; + ptr->tab_which = NULL; + ptr->redraw_tabs = NULL; + ptr->tab_client_area = NULL; + return ptr; + } FL_EXPORT_C(fl_Group,Fl_Tabs_parent)(fl_Tabs tabs){ - return (fl_Group) (static_cast(tabs))->parent(); + return (fl_Group) (static_cast(tabs))->parent(); } FL_EXPORT_C(void,Fl_Tabs_set_parent)(fl_Tabs tabs,fl_Group grp){ - (static_cast(tabs))->parent((static_cast(grp))); + (static_cast(tabs))->parent((static_cast(grp))); } FL_EXPORT_C(uchar,Fl_Tabs_type)(fl_Tabs tabs){ - return (static_cast(tabs))->type(); + return (static_cast(tabs))->type(); } FL_EXPORT_C(void,Fl_Tabs_set_type)(fl_Tabs tabs,uchar t){ - (static_cast(tabs))->type(t); + (static_cast(tabs))->type(t); } - FL_EXPORT_C(int,Fl_Tabs_x)(fl_Tabs tabs){ - return (static_cast(tabs))->x(); + return (static_cast(tabs))->x(); } FL_EXPORT_C(int,Fl_Tabs_y)(fl_Tabs tabs){ - return (static_cast(tabs))->y(); + return (static_cast(tabs))->y(); } FL_EXPORT_C(int,Fl_Tabs_w)(fl_Tabs tabs){ - return (static_cast(tabs))->w(); + return (static_cast(tabs))->w(); } FL_EXPORT_C(int,Fl_Tabs_h)(fl_Tabs tabs){ - return (static_cast(tabs))->h(); + return (static_cast(tabs))->h(); } FL_EXPORT_C(void,Fl_Tabs_set_align)(fl_Tabs tabs, Fl_Align alignment){ - (static_cast(tabs))->align(alignment); + (static_cast(tabs))->align(alignment); } FL_EXPORT_C(Fl_Align,Fl_Tabs_align)(fl_Tabs tabs){ - return (static_cast(tabs))->align(); + return (static_cast(tabs))->align(); } FL_EXPORT_C(Fl_Boxtype,Fl_Tabs_box)(fl_Tabs tabs){ - return (static_cast(tabs))->box(); + return (static_cast(tabs))->box(); } FL_EXPORT_C(void,Fl_Tabs_set_box)(fl_Tabs tabs,Fl_Boxtype new_box){ - (static_cast(tabs))->box((static_cast(new_box))); + (static_cast(tabs))->box((static_cast(new_box))); } FL_EXPORT_C(Fl_Color,Fl_Tabs_color)(fl_Tabs tabs){ - return (static_cast(tabs))->color(); + return (static_cast(tabs))->color(); } FL_EXPORT_C(void,Fl_Tabs_set_color)(fl_Tabs tabs,Fl_Color bg){ - (static_cast(tabs))->color(bg); + (static_cast(tabs))->color(bg); } FL_EXPORT_C(void,Fl_Tabs_set_color_with_bg_sel)(fl_Tabs tabs,Fl_Color bg,Fl_Color a){ - (static_cast(tabs))->color(bg,a); + (static_cast(tabs))->color(bg,a); } FL_EXPORT_C(Fl_Color,Fl_Tabs_selection_color)(fl_Tabs tabs){ - return (static_cast(tabs))->selection_color(); + return (static_cast(tabs))->selection_color(); } FL_EXPORT_C(void,Fl_Tabs_set_selection_color)(fl_Tabs tabs,Fl_Color a){ - (static_cast(tabs))->selection_color(a); + (static_cast(tabs))->selection_color(a); } FL_EXPORT_C(const char*,Fl_Tabs_label)(fl_Tabs tabs){ - return (static_cast(tabs))->label(); + return (static_cast(tabs))->label(); } FL_EXPORT_C(void,Fl_Tabs_copy_label)(fl_Tabs tabs,const char* new_label){ - (static_cast(tabs))->copy_label(new_label); + (static_cast(tabs))->copy_label(new_label); } FL_EXPORT_C(void,Fl_Tabs_set_label)(fl_Tabs tabs,const char* text){ - (static_cast(tabs))->label(text); + (static_cast(tabs))->label(text); } FL_EXPORT_C(Fl_Labeltype,Fl_Tabs_labeltype)(fl_Tabs tabs){ - return (static_cast(tabs))->labeltype(); + return (static_cast(tabs))->labeltype(); } FL_EXPORT_C(void,Fl_Tabs_set_labeltype)(fl_Tabs tabs,Fl_Labeltype a){ - (static_cast(tabs))->labeltype(a); + (static_cast(tabs))->labeltype(a); } FL_EXPORT_C(void,Fl_Tabs_set_labelcolor)(fl_Tabs tabs,Fl_Color c){ - (static_cast(tabs))->labelcolor(c); + (static_cast(tabs))->labelcolor(c); } FL_EXPORT_C(Fl_Color ,Fl_Tabs_labelcolor)(fl_Tabs tabs){ - return (static_cast(tabs))->labelcolor(); + return (static_cast(tabs))->labelcolor(); } FL_EXPORT_C(fl_Image,Fl_Tabs_image)(fl_Tabs tabs){ - return (static_cast(tabs))->image(); + return (static_cast(tabs))->image(); } FL_EXPORT_C(void,Fl_Tabs_set_image)(fl_Tabs tabs,fl_Image pix){ - (static_cast(tabs))->image((static_cast(pix))); + (static_cast(tabs))->image((static_cast(pix))); } FL_EXPORT_C(fl_Image,Fl_Tabs_deimage)(fl_Tabs tabs){ - return (static_cast(tabs))->deimage(); + return (static_cast(tabs))->deimage(); } FL_EXPORT_C(void,Fl_Tabs_set_deimage)(fl_Tabs tabs,fl_Image pix){ - (static_cast(tabs))->deimage((static_cast(pix))); + (static_cast(tabs))->deimage((static_cast(pix))); } FL_EXPORT_C(const char*,Fl_Tabs_tooltip)(fl_Tabs tabs){ - return (static_cast(tabs))->tooltip(); + return (static_cast(tabs))->tooltip(); } FL_EXPORT_C(void,Fl_Tabs_copy_tooltip)(fl_Tabs tabs,const char* text){ - (static_cast(tabs))->copy_tooltip(text); + (static_cast(tabs))->copy_tooltip(text); } FL_EXPORT_C(void,Fl_Tabs_set_tooltip)(fl_Tabs tabs,const char* text){ - (static_cast(tabs))->tooltip(text); + (static_cast(tabs))->tooltip(text); } FL_EXPORT_C(void,Fl_Tabs_set_callback_with_user_data)(fl_Tabs tabs,fl_Callback* cb,void* p){ - Fl_Tabs* castedButton = (static_cast(tabs)); + Fl_Tabs* castedButton = (static_cast(tabs)); new C_to_Fl_Callback(castedButton, cb, p); } FL_EXPORT_C(void,Fl_Tabs_set_callback)(fl_Tabs tabs,fl_Callback* cb){ - Fl_Tabs* castedButton = (static_cast(tabs)); + Fl_Tabs* castedButton = (static_cast(tabs)); new C_to_Fl_Callback(castedButton, cb); } FL_EXPORT_C(void*,Fl_Tabs_user_data)(fl_Tabs tabs){ - C_to_Fl_Callback* stored_cb = (static_cast((static_cast(tabs))->user_data())); + C_to_Fl_Callback* stored_cb = (static_cast((static_cast(tabs))->user_data())); if(stored_cb){ return stored_cb->get_user_data(); } else { - return (static_cast(tabs))->user_data(); + return (static_cast(tabs))->user_data(); } } FL_EXPORT_C(void,Fl_Tabs_set_user_data)(fl_Tabs tabs,void* v){ - C_to_Fl_Callback* stored_cb = (static_cast((static_cast(tabs))->user_data())); + C_to_Fl_Callback* stored_cb = (static_cast((static_cast(tabs))->user_data())); if (stored_cb) { stored_cb->set_user_data(v); - (static_cast(tabs))->user_data(stored_cb); + (static_cast(tabs))->user_data(stored_cb); } else { - (static_cast(tabs))->user_data(v); + (static_cast(tabs))->user_data(v); } } FL_EXPORT_C(long,Fl_Tabs_argument)(fl_Tabs tabs){ - return (static_cast(tabs))->argument(); + return (static_cast(tabs))->argument(); } FL_EXPORT_C(void,Fl_Tabs_set_argument)(fl_Tabs tabs,long v){ - (static_cast(tabs))->argument(v); + (static_cast(tabs))->argument(v); } FL_EXPORT_C(Fl_When,Fl_Tabs_when)(fl_Tabs tabs){ - return (static_cast(tabs))->when(); + return (static_cast(tabs))->when(); } FL_EXPORT_C(void,Fl_Tabs_set_when)(fl_Tabs tabs,uchar i){ - (static_cast(tabs))->when(i); + (static_cast(tabs))->when(i); } FL_EXPORT_C(unsigned int,Fl_Tabs_visible)(fl_Tabs tabs){ - return (static_cast(tabs))->visible(); + return (static_cast(tabs))->visible(); } FL_EXPORT_C(int,Fl_Tabs_visible_r)(fl_Tabs tabs){ - return (static_cast(tabs))->visible_r(); + return (static_cast(tabs))->visible_r(); } FL_EXPORT_C(void,Fl_Tabs_set_visible)(fl_Tabs tabs){ - (static_cast(tabs))->visible(); + (static_cast(tabs))->visible(); } FL_EXPORT_C(void,Fl_Tabs_clear_visible)(fl_Tabs tabs){ - (static_cast(tabs))->clear_visible(); + (static_cast(tabs))->clear_visible(); } FL_EXPORT_C(unsigned int,Fl_Tabs_active)(fl_Tabs tabs){ - return (static_cast(tabs))->active(); + return (static_cast(tabs))->active(); } FL_EXPORT_C(int,Fl_Tabs_active_r)(fl_Tabs tabs){ - return (static_cast(tabs))->active_r(); + return (static_cast(tabs))->active_r(); } FL_EXPORT_C(void,Fl_Tabs_activate)(fl_Tabs tabs){ - (static_cast(tabs))->activate(); + (static_cast(tabs))->activate(); } FL_EXPORT_C(void,Fl_Tabs_deactivate)(fl_Tabs tabs){ - (static_cast(tabs))->deactivate(); + (static_cast(tabs))->deactivate(); } FL_EXPORT_C(unsigned int,Fl_Tabs_output)(fl_Tabs tabs){ - return (static_cast(tabs))->output(); + return (static_cast(tabs))->output(); } FL_EXPORT_C(void,Fl_Tabs_set_output)(fl_Tabs tabs){ - (static_cast(tabs))->output(); + (static_cast(tabs))->output(); } FL_EXPORT_C(void,Fl_Tabs_clear_output)(fl_Tabs tabs){ - (static_cast(tabs))->clear_output(); + (static_cast(tabs))->clear_output(); } FL_EXPORT_C(unsigned int,Fl_Tabs_takesevents)(fl_Tabs tabs){ - return (static_cast(tabs))->takesevents(); + return (static_cast(tabs))->takesevents(); } FL_EXPORT_C(void,Fl_Tabs_set_changed)(fl_Tabs tabs){ - (static_cast(tabs))->changed(); + (static_cast(tabs))->changed(); } FL_EXPORT_C(void,Fl_Tabs_clear_changed)(fl_Tabs tabs){ - (static_cast(tabs))->clear_changed(); + (static_cast(tabs))->clear_changed(); } FL_EXPORT_C(int,Fl_Tabs_take_focus)(fl_Tabs tabs){ - return (static_cast(tabs))->take_focus(); + return (static_cast(tabs))->take_focus(); } FL_EXPORT_C(void,Fl_Tabs_set_visible_focus)(fl_Tabs tabs){ - (static_cast(tabs))->set_visible_focus(); + (static_cast(tabs))->set_visible_focus(); } FL_EXPORT_C(void,Fl_Tabs_clear_visible_focus)(fl_Tabs tabs){ - (static_cast(tabs))->clear_visible_focus(); + (static_cast(tabs))->clear_visible_focus(); } FL_EXPORT_C(void,Fl_Tabs_modify_visible_focus)(fl_Tabs tabs,int v){ - (static_cast(tabs))->visible_focus(v); + (static_cast(tabs))->visible_focus(v); } FL_EXPORT_C(unsigned int,Fl_Tabs_visible_focus)(fl_Tabs tabs){ - return (static_cast(tabs))->visible_focus(); + return (static_cast(tabs))->visible_focus(); } FL_EXPORT_C(void,Fl_Tabs_do_callback)(fl_Tabs tabs){ - (static_cast(tabs))->do_callback(); + (static_cast(tabs))->do_callback(); } FL_EXPORT_C(void,Fl_Tabs_do_callback_with_widget_and_user_data)(fl_Tabs tabs,fl_Widget w,long arg){ - (static_cast(tabs))->do_callback((static_cast(w)),arg); + (static_cast(tabs))->do_callback((static_cast(w)),arg); } FL_EXPORT_C(void,Fl_Tabs_do_callback_with_widget_and_default_user_data)(fl_Tabs tabs,fl_Widget w){ - (static_cast(tabs))->do_callback((static_cast(w))); + (static_cast(tabs))->do_callback((static_cast(w))); } FL_EXPORT_C(int,Fl_Tabs_contains)(fl_Tabs tabs,fl_Widget w){ - return (static_cast(tabs))->contains((static_cast(w))); + return (static_cast(tabs))->contains((static_cast(w))); } FL_EXPORT_C(int,Fl_Tabs_inside)(fl_Tabs tabs,fl_Widget w){ - return (static_cast(tabs))->inside((static_cast(w))); + return (static_cast(tabs))->inside((static_cast(w))); } FL_EXPORT_C(void,Fl_Tabs_redraw)(fl_Tabs tabs){ - (static_cast(tabs))->redraw(); + (static_cast(tabs))->redraw(); } FL_EXPORT_C(void,Fl_Tabs_redraw_label)(fl_Tabs tabs){ - (static_cast(tabs))->redraw_label(); + (static_cast(tabs))->redraw_label(); } FL_EXPORT_C(uchar,Fl_Tabs_damage)(fl_Tabs tabs){ - return (static_cast(tabs))->damage(); + return (static_cast(tabs))->damage(); } FL_EXPORT_C(void,Fl_Tabs_clear_damage_with_bitmask)(fl_Tabs tabs,uchar c){ - (static_cast(tabs))->clear_damage(c); + (static_cast(tabs))->clear_damage(c); } FL_EXPORT_C(void,Fl_Tabs_clear_damage)(fl_Tabs tabs){ - (static_cast(tabs))->clear_damage(); + (static_cast(tabs))->clear_damage(); } FL_EXPORT_C(void,Fl_Tabs_damage_with_text)(fl_Tabs tabs,uchar c){ - (static_cast(tabs))->damage(c); + (static_cast(tabs))->damage(c); } FL_EXPORT_C(void,Fl_Tabs_damage_inside_widget)(fl_Tabs tabs,uchar c,int x,int y,int w,int h){ - (static_cast(tabs))->damage(c,x,y,w,h); + (static_cast(tabs))->damage(c,x,y,w,h); } FL_EXPORT_C(void,Fl_Tabs_draw_label_with_xywh_alignment)(fl_Tabs tabs,int x,int y,int w,int h,Fl_Align alignment){ - (static_cast(tabs))->draw_label(x,y,w,h,alignment); + (static_cast(tabs))->draw_label(x,y,w,h,alignment); } FL_EXPORT_C(void,Fl_Tabs_measure_label)(fl_Tabs tabs,int* ww,int* hh){ - (static_cast(tabs))->measure_label(*ww,*hh); + (static_cast(tabs))->measure_label(*ww,*hh); } FL_EXPORT_C(fl_Window, Fl_Tabs_window)(fl_Tabs tabs){ - return (fl_Window) (static_cast(tabs))->window(); + return (fl_Window) (static_cast(tabs))->window(); } FL_EXPORT_C(fl_Window, Fl_Tabs_top_window)(fl_Tabs tabs){ - return (fl_Window) (static_cast(tabs))->top_window(); + return (fl_Window) (static_cast(tabs))->top_window(); } FL_EXPORT_C(fl_Window , Fl_Tabs_top_window_offset)(fl_Tabs tabs, int* xoff, int* yoff){ - return (fl_Window) (static_cast(tabs))->top_window_offset(*xoff,*yoff); + return (fl_Window) (static_cast(tabs))->top_window_offset(*xoff,*yoff); } FL_EXPORT_C(fl_Group,Fl_Tabs_as_group)(fl_Tabs tabs){ - return (fl_Group) (static_cast(tabs))->as_group(); + return (fl_Group) (static_cast(tabs))->as_group(); } FL_EXPORT_C(fl_Gl_Window,Fl_Tabs_as_gl_window)(fl_Tabs tabs){ - return (fl_Gl_Window) (static_cast(tabs))->as_gl_window(); + return (fl_Gl_Window) (static_cast(tabs))->as_gl_window(); } FL_EXPORT_C(void,Fl_Tabs_begin)(fl_Tabs tabs){ - (static_cast(tabs))->begin(); + (static_cast(tabs))->begin(); } FL_EXPORT_C(void,Fl_Tabs_end)(fl_Tabs tabs){ - (static_cast(tabs))->end(); + (static_cast(tabs))->end(); } FL_EXPORT_C(int,Fl_Tabs_find)(fl_Tabs tabs,fl_Widget w){ - return (static_cast(tabs))->find(static_cast(w)); + return (static_cast(tabs))->find(static_cast(w)); } FL_EXPORT_C(void,Fl_Tabs_set_resizable_by_reference)(fl_Tabs tabs,fl_Widget o){ - (static_cast(tabs))->resizable((static_cast(o))); + (static_cast(tabs))->resizable((static_cast(o))); } FL_EXPORT_C(void,Fl_Tabs_set_resizable)(fl_Tabs tabs,fl_Widget o){ - (static_cast(tabs))->resizable((static_cast(o))); + (static_cast(tabs))->resizable((static_cast(o))); } FL_EXPORT_C(fl_Widget,Fl_Tabs_resizable)(fl_Tabs tabs){ - return (static_cast(tabs))->resizable(); + return (static_cast(tabs))->resizable(); } FL_EXPORT_C(void,Fl_Tabs_add_resizable)(fl_Tabs tabs,fl_Widget o){ - return (static_cast(tabs))->add_resizable(*(static_cast(o))); + return (static_cast(tabs))->add_resizable(*(static_cast(o))); } FL_EXPORT_C(void,Fl_Tabs_init_sizes)(fl_Tabs tabs){ - (static_cast(tabs))->init_sizes(); + (static_cast(tabs))->init_sizes(); } FL_EXPORT_C(void,Fl_Tabs_set_clip_children)(fl_Tabs tabs,int c){ - return (static_cast(tabs))->clip_children(c); + return (static_cast(tabs))->clip_children(c); } FL_EXPORT_C(int,Fl_Tabs_children)(fl_Tabs tabs){ - return (static_cast(tabs))->children(); + return (static_cast(tabs))->children(); } FL_EXPORT_C(unsigned int,Fl_Tabs_clip_children)(fl_Tabs tabs){ - return (static_cast(tabs))->clip_children(); + return (static_cast(tabs))->clip_children(); } FL_EXPORT_C(void,Fl_Tabs_focus)(fl_Tabs tabs, fl_Widget W){ - return (static_cast(tabs))->focus((static_cast(W))); + return (static_cast(tabs))->focus((static_cast(W))); } FL_EXPORT_C(fl_Widget,Fl_Tabs__ddfdesign_kludge)(fl_Tabs tabs){ - return (static_cast(tabs))->_ddfdesign_kludge(); + return (static_cast(tabs))->_ddfdesign_kludge(); } FL_EXPORT_C(fl_Widget*, Fl_Tabs_array)(fl_Tabs self){ - return (fl_Widget*)(static_cast(self))->array(); + return (fl_Widget*)(static_cast(self))->array(); } FL_EXPORT_C(fl_Widget, Fl_Tabs_child)(fl_Tabs self, int n){ - return (fl_Widget)(static_cast(self))->child(n); + return (fl_Widget)(static_cast(self))->child(n); } FL_EXPORT_C(fl_Widget,Fl_Tabs_value)(fl_Tabs tabs){ - return (fl_Widget)(static_cast(tabs))->value(); + return (fl_Widget)(static_cast(tabs))->value(); } FL_EXPORT_C(int,Fl_Tabs_set_value)(fl_Tabs tabs,fl_Widget w){ - return (static_cast(tabs))->value((static_cast(w))); + return (static_cast(tabs))->value((static_cast(w))); } FL_EXPORT_C(fl_Widget,Fl_Tabs_push)(fl_Tabs tabs){ - return (fl_Widget)(static_cast(tabs))->push(); + return (fl_Widget)(static_cast(tabs))->push(); } FL_EXPORT_C(int,Fl_Tabs_set_push)(fl_Tabs tabs,fl_Widget w){ - return (static_cast(tabs))->push((static_cast(w))); + return (static_cast(tabs))->push((static_cast(w))); } FL_EXPORT_C(fl_Widget,Fl_Tabs_which)(fl_Tabs tabs,int event_x,int event_y){ - return (fl_Widget)(static_cast(tabs))->which(event_x,event_y); + return (fl_Widget)(static_cast(tabs))->which(event_x,event_y); } FL_EXPORT_C(void,Fl_Tabs_client_area)(fl_Tabs tabs,int* rx,int* ry,int* rw,int* rh){ - (static_cast(tabs))->client_area(*rx,*ry,*rw,*rh); + (static_cast(tabs))->client_area(*rx,*ry,*rw,*rh,0); } FL_EXPORT_C(void,Fl_Tabs_client_area_with_tabh)(fl_Tabs tabs,int* rx,int* ry,int* rw,int* rh,int tabh){ - (static_cast(tabs))->client_area(*rx,*ry,*rw,*rh,tabh); + (static_cast(tabs))->client_area(*rx,*ry,*rw,*rh,tabh); } FL_EXPORT_C(void, Fl_Tabs_draw)(fl_Tabs o){ (static_cast(o))->draw(); @@ -422,23 +486,36 @@ } FL_EXPORT_C(fl_Tabs, Fl_Tabs_New)(int X, int Y, int W, int H){ fl_Widget_Virtual_Funcs* fs = Fl_Widget_default_virtual_funcs(); - Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,fs); + fl_Tab_Virtual_Funcs* tfs = Fl_Tab_default_virtual_funcs(); + Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,tfs,fs); return (fl_Tabs)w; } FL_EXPORT_C(fl_Tabs, Fl_Tabs_New_WithLabel)(int X, int Y, int W, int H, const char* label){ fl_Widget_Virtual_Funcs* fs = Fl_Widget_default_virtual_funcs(); - Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,label,fs); + fl_Tab_Virtual_Funcs* tfs = Fl_Tab_default_virtual_funcs(); + Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,label,tfs,fs); return (fl_Tabs)w; } - FL_EXPORT_C(fl_Tabs, Fl_OverriddenTabs_New)(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs){ - Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,fs); + FL_EXPORT_C(fl_Tabs, Fl_OverriddenTabs_New)(int X, int Y, int W, int H,fl_Tab_Virtual_Funcs* tfs, fl_Widget_Virtual_Funcs* fs){ + Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,tfs,fs); return (fl_Tabs)w; } - FL_EXPORT_C(fl_Tabs, Fl_OverriddenTabs_New_WithLabel)(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs){ - Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,label,fs); + FL_EXPORT_C(fl_Tabs, Fl_OverriddenTabs_New_WithLabel)(int X, int Y, int W, int H, const char* label, fl_Tab_Virtual_Funcs* tfs, fl_Widget_Virtual_Funcs* fs){ + Fl_DerivedTabs* w = new Fl_DerivedTabs(X,Y,W,H,label,tfs,fs); return (fl_Tabs)w; } - + FL_EXPORT_C(int,Fl_Tabs_tab_positions)(fl_Tabs tabs){ + return (static_cast(tabs))->tab_positions(); + } + FL_EXPORT_C(int,Fl_Tabs_tab_height)(fl_Tabs tabs) { + return (static_cast(tabs))->tab_height(); + } + FL_EXPORT_C(Fl_Align,Fl_Tabs_get_tab_align)(fl_Tabs o){ + return (static_cast(o))->tab_align(); + } + FL_EXPORT_C(void,Fl_Tabs_set_tab_align)(fl_Tabs o, Fl_Align a){ + (static_cast(o))->tab_align(a); + } #ifdef __cplusplus } #endif diff --git a/c-src/Fl_TabsC.h b/c-src/Fl_TabsC.h --- a/c-src/Fl_TabsC.h +++ b/c-src/Fl_TabsC.h @@ -11,6 +11,7 @@ EXPORT { class Fl_DerivedTabs : public Fl_Tabs { fl_Widget_Virtual_Funcs* overriddenFuncs; + fl_Tab_Virtual_Funcs* fs; void* other_data; public: virtual void draw(); @@ -23,12 +24,18 @@ void show_super(); virtual void hide(); void hide_super(); - Fl_DerivedTabs(int X, int Y, int W, int H, const char *l, fl_Widget_Virtual_Funcs* funcs); - Fl_DerivedTabs(int X, int Y, int W, int H, fl_Widget_Virtual_Funcs* funcs); + int tab_positions(); + int tab_height(); + Fl_Widget* which(int,int); + void client_area(int &rx, int &ry, int &rw, int &rh, int tabh); + void redraw_tabs(); + Fl_DerivedTabs(int X, int Y, int W, int H, const char *l, fl_Tab_Virtual_Funcs* fs, fl_Widget_Virtual_Funcs* funcs); + Fl_DerivedTabs(int X, int Y, int W, int H, fl_Tab_Virtual_Funcs* fs, fl_Widget_Virtual_Funcs* funcs); ~Fl_DerivedTabs(); }; #endif + FL_EXPORT_C_HEADER(fl_Tab_Virtual_Funcs*,Fl_Tab_default_virtual_funcs,()); /* Inherited from Fl_Widget */ FL_EXPORT_C_HEADER(int,Fl_Tabs_handle,(fl_Tabs self, int event)); FL_EXPORT_C_HEADER(fl_Group,Fl_Tabs_parent,(fl_Tabs tabs)); @@ -144,8 +151,8 @@ FL_EXPORT_C_HEADER(fl_Widget,Fl_Tabs_which,(fl_Tabs tabs, int event_x, int event_y)); FL_EXPORT_C_HEADER(void,Fl_Tabs_client_area,(fl_Tabs tabs, int* rx, int* ry, int* rw, int* rh)); FL_EXPORT_C_HEADER(void,Fl_Tabs_client_area_with_tabh,(fl_Tabs tabs, int* rx, int* ry, int* rw, int* rh, int tabh)); - FL_EXPORT_C_HEADER(fl_Tabs,Fl_OverriddenTabs_New,(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs)); - FL_EXPORT_C_HEADER(fl_Tabs,Fl_OverriddenTabs_New_WithLabel,(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs)); + FL_EXPORT_C_HEADER(fl_Tabs,Fl_OverriddenTabs_New,(int X, int Y, int W, int H,fl_Tab_Virtual_Funcs* tfs,fl_Widget_Virtual_Funcs* fs)); + FL_EXPORT_C_HEADER(fl_Tabs,Fl_OverriddenTabs_New_WithLabel,(int X, int Y, int W, int H, const char* label,fl_Tab_Virtual_Funcs* tfs,fl_Widget_Virtual_Funcs* fs)); FL_EXPORT_C_HEADER(void,Fl_Tabs_draw,(fl_Tabs o)); FL_EXPORT_C_HEADER(void,Fl_Tabs_draw_super,(fl_Tabs o)); FL_EXPORT_C_HEADER(int,Fl_Tabs_handle,(fl_Tabs o, int event)); @@ -156,6 +163,10 @@ FL_EXPORT_C_HEADER(void,Fl_Tabs_show_super,(fl_Tabs o)); FL_EXPORT_C_HEADER(void,Fl_Tabs_hide,(fl_Tabs o)); FL_EXPORT_C_HEADER(void,Fl_Tabs_hide_super,(fl_Tabs o)); + FL_EXPORT_C_HEADER(int,Fl_Tabs_tab_positions,(fl_Tabs o)); + FL_EXPORT_C_HEADER(int,Fl_Tabs_tab_height,(fl_Tabs o)); + FL_EXPORT_C_HEADER(Fl_Align,Fl_Tabs_get_tab_align,(fl_Tabs o)); + FL_EXPORT_C_HEADER(void,Fl_Tabs_set_tab_align,(fl_Tabs o, Fl_Align a)); #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Text_DisplayC.cpp b/c-src/Fl_Text_DisplayC.cpp --- a/c-src/Fl_Text_DisplayC.cpp +++ b/c-src/Fl_Text_DisplayC.cpp @@ -503,17 +503,7 @@ return (static_cast(text_display))->word_end(pos); } FL_EXPORT_C(void,Fl_Text_Display_highlight_data)(fl_Text_Display text_display,fl_Text_Buffer styleBuffer,Style_Table_Entry *styleTable,int nStyles,char unfinishedStyle,Unfinished_Style_Cb unfinishedHighlightCB,void *cbArg){ - Fl_Text_Display::Style_Table_Entry* s = new Fl_Text_Display::Style_Table_Entry[nStyles](); - int i = 0; - for (;i(text_display))->highlight_data((static_cast(styleBuffer)),s,nStyles,unfinishedStyle,unfinishedHighlightCB,cbArg); + (static_cast(text_display))->highlight_data((static_cast(styleBuffer)),(static_cast((void*) styleTable)),nStyles,unfinishedStyle,unfinishedHighlightCB,cbArg); } FL_EXPORT_C(int,Fl_Text_Display_position_style)(fl_Text_Display text_display,int lineStartPos,int lineLen,int lineIndex){ return (static_cast(text_display))->position_style(lineStartPos,lineLen,lineIndex); diff --git a/c-src/Fl_Text_EditorC.cpp b/c-src/Fl_Text_EditorC.cpp --- a/c-src/Fl_Text_EditorC.cpp +++ b/c-src/Fl_Text_EditorC.cpp @@ -458,17 +458,7 @@ return (static_cast(text_editor))->word_end(pos); } FL_EXPORT_C(void,Fl_Text_Editor_highlight_data)(fl_Text_Editor text_editor,fl_Text_Buffer styleBuffer,Style_Table_Entry *styleTable,int nStyles,char unfinishedStyle,Unfinished_Style_Cb unfinishedHighlightCB,void *cbArg){ - Fl_Text_Editor::Style_Table_Entry* s = new Fl_Text_Editor::Style_Table_Entry[nStyles](); - int i = 0; - for (;i(text_editor))->highlight_data((static_cast(styleBuffer)),s,nStyles,unfinishedStyle,unfinishedHighlightCB,cbArg); + (static_cast(text_editor))->highlight_data((static_cast(styleBuffer)),(static_cast((void*) styleTable)),nStyles,unfinishedStyle,unfinishedHighlightCB,cbArg); } FL_EXPORT_C(int,Fl_Text_Editor_position_style)(fl_Text_Editor text_editor,int lineStartPos,int lineLen,int lineIndex){ return (static_cast(text_editor))->position_style(lineStartPos,lineLen,lineIndex); diff --git a/c-src/Fl_TooltipC.cpp b/c-src/Fl_TooltipC.cpp --- a/c-src/Fl_TooltipC.cpp +++ b/c-src/Fl_TooltipC.cpp @@ -20,6 +20,9 @@ FL_EXPORT_C(void,Fl_Tooltip_enable_with_b)(int b){ Fl_Tooltip::enable(b); } + FL_EXPORT_C(int,Fl_Tooltip_enabled)(){ + return Fl_Tooltip::enabled(); + } FL_EXPORT_C(void,Fl_Tooltip_disable)( ){ Fl_Tooltip::disable(); } @@ -56,7 +59,6 @@ FL_EXPORT_C(void,Fl_Tooltip_set_textcolor)(Fl_Color c){ Fl_Tooltip::textcolor(c); } -#if FLTK_ABI_VERSION >= 10301 FL_EXPORT_C(int,Fl_Tooltip_margin_width)( ){ return Fl_Tooltip::margin_width(); } @@ -75,22 +77,11 @@ FL_EXPORT_C(void,Fl_Tooltip_set_wrap_width)(int v){ Fl_Tooltip::wrap_width(v); } -#else - FL_EXPORT_C(int,Fl_Tooltip_margin_width)( ){ - return Fl_Tooltip::margin_width(); - } - FL_EXPORT_C(int,Fl_Tooltip_margin_height)( ){ - return Fl_Tooltip::margin_height(); - } - FL_EXPORT_C(int,Fl_Tooltip_wrap_width)( ){ - return Fl_Tooltip::wrap_width(); - } -#endif #ifdef __APPLE__ FL_EXPORT_C(fl_Window,Fl_Tooltip_current_window)(void ){ return (fl_Window)Fl_Tooltip::current_window(); } -#endif +#endif #ifdef __cplusplus } #endif diff --git a/c-src/Fl_TooltipC.h b/c-src/Fl_TooltipC.h --- a/c-src/Fl_TooltipC.h +++ b/c-src/Fl_TooltipC.h @@ -30,18 +30,12 @@ FL_EXPORT_C_HEADER(void,Fl_Tooltip_set_color,(Fl_Color c)); FL_EXPORT_C_HEADER(Fl_Color,Fl_Tooltip_textcolor,()); FL_EXPORT_C_HEADER(void,Fl_Tooltip_set_textcolor,(Fl_Color c)); -#if FLTK_ABI_VERSION >= 10301 FL_EXPORT_C_HEADER(int,Fl_Tooltip_margin_width,()); FL_EXPORT_C_HEADER(void,Fl_Tooltip_set_margin_width,(int v)); FL_EXPORT_C_HEADER(int,Fl_Tooltip_margin_height,()); FL_EXPORT_C_HEADER(void,Fl_Tooltip_set_margin_height,(int v)); FL_EXPORT_C_HEADER(int,Fl_Tooltip_wrap_width,()); FL_EXPORT_C_HEADER(void,Fl_Tooltip_set_wrap_width,(int v)); -#else - FL_EXPORT_C_HEADER(int,Fl_Tooltip_margin_width,()); - FL_EXPORT_C_HEADER(int,Fl_Tooltip_margin_height,()); - FL_EXPORT_C_HEADER(int,Fl_Tooltip_wrap_width,()); -#endif #ifdef __APPLE__ FL_EXPORT_C_HEADER(fl_Window,Fl_Tooltip_current_window,(void)); #endif diff --git a/c-src/Fl_TreeC.cpp b/c-src/Fl_TreeC.cpp --- a/c-src/Fl_TreeC.cpp +++ b/c-src/Fl_TreeC.cpp @@ -601,14 +601,12 @@ FL_EXPORT_C(void,Fl_Tree_set_margintop)(fl_Tree tree,int val){ return (static_cast(tree))->margintop(val); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(int,Fl_Tree_marginbottom)(fl_Tree tree){ return (static_cast(tree))->marginbottom(); } FL_EXPORT_C(void,Fl_Tree_set_marginbottom)(fl_Tree tree,int val){ (static_cast(tree))->marginbottom(val); } -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C(int,Fl_Tree_linespacing)(fl_Tree tree){ return (static_cast(tree))->linespacing(); } @@ -633,14 +631,12 @@ FL_EXPORT_C(void,Fl_Tree_set_labelmarginleft)(fl_Tree tree,int val){ return (static_cast(tree))->labelmarginleft(val); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(int,Fl_Tree_widgetmarginleft)(fl_Tree tree){ return (static_cast(tree))->widgetmarginleft(); } FL_EXPORT_C(void,Fl_Tree_set_widgetmarginleft)(fl_Tree tree,int val){ return (static_cast(tree))->widgetmarginleft(val); } -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C(int,Fl_Tree_connectorwidth)(fl_Tree tree){ return (static_cast(tree))->connectorwidth(); } @@ -701,7 +697,6 @@ FL_EXPORT_C(void,Fl_Tree_set_selectmode)(fl_Tree tree,Fl_Tree_Select val){ (static_cast(tree))->selectmode(val); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(Fl_Tree_Item_Reselect_Mode,Fl_Tree_item_reselect_mode)(fl_Tree tree){ return (static_cast(tree))->item_reselect_mode(); } @@ -717,7 +712,6 @@ FL_EXPORT_C(void,Fl_Tree_set_item_draw_mode_with_int)(fl_Tree tree,int mode){ (static_cast(tree))->item_draw_mode(mode); } -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C(int,Fl_Tree_displayed)(fl_Tree tree,fl_Tree_Item item){ return (static_cast(tree))->displayed((static_cast(item))); } @@ -820,7 +814,9 @@ FL_EXPORT_C(void, Fl_Tree_hide_super)(fl_Tree o){ (static_cast(o))->hide_super(); } - + FL_EXPORT_C(void, Fl_Tree_recalc_tree)(fl_Tree o){ + (static_cast(o))->recalc_tree(); + } #ifdef __cplusplus } #endif diff --git a/c-src/Fl_TreeC.h b/c-src/Fl_TreeC.h --- a/c-src/Fl_TreeC.h +++ b/c-src/Fl_TreeC.h @@ -210,10 +210,8 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_set_marginleft,(fl_Tree tree,int val)); FL_EXPORT_C_HEADER(int,Fl_Tree_margintop,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_margintop,(fl_Tree tree,int val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(int,Fl_Tree_marginbottom,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_marginbottom,(fl_Tree tree,int val)); -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C_HEADER(int,Fl_Tree_linespacing,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_linespacing,(fl_Tree tree,int val)); FL_EXPORT_C_HEADER(int,Fl_Tree_openchild_marginbottom,(fl_Tree tree)); @@ -222,10 +220,8 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_set_usericonmarginleft,(fl_Tree tree,int val)); FL_EXPORT_C_HEADER(int,Fl_Tree_labelmarginleft,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_labelmarginleft,(fl_Tree tree,int val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(int,Fl_Tree_widgetmarginleft,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_widgetmarginleft,(fl_Tree tree,int val)); -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C_HEADER(int,Fl_Tree_connectorwidth,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_connectorwidth,(fl_Tree tree,int val)); FL_EXPORT_C_HEADER(fl_Image,Fl_Tree_usericon,(fl_Tree tree)); @@ -246,13 +242,11 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_set_selectbox,(fl_Tree tree,Fl_Boxtype val)); FL_EXPORT_C_HEADER(Fl_Tree_Select,Fl_Tree_selectmode,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_selectmode,(fl_Tree tree,Fl_Tree_Select val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(Fl_Tree_Item_Reselect_Mode,Fl_Tree_item_reselect_mode,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_item_reselect_mode,(fl_Tree tree,Fl_Tree_Item_Reselect_Mode mode)); FL_EXPORT_C_HEADER(Fl_Tree_Item_Draw_Mode,Fl_Tree_item_draw_mode,(fl_Tree tree)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_item_draw_mode,(fl_Tree tree,Fl_Tree_Item_Draw_Mode mode)); FL_EXPORT_C_HEADER(void,Fl_Tree_set_item_draw_mode_with_int,(fl_Tree tree,int mode)); -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C_HEADER(int,Fl_Tree_displayed,(fl_Tree tree,fl_Tree_Item item)); FL_EXPORT_C_HEADER(void,Fl_Tree_show_item_with_yoff,(fl_Tree tree,fl_Tree_Item item, int yoff)); FL_EXPORT_C_HEADER(void,Fl_Tree_show_item,(fl_Tree tree,fl_Tree_Item item)); @@ -284,6 +278,7 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_show_super,(fl_Tree o)); FL_EXPORT_C_HEADER(void,Fl_Tree_hide,(fl_Tree o)); FL_EXPORT_C_HEADER(void,Fl_Tree_hide_super,(fl_Tree o)); + FL_EXPORT_C_HEADER(void,Fl_Tree_recalc_tree, (fl_Tree o)); #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Tree_ItemC.cpp b/c-src/Fl_Tree_ItemC.cpp --- a/c-src/Fl_Tree_ItemC.cpp +++ b/c-src/Fl_Tree_ItemC.cpp @@ -26,12 +26,6 @@ FL_EXPORT_C(int,Fl_Tree_Item_h)(fl_Tree_Item tree_item){ return (static_cast(tree_item))->h(); } - FL_EXPORT_C(void,Fl_Tree_Item_draw)(fl_Tree_Item tree_item,int X,int *Y,int W,fl_Widget tree,fl_Tree_Item itemfocus,fl_Tree_Prefs prefs){ - (static_cast(tree_item))->draw(X,*Y,W,(static_cast(tree)),(static_cast(itemfocus)),(*(static_cast(prefs)))); - } - FL_EXPORT_C(void,Fl_Tree_Item_draw_with_lastchild)(fl_Tree_Item tree_item,int X,int *Y,int W,fl_Widget tree,fl_Tree_Item itemfocus,fl_Tree_Prefs prefs){ - (static_cast(tree_item))->draw(X,*Y,W,(static_cast(tree)),(static_cast(itemfocus)),(*(static_cast(prefs)))); - } FL_EXPORT_C(void,Fl_Tree_Item_show_self_with_indent)(fl_Tree_Item tree_item,char* indent){ (static_cast(tree_item))->show_self(indent); } diff --git a/c-src/Fl_Tree_ItemC.h b/c-src/Fl_Tree_ItemC.h --- a/c-src/Fl_Tree_ItemC.h +++ b/c-src/Fl_Tree_ItemC.h @@ -17,8 +17,6 @@ FL_EXPORT_C_HEADER(int,Fl_Tree_Item_y,(fl_Tree_Item tree_item)); FL_EXPORT_C_HEADER(int,Fl_Tree_Item_w,(fl_Tree_Item tree_item)); FL_EXPORT_C_HEADER(int,Fl_Tree_Item_h,(fl_Tree_Item tree_item)); - FL_EXPORT_C_HEADER(void,Fl_Tree_Item_draw,(fl_Tree_Item tree_item, int X, int *Y, int W, fl_Widget tree, fl_Tree_Item itemfocus, fl_Tree_Prefs prefs)); - FL_EXPORT_C_HEADER(void,Fl_Tree_Item_draw_with_lastchild,(fl_Tree_Item tree_item, int X, int *Y, int W, fl_Widget tree, fl_Tree_Item itemfocus, fl_Tree_Prefs prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Item_show_self_with_indent,(fl_Tree_Item tree_item, char* indent)); FL_EXPORT_C_HEADER(void,Fl_Tree_Item_show_self,(fl_Tree_Item tree_item)); FL_EXPORT_C_HEADER(void,Fl_Tree_Item_set_label,(fl_Tree_Item tree_item, char* val)); diff --git a/c-src/Fl_Tree_PrefsC.cpp b/c-src/Fl_Tree_PrefsC.cpp --- a/c-src/Fl_Tree_PrefsC.cpp +++ b/c-src/Fl_Tree_PrefsC.cpp @@ -70,14 +70,12 @@ FL_EXPORT_C(void,Fl_Tree_Prefs_set_margintop)(fl_Tree_Prefs tree_prefs,int val){ (static_cast(tree_prefs))->margintop(val); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(int,Fl_Tree_Prefs_marginbottom)(fl_Tree_Prefs tree_prefs){ return (static_cast(tree_prefs))->marginbottom(); } FL_EXPORT_C(void,Fl_Tree_Prefs_set_marginbottom)(fl_Tree_Prefs tree_prefs,int val){ (static_cast(tree_prefs))->marginbottom(val); } -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C(int,Fl_Tree_Prefs_openchild_marginbottom)(fl_Tree_Prefs tree_prefs){ return (static_cast(tree_prefs))->openchild_marginbottom(); } @@ -96,14 +94,12 @@ FL_EXPORT_C(void,Fl_Tree_Prefs_set_labelmarginleft)(fl_Tree_Prefs tree_prefs,int val){ (static_cast(tree_prefs))->labelmarginleft(val); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(int,Fl_Tree_Prefs_widgetmarginleft)(fl_Tree_Prefs tree_prefs){ return (static_cast(tree_prefs))->widgetmarginleft(); } FL_EXPORT_C(void,Fl_Tree_Prefs_set_widgetmarginleft)(fl_Tree_Prefs tree_prefs,int val){ (static_cast(tree_prefs))->widgetmarginleft(val); } -#endif FL_EXPORT_C(int,Fl_Tree_Prefs_linespacing)(fl_Tree_Prefs tree_prefs){ return (static_cast(tree_prefs))->linespacing(); } @@ -179,7 +175,6 @@ FL_EXPORT_C(void,Fl_Tree_Prefs_set_selectmode)(fl_Tree_Prefs tree_prefs,Fl_Tree_Select val){ (static_cast(tree_prefs))->selectmode(val); } -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C(Fl_Tree_Item_Reselect_Mode,Fl_Tree_Prefs_item_reselect_mode)(fl_Tree_Prefs tree_prefs){ return (static_cast(tree_prefs))->item_reselect_mode(); } @@ -192,7 +187,6 @@ FL_EXPORT_C(void,Fl_Tree_Prefs_set_item_draw_mode)(fl_Tree_Prefs tree_prefs,Fl_Tree_Item_Draw_Mode val){ (static_cast(tree_prefs))->item_draw_mode(val); } -#endif #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Tree_PrefsC.h b/c-src/Fl_Tree_PrefsC.h --- a/c-src/Fl_Tree_PrefsC.h +++ b/c-src/Fl_Tree_PrefsC.h @@ -5,6 +5,7 @@ // Fl_Widget is included transitively and needed for // the callback mechanism included below to work. #include "FL/Fl.H" +#include "FL/Fl_Image.H" #include "FL/Fl_Tree_Prefs.H" #include "Fl_CallbackC.h" EXPORT { @@ -17,13 +18,8 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_item_labelsize,(fl_Tree_Prefs tree_prefs, Fl_Fontsize val)); FL_EXPORT_C_HEADER(Fl_Color,Fl_Tree_Prefs_item_labelfgcolor,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_item_labelfgcolor,(fl_Tree_Prefs tree_prefs, Fl_Color val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(Fl_Color,Fl_Tree_Prefs_item_labelbgcolor,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_item_labelbgcolor,(fl_Tree_Prefs tree_prefs, Fl_Color val)); -#else /*FLTK_ABI_VERSION*/ - FL_EXPORT_C_HEADER(Fl_Color,Fl_Tree_Prefs_item_labelbgcolor,(fl_Tree_Prefs tree_prefs)); - FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_item_labelbgcolor,(fl_Tree_Prefs tree_prefs, Fl_Color val)); -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C_HEADER(Fl_Font,Fl_Tree_Prefs_labelfont,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_labelfont,(fl_Tree_Prefs tree_prefs, Fl_Font val)); FL_EXPORT_C_HEADER(Fl_Fontsize,Fl_Tree_Prefs_labelsize,(fl_Tree_Prefs tree_prefs)); @@ -36,20 +32,16 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_marginleft,(fl_Tree_Prefs tree_prefs, int val)); FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_margintop,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_margintop,(fl_Tree_Prefs tree_prefs, int val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_marginbottom,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_marginbottom,(fl_Tree_Prefs tree_prefs, int val)); -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_openchild_marginbottom,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_openchild_marginbottom,(fl_Tree_Prefs tree_prefs, int val)); FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_usericonmarginleft,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_usericonmarginleft,(fl_Tree_Prefs tree_prefs, int val)); FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_labelmarginleft,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_labelmarginleft,(fl_Tree_Prefs tree_prefs, int val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_widgetmarginleft,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_widgetmarginleft,(fl_Tree_Prefs tree_prefs, int val)); -#endif /*FLTK_ABI_VERSION*/ FL_EXPORT_C_HEADER(int,Fl_Tree_Prefs_linespacing,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_linespacing,(fl_Tree_Prefs tree_prefs, int val)); FL_EXPORT_C_HEADER(Fl_Color,Fl_Tree_Prefs_connectorcolor,(fl_Tree_Prefs tree_prefs)); @@ -75,12 +67,10 @@ FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_showroot,(fl_Tree_Prefs tree_prefs, int val)); FL_EXPORT_C_HEADER(Fl_Tree_Select,Fl_Tree_Prefs_selectmode,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_selectmode,(fl_Tree_Prefs tree_prefs, Fl_Tree_Select val)); -#if FLTK_ABI_VERSION >= 10302 FL_EXPORT_C_HEADER(Fl_Tree_Item_Reselect_Mode,Fl_Tree_Prefs_item_reselect_mode,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_item_reselect_mode,(fl_Tree_Prefs tree_prefs, Fl_Tree_Item_Reselect_Mode mode)); FL_EXPORT_C_HEADER(Fl_Tree_Item_Draw_Mode,Fl_Tree_Prefs_item_draw_mode,(fl_Tree_Prefs tree_prefs)); FL_EXPORT_C_HEADER(void,Fl_Tree_Prefs_set_item_draw_mode,(fl_Tree_Prefs tree_prefs, Fl_Tree_Item_Draw_Mode val)); -#endif /*FLTK_ABI_VERSION*/ #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Types.h b/c-src/Fl_Types.h --- a/c-src/Fl_Types.h +++ b/c-src/Fl_Types.h @@ -2,15 +2,8 @@ #define __FL_TYPES_H #include "FL/fl_types.h" #include "Fl_EnumerationsC.h" - -#if defined(WIN32) && !defined(__CYGWIN__) -# if defined(_WIN64) -# define FL_SOCKET unsigned __int64 -# else -# define FL_SOCKET int -# endif -#else -# define FL_SOCKET int +#if FL_API_VERSION >= 10400 +#include "FL/platform_types.h" #endif #ifdef _WIN64 #ifdef __GNUC__ @@ -85,9 +78,7 @@ FL_TREE_REASON_NONE=0, FL_TREE_REASON_SELECTED, FL_TREE_REASON_DESELECTED, -#if FLTK_ABI_VERSION >= 10302 FL_TREE_REASON_RESELECTED, -#endif FL_TREE_REASON_OPENED, FL_TREE_REASON_CLOSED, FL_TREE_REASON_DRAGGED @@ -356,15 +347,12 @@ typedef unsigned int Fl_Char; #endif /* INTERNAL_LINKAGE */ typedef void* ID; - typedef void* fl_Window; - typedef void* fl_Group; - typedef void* fl_Label; typedef void* fl_Adjuster; - typedef void* fl_Bitmap; typedef void* fl_BMP_Image; + typedef void* fl_Bitmap; typedef void* fl_Box; - typedef void* fl_Browser_; typedef void* fl_Browser; + typedef void* fl_Browser_; typedef void* fl_Button; typedef void* fl_Cairo; typedef void* fl_Cairo_Window; @@ -376,9 +364,10 @@ typedef void* fl_Color_Chooser; typedef void* fl_Copy_Surface; typedef void* fl_Counter; - typedef void* fl_Simple_Counter; typedef void* fl_Device; + typedef void* fl_Device_Plugin; typedef void* fl_Dial; + typedef void* fl_Display_Device; typedef void* fl_Double_Window; typedef void* fl_Export; typedef void* fl_File_Browser; @@ -396,9 +385,7 @@ typedef void* fl_Gl_Window; typedef void* fl_Glut_Window; typedef void* fl_Graphics_Driver; - typedef void* fl_Surface_Device; - typedef void* fl_Display_Device; - typedef void* fl_Device_Plugin; + typedef void* fl_Group; typedef void* fl_Help_Dialog; typedef void* fl_Help_View; typedef void* fl_Hold_Browser; @@ -408,16 +395,18 @@ typedef void* fl_Hor_Value_Slider; typedef void* fl_Image; typedef void* fl_Image_Surface; - typedef void* fl_Input_Choice; - typedef void* fl_Input_; typedef void* fl_Input; + typedef void* fl_Input_; + typedef void* fl_Input_Choice; typedef void* fl_Int_Input; typedef void* fl_JPEG_Image; + typedef void* fl_Label; typedef void* fl_Light_Button; typedef void* fl_Line_Dial; - typedef void* fl_Menu_Button; - typedef void* fl_Menu_; typedef void* fl_Menu; + typedef void* fl_Menu_; + typedef void* fl_Menu_Bar; + typedef void* fl_Menu_Button; typedef void* fl_Menu_Item; typedef void* fl_Menu_Window; typedef void* fl_Multi_Browser; @@ -429,37 +418,40 @@ typedef void* fl_Object; typedef void* fl_Output; typedef void* fl_Overlay_Window; + typedef void* fl_PNG_Image; + typedef void* fl_PNM_Image; typedef void* fl_Pack; typedef void* fl_Paged_Device; typedef void* fl_Pixmap; typedef void* fl_Plugin; - typedef void* fl_PNG_Image; - typedef void* fl_PNM_Image; typedef void* fl_Positioner; typedef void* fl_PostScript; typedef void* fl_Preferences; typedef void* fl_Printer; typedef void* fl_Progress; + typedef void* fl_RGB_Image; typedef void* fl_Radio_Button; typedef void* fl_Radio_Light_Button; typedef void* fl_Radio_Round_Button; + typedef void* fl_Region; + typedef void* fl_Region; typedef void* fl_Repeat_Button; typedef void* fl_Return_Button; - typedef void* fl_RGB_Image; typedef void* fl_Roller; typedef void* fl_Round_Button; typedef void* fl_Round_Clock; - typedef void* fl_Scrollbar; typedef void* fl_Scroll; + typedef void* fl_Scrollbar; typedef void* fl_Secret_Input; typedef void* fl_Select_Browser; typedef void* fl_Shared_Image; - typedef void* fl_show_input; typedef void* fl_Simple_Counter; + typedef void* fl_Simple_Terminal; typedef void* fl_Single_Window; typedef void* fl_Slider; typedef void* fl_Spinner; - typedef void* fl_Menu_Bar; + typedef void* fl_Surface_Device; + typedef void* fl_SVG_Image; typedef void* fl_Sys_Menu_Bar; typedef void* fl_Table; typedef void* fl_Table_Row; @@ -468,32 +460,35 @@ typedef void* fl_Text_Display; typedef void* fl_Text_Editor; typedef void* fl_Text_Selection; - typedef void* fl_Tiled_Image; typedef void* fl_Tile; + typedef void* fl_Tiled_Image; typedef void* fl_Timer; typedef void* fl_Toggle_Button; typedef void* fl_Toggle_Light_Button; typedef void* fl_Toggle_Round_Button; typedef void* fl_Tooltip; typedef void* fl_Tree; - typedef void* fl_Tree_Item_Array; typedef void* fl_Tree_Item; + typedef void* fl_Tree_Item_Array; typedef void* fl_Tree_Prefs; typedef void* fl_Valuator; typedef void* fl_Value_Input; typedef void* fl_Value_Output; typedef void* fl_Value_Slider; typedef void* fl_Widget; + typedef void* fl_Window; + typedef void* fl_Window_Handle; + typedef void* fl_Window_Handle; typedef void* fl_Wizard; typedef void* fl_XBM_Image; typedef void* fl_XPM_Image; - typedef void* fl_Region; - typedef void* fl_Window_Handle; + typedef void* fl_show_input; typedef void (fl_Callback )(fl_Widget, void*); typedef void (fl_Text_Buffer_Callback)(fl_Text_Buffer); typedef void (*Unfinished_Style_Cb)(int, void *); typedef void (fl_File_Chooser_Callback)(fl_File_Chooser,void*); typedef fl_Image (fl_Shared_Image_Handler)(const char *name, uchar *header,int headerlen); + typedef void (fl_Menu_Item_Draw)(fl_Menu_Item i, int x, int y, int w, int h, fl_Menu m, int selected); typedef struct Style_Table_Entry { Fl_Color color; Fl_Font font; @@ -642,6 +637,30 @@ /* Fl_Valuator specific */ int (*format )(fl_Valuator valuator, char* format); } fl_Valuator_Virtual_Funcs; + + typedef struct { + void (*tab_draw) (fl_Tabs tabs); + int (*tab_positions)(fl_Tabs tabs, int* tab_pos, int* tab_width); + int (*tab_height)(fl_Tabs); + fl_Widget (*tab_which)(fl_Tabs tabs, int x, int y); + void (*redraw_tabs)(fl_Tabs tabs); + void (*tab_client_area)(fl_Tabs, int *rx, int *ry, int *rw, int *rh, int tabh); + } fl_Tab_Virtual_Funcs; + + typedef struct { + int (*get_mode)(fl_Color_Chooser c); + void (*set_mode)(fl_Color_Chooser c,int newMode); + double (*hue)(fl_Color_Chooser c); + double (*saturation)(fl_Color_Chooser c); + double (*value)(fl_Color_Chooser c); + double (*r)(fl_Color_Chooser c); + double (*g)(fl_Color_Chooser c); + double (*b)(fl_Color_Chooser c); + int (*hsv)(fl_Color_Chooser c,double H, double S, double V); + int (*rgb)(fl_Color_Chooser c,double R, double G, double B); + } fl_Color_Chooser_Virtual_Funcs; + typedef fl_Color_Chooser_Virtual_Funcs fl_Color_Chooser_Virtual_Funcs; + typedef fl_Tab_Virtual_Funcs fl_Tab_Virtual_Funcs; typedef fl_Table_Virtual_Funcs fl_Table_Row_Virtual_Funcs; typedef fl_Widget_Virtual_Funcs fl_Button_Virtual_Funcs; typedef fl_Widget_Virtual_Funcs fl_Int_Input_Virtual_Funcs; diff --git a/c-src/Fl_WidgetC.cpp b/c-src/Fl_WidgetC.cpp --- a/c-src/Fl_WidgetC.cpp +++ b/c-src/Fl_WidgetC.cpp @@ -118,6 +118,15 @@ } return win; } +unsigned int Fl_DerivedWidget::flags() { + return Fl_Widget::flags(); +} +void Fl_DerivedWidget::set_flag(unsigned int f) { + Fl_Widget::set_flag(f); +} +void Fl_DerivedWidget::clear_flag(unsigned int f) { + Fl_Widget::clear_flag(f); +} EXPORT { #endif FL_EXPORT_C(fl_Widget_Virtual_Funcs*, Fl_Widget_default_virtual_funcs)(){ @@ -480,6 +489,15 @@ FL_EXPORT_C(void, Fl_Widget_Destroy)(fl_Widget widget){ delete (static_cast(widget)); } + FL_EXPORT_C(unsigned int, Fl_Widget_flags)(fl_Widget widget){ + return (static_cast(widget))->flags(); + }; + FL_EXPORT_C(void, Fl_Widget_set_flag)(fl_Widget widget, unsigned int flag){ + (static_cast(widget))->set_flag(flag); + }; + FL_EXPORT_C(void, Fl_Widget_clear_flag)(fl_Widget widget, unsigned int flag){ + (static_cast(widget))->clear_flag(flag); + }; #ifdef __cplusplus } #endif diff --git a/c-src/Fl_WidgetC.h b/c-src/Fl_WidgetC.h --- a/c-src/Fl_WidgetC.h +++ b/c-src/Fl_WidgetC.h @@ -22,6 +22,9 @@ void draw_focus(Fl_Boxtype t, int x,int y,int w,int h); void draw_label(); void draw_label(int x,int y,int w,int h,Fl_Align alignment); + void set_flag(unsigned int); + void clear_flag(unsigned int); + unsigned int flags(); virtual void draw(); virtual int handle(int event); void resize_super(int x, int y, int w, int h); @@ -36,6 +39,35 @@ ~Fl_DerivedWidget(); }; #endif +#ifndef INTERNAL_LINKAGE + typedef enum WidgetFlags { + INACTIVE = 1<<0, + INVISIBLE = 1<<1, + OUTPUT = 1<<2, + NOBORDER = 1<<3, + FORCE_POSITION = 1<<4, + NON_MODAL = 1<<5, + SHORTCUT_LABEL = 1<<6, + CHANGED = 1<<7, + OVERRIDE = 1<<8, + VISIBLE_FOCUS = 1<<9, + COPIED_LABEL = 1<<10, + CLIP_CHILDREN = 1<<11, + MENU_WINDOW = 1<<12, + TOOLTIP_WINDOW = 1<<13, + MODAL = 1<<14, + NO_OVERLAY = 1<<15, + GROUP_RELATIVE = 1<<16, + COPIED_TOOLTIP = 1<<17, + FULLSCREEN = 1<<18, + MAC_USE_ACCENTS_MENU = 1<<19, + NEEDS_KEYBOARD = 1<<20, + USERFLAG3 = 1<<29, + USERFLAG2 = 1<<30, + USERFLAG1 = 1<<31 + } WidgetFlags; +#endif + FL_EXPORT_C_HEADER(int,Fl_Widget_handle,(fl_Widget self, int event)); FL_EXPORT_C_HEADER(fl_Group,Fl_Widget_parent,(fl_Widget widget)); FL_EXPORT_C_HEADER(void,Fl_Widget_set_parent,(fl_Widget widget, fl_Group grp)); @@ -143,6 +175,9 @@ FL_EXPORT_C_HEADER(fl_Widget,Fl_OverriddenWidget_New,(int X, int Y, int W, int H,fl_Widget_Virtual_Funcs* fs)); FL_EXPORT_C_HEADER(fl_Widget,Fl_OverriddenWidget_New_WithLabel,(int X, int Y, int W, int H, const char* label, fl_Widget_Virtual_Funcs* fs)); FL_EXPORT_C_HEADER(void,Fl_Widget_Destroy,(fl_Widget widget)); + FL_EXPORT_C_HEADER(unsigned int, Fl_Widget_flags,(fl_Widget widget)); + FL_EXPORT_C_HEADER(void, Fl_Widget_set_flag,(fl_Widget widget, unsigned int flag)); + FL_EXPORT_C_HEADER(void, Fl_Widget_clear_flag,(fl_Widget widget, unsigned int flag)); #ifdef __cplusplus } #endif diff --git a/c-src/Makefile.in b/c-src/Makefile.in --- a/c-src/Makefile.in +++ b/c-src/Makefile.in @@ -15,6 +15,8 @@ endif CPPFILES= $(GL_FILES) \ + Fl_Simple_TerminalC.cpp \ + Fl_Multi_LabelC.cpp \ Fl_Menu_ButtonC.cpp \ Fl_PositionerC.cpp \ Fl_Value_OutputC.cpp \ @@ -77,6 +79,7 @@ Fl_XPM_ImageC.cpp \ Fl_GIF_ImageC.cpp \ Fl_BMP_ImageC.cpp \ + Fl_SVG_ImageC.cpp \ Fl_PreferencesC.cpp \ Fl_PrinterC.cpp \ Fl_ProgressC.cpp \ diff --git a/c-src/filenameC.h b/c-src/filenameC.h --- a/c-src/filenameC.h +++ b/c-src/filenameC.h @@ -9,7 +9,6 @@ #include "Fl_CallbackC.h" EXPORT { #else -#include #include "FL/filename.H" #endif FL_EXPORT_C_HEADER(int,flc_filename_list,(const char *d, struct dirent ***l)); diff --git a/fltk-1.3.4-1-source.tar.gz b/fltk-1.3.4-1-source.tar.gz deleted file mode 100644 # file too large to diff: fltk-1.3.4-1-source.tar.gz diff --git a/fltk-master.zip b/fltk-master.zip new file mode 100644 # file too large to diff: fltk-master.zip diff --git a/fltkhs.cabal b/fltkhs.cabal --- a/fltkhs.cabal +++ b/fltkhs.cabal @@ -1,5 +1,5 @@ name : fltkhs -version : 0.5.4.5 +version : 0.6.0.0 synopsis : FLTK bindings description: 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 @@ -15,7 +15,7 @@ ---------------------------------------- build-type: Custom -cabal-version: >=1.24 +cabal-version: >=2.0 -- for custom-setup source-repository head @@ -48,17 +48,18 @@ custom-setup setup-depends: - Cabal >= 1.24.1 && < 3, + Cabal >= 2.2.0.0 && < 3, filepath, directory >= 1.2.3.0, - -- c2hs >=0.28, - base >= 4.5 && < 4.11 + base >= 4.5 && < 4.13 ---------------------------------------- library build-tools: c2hs + if !os(darwin) && !os(windows) + build-tools: pkg-config -- -- extra-libraries: jpeg -- -- from the `libjpeg` system package @@ -80,110 +81,112 @@ Graphics.UI.FLTK.LowLevel.GlWindow cpp-options: -DGLSUPPORT exposed-modules: - Graphics.UI.FLTK.LowLevel.FLTKHS + Graphics.UI.FLTK.LowLevel.Adjuster Graphics.UI.FLTK.LowLevel.Ask - Graphics.UI.FLTK.LowLevel.SingleWindow - Graphics.UI.FLTK.LowLevel.Window - Graphics.UI.FLTK.LowLevel.DoubleWindow - Graphics.UI.FLTK.LowLevel.OverlayWindow + Graphics.UI.FLTK.LowLevel.BMPImage + Graphics.UI.FLTK.LowLevel.Bitmap + Graphics.UI.FLTK.LowLevel.Box + Graphics.UI.FLTK.LowLevel.Browser Graphics.UI.FLTK.LowLevel.Button - Graphics.UI.FLTK.LowLevel.LightButton - Graphics.UI.FLTK.LowLevel.RadioLightButton Graphics.UI.FLTK.LowLevel.CheckButton - Graphics.UI.FLTK.LowLevel.ReturnButton - Graphics.UI.FLTK.LowLevel.RoundButton - Graphics.UI.FLTK.LowLevel.RepeatButton - Graphics.UI.FLTK.LowLevel.ToggleButton + Graphics.UI.FLTK.LowLevel.Choice + Graphics.UI.FLTK.LowLevel.Clock + Graphics.UI.FLTK.LowLevel.ColorChooser + Graphics.UI.FLTK.LowLevel.CopySurface + Graphics.UI.FLTK.LowLevel.Counter + Graphics.UI.FLTK.LowLevel.Dial + Graphics.UI.FLTK.LowLevel.Dispatch + Graphics.UI.FLTK.LowLevel.DoubleWindow + Graphics.UI.FLTK.LowLevel.Draw + Graphics.UI.FLTK.LowLevel.FL + Graphics.UI.FLTK.LowLevel.FLTKHS + Graphics.UI.FLTK.LowLevel.FileBrowser + Graphics.UI.FLTK.LowLevel.FileInput + Graphics.UI.FLTK.LowLevel.FillDial + Graphics.UI.FLTK.LowLevel.FillSlider Graphics.UI.FLTK.LowLevel.Fl_Enumerations Graphics.UI.FLTK.LowLevel.Fl_Types - Graphics.UI.FLTK.LowLevel.Dispatch - Graphics.UI.FLTK.LowLevel.Hierarchy + Graphics.UI.FLTK.LowLevel.GIFImage Graphics.UI.FLTK.LowLevel.Group - Graphics.UI.FLTK.LowLevel.Widget - Graphics.UI.FLTK.LowLevel.Box - Graphics.UI.FLTK.LowLevel.Clock - Graphics.UI.FLTK.LowLevel.Valuator - Graphics.UI.FLTK.LowLevel.Slider - Graphics.UI.FLTK.LowLevel.HorSlider - Graphics.UI.FLTK.LowLevel.FillSlider + Graphics.UI.FLTK.LowLevel.Hierarchy Graphics.UI.FLTK.LowLevel.HorFillSlider Graphics.UI.FLTK.LowLevel.HorNiceSlider + Graphics.UI.FLTK.LowLevel.HorSlider Graphics.UI.FLTK.LowLevel.HorValueSlider - Graphics.UI.FLTK.LowLevel.NiceSlider - Graphics.UI.FLTK.LowLevel.MenuItem - Graphics.UI.FLTK.LowLevel.MenuPrim - Graphics.UI.FLTK.LowLevel.Browser - Graphics.UI.FLTK.LowLevel.SelectBrowser - Graphics.UI.FLTK.LowLevel.SysMenuBar - Graphics.UI.FLTK.LowLevel.MenuBar - Graphics.UI.FLTK.LowLevel.Choice - Graphics.UI.FLTK.LowLevel.MenuButton Graphics.UI.FLTK.LowLevel.Image - Graphics.UI.FLTK.LowLevel.Bitmap - Graphics.UI.FLTK.LowLevel.Pixmap - Graphics.UI.FLTK.LowLevel.Draw - Graphics.UI.FLTK.LowLevel.CopySurface Graphics.UI.FLTK.LowLevel.ImageSurface - Graphics.UI.FLTK.LowLevel.Adjuster - Graphics.UI.FLTK.LowLevel.Dial - Graphics.UI.FLTK.LowLevel.FillDial + Graphics.UI.FLTK.LowLevel.Input + Graphics.UI.FLTK.LowLevel.JPEGImage + Graphics.UI.FLTK.LowLevel.LightButton Graphics.UI.FLTK.LowLevel.LineDial + Graphics.UI.FLTK.LowLevel.MenuBar + Graphics.UI.FLTK.LowLevel.MenuButton + Graphics.UI.FLTK.LowLevel.MenuItem + Graphics.UI.FLTK.LowLevel.MenuPrim + Graphics.UI.FLTK.LowLevel.MultiLabel + Graphics.UI.FLTK.LowLevel.NativeFileChooser + Graphics.UI.FLTK.LowLevel.NiceSlider + Graphics.UI.FLTK.LowLevel.Output + Graphics.UI.FLTK.LowLevel.OverlayWindow + Graphics.UI.FLTK.LowLevel.PNGImage + Graphics.UI.FLTK.LowLevel.PNMImage + Graphics.UI.FLTK.LowLevel.Pack + Graphics.UI.FLTK.LowLevel.Pixmap + Graphics.UI.FLTK.LowLevel.Positioner + Graphics.UI.FLTK.LowLevel.Progress + Graphics.UI.FLTK.LowLevel.RGBImage + Graphics.UI.FLTK.LowLevel.RadioLightButton + Graphics.UI.FLTK.LowLevel.RepeatButton + Graphics.UI.FLTK.LowLevel.ReturnButton Graphics.UI.FLTK.LowLevel.Roller - Graphics.UI.FLTK.LowLevel.Counter - Graphics.UI.FLTK.LowLevel.SimpleCounter + Graphics.UI.FLTK.LowLevel.RoundButton Graphics.UI.FLTK.LowLevel.Scrollbar Graphics.UI.FLTK.LowLevel.Scrolled - Graphics.UI.FLTK.LowLevel.ValueSlider - Graphics.UI.FLTK.LowLevel.ValueInput - Graphics.UI.FLTK.LowLevel.ValueOutput - Graphics.UI.FLTK.LowLevel.Progress - Graphics.UI.FLTK.LowLevel.Positioner - Graphics.UI.FLTK.LowLevel.Input - Graphics.UI.FLTK.LowLevel.Output - Graphics.UI.FLTK.LowLevel.IntInput - Graphics.UI.FLTK.LowLevel.FileInput - Graphics.UI.FLTK.LowLevel.Wizard + Graphics.UI.FLTK.LowLevel.SelectBrowser + Graphics.UI.FLTK.LowLevel.SingleWindow + Graphics.UI.FLTK.LowLevel.Slider + Graphics.UI.FLTK.LowLevel.Spinner + Graphics.UI.FLTK.LowLevel.SysMenuBar Graphics.UI.FLTK.LowLevel.Table Graphics.UI.FLTK.LowLevel.TableRow - Graphics.UI.FLTK.LowLevel.TreePrefs - Graphics.UI.FLTK.LowLevel.TreeItem - Graphics.UI.FLTK.LowLevel.Tree - Graphics.UI.FLTK.LowLevel.FL - Graphics.UI.FLTK.LowLevel.TextSelection + Graphics.UI.FLTK.LowLevel.Tabs Graphics.UI.FLTK.LowLevel.TextBuffer Graphics.UI.FLTK.LowLevel.TextDisplay Graphics.UI.FLTK.LowLevel.TextEditor - Graphics.UI.FLTK.LowLevel.NativeFileChooser - Graphics.UI.FLTK.LowLevel.Utils + Graphics.UI.FLTK.LowLevel.TextSelection Graphics.UI.FLTK.LowLevel.Tile - Graphics.UI.FLTK.LowLevel.Pack - Graphics.UI.FLTK.LowLevel.Tabs - Graphics.UI.FLTK.LowLevel.Spinner - Graphics.UI.FLTK.LowLevel.ColorChooser - Graphics.UI.FLTK.LowLevel.FileBrowser - Graphics.UI.FLTK.LowLevel.JPEGImage - Graphics.UI.FLTK.LowLevel.RGBImage - Graphics.UI.FLTK.LowLevel.BMPImage - Graphics.UI.FLTK.LowLevel.GIFImage + Graphics.UI.FLTK.LowLevel.ToggleButton + Graphics.UI.FLTK.LowLevel.Tree + Graphics.UI.FLTK.LowLevel.TreeItem + Graphics.UI.FLTK.LowLevel.TreePrefs + Graphics.UI.FLTK.LowLevel.Utils + Graphics.UI.FLTK.LowLevel.Valuator + Graphics.UI.FLTK.LowLevel.ValueInput + Graphics.UI.FLTK.LowLevel.ValueOutput + Graphics.UI.FLTK.LowLevel.ValueSlider + Graphics.UI.FLTK.LowLevel.Widget + Graphics.UI.FLTK.LowLevel.Window + Graphics.UI.FLTK.LowLevel.Wizard + Graphics.UI.FLTK.LowLevel.X Graphics.UI.FLTK.LowLevel.XBMImage Graphics.UI.FLTK.LowLevel.XPMImage - Graphics.UI.FLTK.LowLevel.PNGImage - Graphics.UI.FLTK.LowLevel.PNMImage - Graphics.UI.FLTK.LowLevel.X + Graphics.UI.FLTK.LowLevel.SVGImage + Graphics.UI.FLTK.LowLevel.SimpleTerminal + Graphics.UI.FLTK.LowLevel.Tooltip other-modules: C2HS build-depends: base == 4.*, bytestring, - text >= 0.2 && < 1.3 + text >= 0.2 && < 1.3, + vector >= 0.12.0.1 hs-source-dirs: src - include-dirs: ./c-src, ./ default-extensions: GADTs default-language: Haskell2010 - ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-unused-matches -fno-warn-dodgy-exports + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-unused-matches -fno-warn-dodgy-exports -fno-warn-unused-top-binds if impl(ghc >= 8.0.1) cpp-options: -DHASCALLSTACK_AVAILABLE @@ -220,7 +223,7 @@ mtl default-language: Haskell2010 - ghc-Options: -Wall -threaded + ghc-Options: -Wall -Wdodgy-imports -threaded if os(windows) && arch(x86_64) cpp-options: -DWIN64 @@ -278,7 +281,7 @@ base == 4.*, fltkhs, text >= 1.2.2.0, - OpenGLRaw >= 3 && < 3.3 + OpenGLRaw >= 3 && < 3.4 default-language: Haskell2010 ghc-Options: -Wall -threaded diff --git a/scripts/doc-parser.hs b/scripts/doc-parser.hs --- a/scripts/doc-parser.hs +++ b/scripts/doc-parser.hs @@ -58,8 +58,13 @@ spacesOrNewLines char '(' methodName <- word - _ <- go (1 :: Int) "" spacesOrNewLines + char '(' + spacesOrNewLines + char ')' + spacesOrNewLines + char ')' + spacesOrNewLines widgetType <- word return (constraints, typeSig, methodName, widgetType) where @@ -171,7 +176,7 @@ let (functions, inNewVersionOnly) = parseWidgetFile contents let rendered = maybe [] (sort . map (\(c, sig, mName, wType) -> pprint ((c, sig), mName, wType))) putStr $ intercalate "\n--\n" (map ((++) "-- ") (rendered functions)) - putStr "\n" - putStr $ "\n-- Available in FLTK 1.3.4 only: \n" - putStr $ intercalate "\n--\n" (map ((++) "-- ") (rendered inNewVersionOnly)) - putStr "\n" + -- putStr "\n" + -- putStr $ "\n-- Available in FLTK 1.3.4 only: \n" + -- putStr $ intercalate "\n--\n" (map ((++) "-- ") (rendered inNewVersionOnly)) + -- putStr "\n" diff --git a/src/Fluid/Generate.hs b/src/Fluid/Generate.hs --- a/src/Fluid/Generate.hs +++ b/src/Fluid/Generate.hs @@ -17,6 +17,7 @@ import Data.List import Foreign.C.Types import Graphics.UI.FLTK.LowLevel.Utils +import Graphics.UI.FLTK.LowLevel.Fl_Types(ResolveImageLabelConflict(ResolveImageLabelDoNothing)) import Lookup import Types import Parser @@ -134,7 +135,7 @@ Types.Labeltype l -> maybe "" (\_f -> - (apply "setLabeltype" name (Just _f))) + (apply "setLabeltype" name (Just (_f ++ " " ++ (show ResolveImageLabelDoNothing))))) (lookup (show l) labelType) Types.Labelcolor c -> apply "setLabelcolor" name (Just $ "(Color " ++ (show c) ++ ")") @@ -291,7 +292,7 @@ (shortcutCode "Nothing") False (_,newFlags) <- get - tell ["(MenuItemIndex idx) <- add " ++ + tell ["(AtIndex idx) <- add " ++ mn ++ " label " ++ "shortcut " ++ "callback " ++ @@ -406,7 +407,7 @@ (constructorG newFlClassName hsConstructor (Just newName) posSize) ++ (map (attributeG newFlClassName newName) restAttrs) ++ innerTreeOutput ++ - ["setValue " ++ newName ++ " (MenuItemByIndex (MenuItemIndex " ++ (show 0) ++ "))"] + ["setValue " ++ newName ++ " (MenuItemByIndex (AtIndex " ++ (show 0) ++ "))"] _ -> (constructorG newFlClassName hsConstructor (Just newName) posSize) ++ (map (attributeG newFlClassName newName) attrsWithoutLabel) ++ diff --git a/src/Fluid/Lookup.hs b/src/Fluid/Lookup.hs --- a/src/Fluid/Lookup.hs +++ b/src/Fluid/Lookup.hs @@ -109,11 +109,11 @@ ] labelType = [ - ("NORMAL_LABEL" ,"NormalLabel"), - ("SHADOW_LABEL" ,"ShadowLabel"), - ("ENGRAVED_LABEL" ,"EngravedLabel"), - ("EMBOSSED_LABEL" ,"EmbossedLabel"), - ("NO_LABEL" ,"NoLabel") + ("NORMAL_LABEL" ,"NormalLabelType"), + ("SHADOW_LABEL" ,"ShadowLabelType"), + ("ENGRAVED_LABEL" ,"EngravedLabelType"), + ("EMBOSSED_LABEL" ,"EmbossedLabelType"), + ("NO_LABEL" ,"NoLabelType") ] alignmentType = [ ("FL_ALIGN_CENTER" ,"alignCenter"), diff --git a/src/Fluid/Utils.hs b/src/Fluid/Utils.hs --- a/src/Fluid/Utils.hs +++ b/src/Fluid/Utils.hs @@ -1,7 +1,6 @@ module Utils (collapseParts, collapseString) where import Types import Numeric -import Debug.Trace collapseParts :: [BracedStringParts] -> String collapseParts parts = go parts [] diff --git a/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs b/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs --- a/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Adjuster.chs @@ -61,12 +61,12 @@ adjusterDestroy' adjusterPtr return nullPtr -{# fun Fl_Adjuster_soft as soft' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetSoft ()) Adjuster orig impl where +{# fun Fl_Adjuster_soft as soft' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (GetSoft ()) Adjuster orig impl where runOp _ _ adjuster = withRef adjuster $ \adjusterPtr -> soft' adjusterPtr -{# fun Fl_Adjuster_set_soft as setSoft' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetSoft ()) Adjuster orig impl where +{# fun Fl_Adjuster_set_soft as setSoft' { id `Ptr ()',cFromBool `Bool' } -> `()' #} +instance (impl ~ (Bool-> IO ())) => Op (SetSoft ()) Adjuster orig impl where runOp _ _ adjuster soft = withRef adjuster $ \adjusterPtr -> setSoft' adjusterPtr soft {# fun Fl_Adjuster_draw as draw'' { id `Ptr ()' } -> `()' #} @@ -124,7 +124,7 @@ -- -- drawSuper :: 'Ref' 'Adjuster' -> 'IO' () -- --- getSoft :: 'Ref' 'Adjuster' -> 'IO' ('Int') +-- getSoft :: 'Ref' 'Adjuster' -> 'IO' ('Bool') -- -- handle :: 'Ref' 'Adjuster' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- @@ -138,7 +138,7 @@ -- -- resizeSuper :: 'Ref' 'Adjuster' -> 'Rectangle' -> 'IO' () -- --- setSoft :: 'Ref' 'Adjuster' -> 'Int' -> 'IO' () +-- setSoft :: 'Ref' 'Adjuster' -> 'Bool'>- 'IO' () -- -- showWidget :: 'Ref' 'Adjuster' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Box.chs b/src/Graphics/UI/FLTK/LowLevel/Box.chs --- a/src/Graphics/UI/FLTK/LowLevel/Box.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Box.chs @@ -56,26 +56,32 @@ in case funcs' of Just fs -> do ptr <- customWidgetFunctionStruct draw' fs - overriddenBoxNewWithBoxtype' boxtype' x_pos y_pos width height l' (castPtr ptr) >>= toRef + ref <- overriddenBoxNewWithBoxtype' boxtype' x_pos y_pos width height l' (castPtr ptr) >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref Nothing -> boxNewWithBoxtype' boxtype' x_pos y_pos width height l' >>= toRef boxNew :: Rectangle -> Maybe T.Text -> IO (Ref Box) boxNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> boxNew' x_pos y_pos width height >>= - toRef - Just l -> boxNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenBoxNew' + overriddenBoxNewWithLabel' boxNewWithBoxtype :: Boxtype -> Rectangle -> T.Text -> IO (Ref Box) boxNewWithBoxtype boxtype' rectangle' l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle' - in - boxNewWithBoxtype' boxtype' x_pos y_pos width height l' >>= - toRef + in do + ref <- boxNewWithBoxtype' boxtype' x_pos y_pos width height l' >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {#fun Fl_Box_handle as boxHandle' { id `Ptr ()', id `CInt' } -> `Int' #} instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (Handle ()) Box orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/Browser.chs b/src/Graphics/UI/FLTK/LowLevel/Browser.chs --- a/src/Graphics/UI/FLTK/LowLevel/Browser.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Browser.chs @@ -44,12 +44,13 @@ browserNew :: Rectangle -> Maybe T.Text -> IO (Ref Browser) browserNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> browserNew' x_pos y_pos width height >>= - toRef - Just l -> browserNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenBrowserNew' + overriddenBrowserNewWithLabel' {#fun Fl_Browser_handle as browserHandle' { id `Ptr ()', id `CInt' } -> `Int' #} @@ -61,20 +62,22 @@ browserDestroy' browserPtr return nullPtr {# fun Fl_Browser_remove as remove' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (Remove ()) Browser orig impl where - runOp _ _ browser line = withRef browser $ \browserPtr -> remove' browserPtr line +instance (impl ~ (LineNumber -> IO ())) => Op (Remove ()) Browser orig impl where + runOp _ _ browser (LineNumber line) = withRef browser $ \browserPtr -> remove' browserPtr line {# fun Fl_Browser_add as add' { id `Ptr ()',unsafeToCString `T.Text' } -> `()' #} instance (impl ~ (T.Text -> IO ())) => Op (Add ()) Browser orig impl where runOp _ _ browser newtext = withRef browser $ \browserPtr -> add' browserPtr newtext {# fun Fl_Browser_insert as insert' { id `Ptr ()',`Int',unsafeToCString `T.Text' } -> `()' #} -instance (impl ~ (Int -> T.Text -> IO ())) => Op (Insert ()) Browser orig impl where - runOp _ _ browser line newtext = withRef browser $ \browserPtr -> insert' browserPtr line newtext +instance (impl ~ (LineNumber -> T.Text -> IO ())) => Op (Insert ()) Browser orig impl where + runOp _ _ browser (LineNumber line) newtext = withRef browser $ \browserPtr -> insert' browserPtr line newtext {# fun Fl_Browser_move as move' { id `Ptr ()',`Int',`Int' } -> `()' #} instance (impl ~ (LineNumber -> LineNumber -> IO ())) => Op (Move ()) Browser orig impl where runOp _ _ browser (LineNumber to) (LineNumber from) = withRef browser $ \browserPtr -> move' browserPtr to from {# fun Fl_Browser_load as load' { id `Ptr ()',unsafeToCString `T.Text' } -> `Int' #} -instance (impl ~ (T.Text -> IO (Int))) => Op (Load ()) Browser orig impl where - runOp _ _ browser filename = withRef browser $ \browserPtr -> load' browserPtr filename +instance (impl ~ (T.Text -> IO (Either UnknownError ()))) => Op (Load ()) Browser orig impl where + runOp _ _ browser filename = do + res <- withRef browser $ \browserPtr -> load' browserPtr filename + if (res == 0) then return (Left UnknownError) else return (Right ()) {# fun Fl_Browser_swap as swap' { id `Ptr ()',`Int',`Int' } -> `()' #} instance (impl ~ (LineNumber -> LineNumber -> IO ())) => Op (Swap ()) Browser orig impl where runOp _ _ browser (LineNumber a) (LineNumber b) = withRef browser $ \browserPtr -> swap' browserPtr a b @@ -85,14 +88,14 @@ instance (impl ~ ( IO (Int))) => Op (GetSize ()) Browser orig impl where runOp _ _ browser = withRef browser $ \browserPtr -> size' browserPtr {# fun Fl_Browser_set_size as setSize' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ (Int -> Int -> IO ())) => Op (SetSize ()) Browser orig impl where - runOp _ _ browser w h = withRef browser $ \browserPtr -> setSize' browserPtr w h +instance (impl ~ (Size -> IO ())) => Op (SetSize ()) Browser orig impl where + runOp _ _ browser (Size (Width w) (Height h)) = withRef browser $ \browserPtr -> setSize' browserPtr w h {# fun Fl_Browser_topline as topline' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (LineNumber))) => Op (GetTopline ()) Browser orig impl where runOp _ _ browser = withRef browser $ \browserPtr -> topline' browserPtr >>= return . LineNumber {# fun Fl_Browser_lineposition as lineposition' { id `Ptr ()',`Int', cFromEnum `LinePosition' } -> `()' #} -instance (impl ~ (Int -> LinePosition -> IO ())) => Op (Lineposition ()) Browser orig impl where - runOp _ _ browser line pos = withRef browser $ \browserPtr -> lineposition' browserPtr line pos +instance (impl ~ (LineNumber -> LinePosition -> IO ())) => Op (Lineposition ()) Browser orig impl where + runOp _ _ browser (LineNumber line) pos = withRef browser $ \browserPtr -> lineposition' browserPtr line pos {# fun Fl_Browser_set_topline as setTopline' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ (LineNumber -> IO ())) => Op (SetTopline ()) Browser orig impl where runOp _ _ browser (LineNumber line) = withRef browser $ \browserPtr -> setTopline' browserPtr line @@ -224,6 +227,12 @@ {# fun Fl_Browser_set_textcolor as setTextcolor' { id `Ptr ()',cFromColor `Color' } -> `()' #} instance (impl ~ (Color -> IO ())) => Op (SetTextcolor ()) Browser orig impl where runOp _ _ browser col = withRef browser $ \browserPtr -> setTextcolor' browserPtr col +{# fun Fl_Browser_set_scrollbar_color as setScrollbarColor' { id `Ptr ()',cFromColor `Color' } -> `()' #} +instance (impl ~ (Color -> IO ())) => Op (SetScrollbarColor ()) Browser orig impl where + runOp _ _ browser col = withRef browser $ \browserPtr -> setScrollbarColor' browserPtr col +{# fun Fl_Browser_set_scrollbar_selection_color as setScrollbarSelectionColor' { id `Ptr ()',cFromColor `Color' } -> `()' #} +instance (impl ~ (Color -> IO ())) => Op (SetScrollbarSelectionColor ()) Browser orig impl where + runOp _ _ browser col = withRef browser $ \browserPtr -> setScrollbarSelectionColor' browserPtr col {# fun Fl_Browser_scrollbar_size as scrollbarSize' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (GetScrollbarSize ()) Browser orig impl where runOp _ _ browser = withRef browser $ \browserPtr -> scrollbarSize' browserPtr @@ -248,6 +257,12 @@ {# fun Fl_Widget_type as type' { id `Ptr ()' } -> `Word8' #} instance (impl ~ IO (BrowserType)) => Op (GetType_ ()) Browser orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> type' widgetPtr >>= return . toEnum . fromInteger . toInteger +{# fun Fl_Browser_handle_super as handleSuper' { id `Ptr ()', id `CInt'} -> `Int' #} +instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (HandleSuper ()) Browser orig impl where + runOp _ _ browser event = withRef browser (\p -> handleSuper' p (fromIntegral . fromEnum $ event)) >>= return . successOrUnknownEvent +{# fun Fl_Browser_draw_super as drawSuper' { id `Ptr ()' } -> `()' #} +instance (impl ~ (IO ())) => Op (DrawSuper ()) Browser orig impl where + runOp _ _ browser = withRef browser (\p -> drawSuper' p) -- $functions -- @ @@ -263,6 +278,8 @@ -- -- displayed :: 'Ref' 'Browser' -> 'LineNumber' -> 'IO' ('Bool') -- +-- drawSuper :: 'Ref' 'Browser' -> 'IO' () +-- -- getColumnChar :: 'Ref' 'Browser' -> 'IO' ('Char') -- -- getColumnWidths :: 'Ref' 'Browser' -> 'IO' ['Int'] @@ -299,21 +316,23 @@ -- -- handle :: 'Ref' 'Browser' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- +-- handleSuper :: 'Ref' 'Browser' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- -- hide :: 'Ref' 'Browser' -> 'IO' () -- -- hideLine :: 'Ref' 'Browser' -> 'LineNumber' -> 'IO' () -- --- insert :: 'Ref' 'Browser' -> 'Int' -> 'T.Text' -> 'IO' () +-- insert :: 'Ref' 'Browser' -> 'LineNumber' -> 'T.Text' -> 'IO' () -- --- lineposition :: 'Ref' 'Browser' -> 'Int' -> 'LinePosition' -> 'IO' () +-- lineposition :: 'Ref' 'Browser' -> 'LineNumber' -> 'LinePosition' -> 'IO' () -- --- load :: 'Ref' 'Browser' -> 'T.Text' -> 'IO' ('Int') +-- load :: 'Ref' 'Browser' -> 'T.Text' -> 'IO' ('Either' 'UnknownError' ()) -- -- makeVisible :: 'Ref' 'Browser' -> 'LineNumber' -> 'IO' () -- -- move :: 'Ref' 'Browser' -> 'LineNumber' -> 'LineNumber' -> 'IO' () -- --- remove :: 'Ref' 'Browser' -> 'Int' -> 'IO' () +-- remove :: 'Ref' 'Browser' -> 'LineNumber' -> 'IO' () -- -- removeIcon :: 'Ref' 'Browser' -> 'LineNumber' -> 'IO' () -- @@ -339,11 +358,15 @@ -- -- setPosition :: 'Ref' 'Browser' -> 'PixelPosition' -> 'IO' () -- +-- setScrollbarColor :: 'Ref' 'Browser' -> 'Color' -> 'IO' () +-- +-- setScrollbarSelectionColor :: 'Ref' 'Browser' -> 'Color' -> 'IO' () +-- -- setScrollbarSize :: 'Ref' 'Browser' -> 'Int' -> 'IO' () -- -- setScrollbarWidth :: 'Ref' 'Browser' -> 'Int' -> 'IO' () -- --- setSize :: 'Ref' 'Browser' -> 'Int' -> 'Int' -> 'IO' () +-- setSize :: 'Ref' 'Browser' -> 'Size' -> 'IO' () -- -- setText :: 'Ref' 'Browser' -> 'LineNumber' -> 'T.Text' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/CheckButton.chs b/src/Graphics/UI/FLTK/LowLevel/CheckButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/CheckButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/CheckButton.chs @@ -47,10 +47,13 @@ {# fun Fl_Check_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} checkButtonNew :: Rectangle -> Maybe T.Text -> IO (Ref CheckButton) checkButtonNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Check_Button_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (Destroy ()) CheckButton orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/Choice.chs b/src/Graphics/UI/FLTK/LowLevel/Choice.chs --- a/src/Graphics/UI/FLTK/LowLevel/Choice.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Choice.chs @@ -50,12 +50,13 @@ {# fun Fl_Choice_New_WithLabel as choiceNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} choiceNew :: Rectangle -> Maybe T.Text -> IO (Ref Choice) choiceNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> choiceNew' x_pos y_pos width height >>= - toRef - Just l -> choiceNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Choice_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Choice orig impl where runOp _ _ menu_ = swapRef menu_ $ @@ -63,18 +64,18 @@ widgetDestroy' menu_Ptr >> return nullPtr {# fun Fl_Choice_value as value' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (MenuItemIndex))) => Op (GetValue ()) Choice orig impl where - runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> value' menu_Ptr >>= return . MenuItemIndex +instance (impl ~ ( IO (AtIndex))) => Op (GetValue ()) Choice orig impl where + runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> value' menu_Ptr >>= return . AtIndex {# fun Fl_Choice_set_value_with_item as valueWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun Fl_Choice_set_value_with_index as valueWithIndex' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (MenuItemReference -> IO (Int))) => Op (SetValue ()) Choice orig impl where +instance (impl ~ (MenuItemReference -> IO (Either NoChange ()))) => Op (SetValue ()) Choice orig impl where runOp _ _ menu_ menu_item_reference = withRef menu_ $ \menu_Ptr -> case menu_item_reference of - (MenuItemByIndex (MenuItemIndex index')) -> valueWithIndex' menu_Ptr index' + (MenuItemByIndex (AtIndex index')) -> valueWithIndex' menu_Ptr index' >>= return . successOrNoChange (MenuItemByPointer (MenuItemPointer menu_item)) -> withRef menu_item $ \menu_itemPtr -> - valueWithItem' menu_Ptr menu_itemPtr + valueWithItem' menu_Ptr menu_itemPtr >>= return . successOrNoChange {#fun Fl_Choice_handle as menu_Handle' { id `Ptr ()', id `CInt' } -> `Int' #} instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (Handle ()) Choice orig impl where runOp _ _ menu_ event = withRef menu_ (\p -> menu_Handle' p (fromIntegral . fromEnum $ event)) >>= return . successOrUnknownEvent @@ -119,7 +120,7 @@ -- -- drawSuper :: 'Ref' 'Choice' -> 'IO' () -- --- getValue :: 'Ref' 'Choice' -> 'IO' ('MenuItemIndex') +-- getValue :: 'Ref' 'Choice' -> 'IO' ('AtIndex') -- -- handle :: 'Ref' 'Choice' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- @@ -133,7 +134,7 @@ -- -- resizeSuper :: 'Ref' 'Choice' -> 'Rectangle' -> 'IO' () -- --- setValue :: 'Ref' 'Choice' -> 'MenuItemReference' -> 'IO' ('Int') +-- setValue :: 'Ref' 'Choice' -> 'MenuItemReference' -> 'IO' ('Either' 'NoChange' ()) -- -- showWidget :: 'Ref' 'Choice' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Clock.chs b/src/Graphics/UI/FLTK/LowLevel/Clock.chs --- a/src/Graphics/UI/FLTK/LowLevel/Clock.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Clock.chs @@ -43,12 +43,12 @@ }; #endc {# enum ClockType {} deriving (Show) #} -newtype Hour = Hour Int -newtype Minute = Minute Int -newtype Second = Second Int -data ClockByTime = ClockByTime Hour Minute Second -data ClockSinceEpoch = ClockSinceEpoch Second -data ClockSetTimeType = ClockSetByTime ClockByTime | ClockSetSinceEpoch ClockSinceEpoch +newtype Hour = Hour Int deriving Show +newtype Minute = Minute Int deriving Show +newtype Second = Second Int deriving Show +data ClockByTime = ClockByTime Hour Minute Second deriving Show +data ClockSinceEpoch = ClockSinceEpoch Second deriving Show +data ClockSetTimeType = ClockSetByTime ClockByTime | ClockSetSinceEpoch ClockSinceEpoch deriving Show {# fun Fl_OverriddenClock_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenClock_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} @@ -67,24 +67,27 @@ overriddenWidgetNew' overriddenWidgetNewWithLabel' - - {# fun Fl_Clock_New as clockNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Clock_New_WithLabel as clockNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} {# fun Fl_Clock_New_WithClockType as clockNewWithClockType' { id `CUChar', `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} clockNew :: Rectangle -> Maybe T.Text -> IO (Ref Clock) clockNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> clockNew' x_pos y_pos width height >>= - toRef - Just l -> clockNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' + clockNewWithType :: ClockType -> Rectangle -> T.Text -> IO (Ref Clock) clockNewWithType clocktype' rectangle' label' = let (x_pos, y_pos, width, height) = fromRectangle rectangle' - in - clockNewWithClockType' (castCharToCUChar . chr . fromEnum $ clocktype') x_pos y_pos width height label' >>= toRef + in do + ref <- clockNewWithClockType' (castCharToCUChar . chr . fromEnum $ clocktype') x_pos y_pos width height label' >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Clock_set_value_with_hms as setValueWithhms' {id `Ptr ()', `Int', `Int', `Int'} -> `()' #} {# fun Fl_Clock_set_value as setValue' {id `Ptr ()', id `CULong'} -> `()' #} @@ -94,6 +97,7 @@ ClockSetByTime (ClockByTime (Hour h)(Minute m) (Second s)) -> setValueWithhms' clockPtr h m s ClockSetSinceEpoch (ClockSinceEpoch (Second s)) -> setValue' clockPtr (fromIntegral s) + {# fun Fl_Clock_value as getValue' {id `Ptr ()'} -> `CULong' id #} instance (impl ~ (IO ClockSinceEpoch)) => Op (GetValueSinceEpoch ()) Clock orig impl where runOp _ _ clock' = withRef clock' $ \clockPtr -> @@ -150,22 +154,27 @@ {# fun Fl_Clock_show_super as showSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Clock orig impl where runOp _ _ clock = withRef clock $ \clockPtr -> showSuper' clockPtr +{#fun Fl_Clock_get_shadow as getShadow' {id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ (IO Bool)) => Op (GetShadow ()) Clock orig impl where + runOp _ _ clock = withRef clock $ \clockPtr -> getShadow' clockPtr +{#fun Fl_Clock_set_shadow as setShadow' {id `Ptr ()', cFromBool `Bool'} -> `()'#} +instance (impl ~ (Bool -> IO ())) => Op (SetShadow ()) Clock orig impl where + runOp _ _ clock shadow = withRef clock $ \clockPtr -> setShadow' clockPtr shadow -- $Clockfunctions -- -- @ --- --- getValue :: 'Ref' 'Clock' -> 'IO' 'ClockByTime' +-- draw :: 'Ref' 'Clock' -> 'IO' () -- --- getValueSinceEpoch :: 'Ref' 'Clock' -> 'IO' 'ClockSinceEpoch' +-- drawSuper :: 'Ref' 'Clock' -> 'IO' () -- --- handle :: 'Ref' 'Clock' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- getShadow :: 'Ref' 'Clock' -> 'IO' 'Bool' -- --- setValue :: 'Ref' 'Clock' -> 'ClockSetTimeType' -> 'IO' () +-- getType_ :: 'Ref' 'Clock' -> 'IO' ('ClockType') -- --- draw :: 'Ref' 'Clock' -> 'IO' () +-- getValue :: 'Ref' 'Clock' -> 'IO' 'ClockByTime' -- --- drawSuper :: 'Ref' 'Clock' -> 'IO' () +-- getValueSinceEpoch :: 'Ref' 'Clock' -> 'IO' 'ClockSinceEpoch' -- -- handle :: 'Ref' 'Clock' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- @@ -178,6 +187,10 @@ -- resize :: 'Ref' 'Clock' -> 'Rectangle' -> 'IO' () -- -- resizeSuper :: 'Ref' 'Clock' -> 'Rectangle' -> 'IO' () +-- +-- setShadow :: 'Ref' 'Clock' -> 'Bool' -> 'IO' () +-- +-- setType :: 'Ref' 'Clock' -> 'ClockType' -> 'IO' () -- -- showWidget :: 'Ref' 'Clock' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/ColorChooser.chs b/src/Graphics/UI/FLTK/LowLevel/ColorChooser.chs --- a/src/Graphics/UI/FLTK/LowLevel/ColorChooser.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ColorChooser.chs @@ -7,7 +7,8 @@ colorChooserCustom, rgb2Hsv, hsv2Rgb, - flcColorChooser + flcColorChooser, + CustomColorChooserFuncs(..) -- * Hierarchy -- -- $hierarchy @@ -30,24 +31,102 @@ import qualified Data.Text as T import Data.List import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +import Control.Applicative -{# fun Fl_OverriddenColor_Chooser_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenColor_Chooser_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} +data CustomColorChooserFuncs a = + CustomColorChooserFuncs + { + getModeCustom :: Ref a -> IO ColorChooserMode + , setModeCustom :: Ref a -> ColorChooserMode -> IO () + , hueCustom :: Ref a -> IO Between0And6 + , saturationCustom :: Ref a -> IO Between0And1 + , valueCustom :: Ref a -> IO Between0And1 + , rCustom :: Ref a -> IO Between0And1 + , gCustom :: Ref a -> IO Between0And1 + , bCustom :: Ref a -> IO Between0And1 + , hsvCustom :: Ref a -> (Between0And6,Between0And1,Between0And1) -> IO Int + , rgbCustom :: Ref a -> (Between0And1,Between0And1,Between0And1) -> IO Int + } + +toGetBetween0And6Prim :: (Ref a -> IO Between0And6) -> IO (FunPtr GetDoublePrim) +toGetBetween0And6Prim f = + mkGetDouble (\ptr -> do + pp <- wrapNonNull ptr "Null pointer: toGetBetween0And6Prim" + (Between0And6 res) <- f (castTo (wrapInRef pp)) + return (realToFrac res)) + +toGetBetween0And1Prim :: (Ref a -> IO Between0And1) -> IO (FunPtr GetDoublePrim) +toGetBetween0And1Prim f = + mkGetDouble (\ptr -> do + pp <- wrapNonNull ptr "Null pointer: toGetBetween0And1Prim" + (Between0And1 res) <- f (castTo (wrapInRef pp)) + return (realToFrac res)) + +toGetModePrim :: (Ref a -> IO ColorChooserMode) -> IO (FunPtr GetIntPrim) +toGetModePrim f = + mkGetInt (\ptr -> do + pp <- wrapNonNull ptr "Null pointer: toGetModePrim" + mode <- f (castTo (wrapInRef pp)) + return (fromIntegral (fromEnum mode))) + +toSetModePrim :: (Ref a -> ColorChooserMode -> IO ()) -> IO (FunPtr SetIntPrim) +toSetModePrim f = + mkSetInt (\ptr m -> do + pp <- wrapNonNull ptr "Null pointer: toSetModePrim" + f (castTo (wrapInRef pp)) (cToEnum (fromIntegral m))) + +toHsvPrim :: (Ref a -> (Between0And6,Between0And1,Between0And1) -> IO Int)-> IO (FunPtr ColorSetPrim) +toHsvPrim f = + mkColorSetPrim (\ptr (CDouble h) (CDouble s) (CDouble v) -> do + pp <- wrapNonNull ptr "Null pointer: toHsvPrim" + ret <- f (castTo (wrapInRef pp)) (Between0And6 h,Between0And1 s,Between0And1 v) + return (fromIntegral ret)) + +toRgbPrim :: (Ref a -> (Between0And1,Between0And1,Between0And1) -> IO Int) -> IO (FunPtr ColorSetPrim) +toRgbPrim f = + mkColorSetPrim (\ptr (CDouble r) (CDouble g) (CDouble b) -> do + pp <- wrapNonNull ptr "Null pointer: toRgbPrim" + ret <- f (castTo (wrapInRef pp)) (Between0And1 r,Between0And1 g,Between0And1 b) + return (fromIntegral ret)) + +fillCustomColorChooserFunctionStruct :: forall a. (Parent a ColorChooser) => CustomColorChooserFuncs a -> IO (Ptr ()) +fillCustomColorChooserFunctionStruct funcs = do + structPtr <- mallocBytes {#sizeof fl_Color_Chooser_Virtual_Funcs #} + toGetModePrim (getModeCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->get_mode #} structPtr + toSetModePrim (setModeCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->set_mode #} structPtr + toGetBetween0And6Prim (hueCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->hue #} structPtr + toGetBetween0And1Prim (saturationCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->saturation #} structPtr + toGetBetween0And1Prim (valueCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->value #} structPtr + toGetBetween0And1Prim (rCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->r #} structPtr + toGetBetween0And1Prim (gCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->g #} structPtr + toGetBetween0And1Prim (bCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->b #} structPtr + toHsvPrim (hsvCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->hsv #} structPtr + toRgbPrim (rgbCustom funcs) >>= {#set fl_Color_Chooser_Virtual_Funcs->rgb #} structPtr + return structPtr + +{# fun Fl_OverriddenColor_Chooser_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()', id `Ptr ()' } -> `Ptr ()' id #} +{# fun Fl_OverriddenColor_Chooser_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()', id `Ptr ()' } -> `Ptr ()' id #} colorChooserCustom :: Rectangle -- ^ The bounds of this ColorChooser -> Maybe T.Text -- ^ The ColorChooser label -> Maybe (Ref ColorChooser -> IO ()) -- ^ Optional custom drawing function + -> Maybe (CustomColorChooserFuncs ColorChooser) -> Maybe (CustomWidgetFuncs ColorChooser) -- ^ Optional custom widget functions -> IO (Ref ColorChooser) -colorChooserCustom rectangle l' draw' funcs' = - widgetMaker - rectangle - l' - draw' - funcs' - overriddenWidgetNew' - overriddenWidgetNewWithLabel' - +colorChooserCustom rectangle l' draw' colorChooserFuncs' funcs' = + let (x_pos, y_pos, width, height) = fromRectangle rectangle + in do + widgetFuncsPtr <- customWidgetFunctionStruct draw' (maybe defaultCustomWidgetFuncs id funcs') + colorChooserFuncsPtr <- maybe (return nullPtr) fillCustomColorChooserFunctionStruct colorChooserFuncs' + colorChooser <- + maybe + (overriddenWidgetNew' x_pos y_pos width height (castPtr widgetFuncsPtr) (castPtr colorChooserFuncsPtr)) + (\l -> overriddenWidgetNewWithLabel' x_pos y_pos width height l (castPtr widgetFuncsPtr) (castPtr colorChooserFuncsPtr)) + l' + ref <- toRef colorChooser + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Color_Chooser_New as colorchooserNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Color_Chooser_New_WithLabel as colorchooserNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -55,11 +134,12 @@ colorChooserNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle in case l' of - Nothing -> colorchooserNew' x_pos y_pos width height >>= - toRef - Just l -> colorchooserNewWithLabel' x_pos y_pos width height l >>= - toRef - + Nothing -> colorchooserNew' x_pos y_pos width height >>= toRef + Just l -> do + ref <- colorchooserNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Color_Chooser_mode as mode' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (ColorChooserMode))) => Op (GetMode ()) ColorChooser orig impl where runOp _ _ color_chooser = withRef color_chooser $ \color_chooserPtr -> mode' color_chooserPtr >>= return . toEnum @@ -131,6 +211,28 @@ ret <- rgb' color_chooserPtr r'' g'' b'' if (ret == 0) then return (Left NoChange) else return (Right ()) +instance (impl ~ (IO ( Either OutOfRange (Between0And1, Between0And1, Between0And1)))) => Op (GetRgb()) ColorChooser orig impl where + runOp _ _ color_chooser = do + _r <- getR color_chooser + _g <- getG color_chooser + _b <- getB color_chooser + return (do + r <- _r + g <- _g + b <- _b + return (r,g,b)) + +instance (impl ~ (IO ( Either OutOfRange (Between0And6, Between0And1, Between0And1)))) => Op (GetHsv()) ColorChooser orig impl where + runOp _ _ color_chooser = do + _h <- getHue color_chooser + _s <- getSaturation color_chooser + _v <- getValue color_chooser + return (do + h <- _h + s <- _s + v <- _v + return (h,s,v)) + {# fun Fl_Color_Chooser_draw as draw' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Draw ()) ColorChooser orig impl where runOp _ _ colorChooser = withRef colorChooser $ \colorChooserPtr -> draw' colorChooserPtr @@ -174,14 +276,10 @@ alloca $ \gPtr -> alloca $ \bPtr -> do hsv2rgb' h'' s'' v'' rPtr gPtr bPtr - let (nullPtrs, nonNullPtrs) = partition ((==) nullPtr) [rPtr, gPtr, bPtr] - if (not (null nullPtrs)) - then mapM_ free nonNullPtrs >> return Nothing - else do - r'' <- peek rPtr - g'' <- peek gPtr - b'' <- peek bPtr - return (Just (Between0And1 (realToFrac r''),Between0And1 (realToFrac g''),Between0And1 (realToFrac b''))) + r'' <- peek rPtr + g'' <- peek gPtr + b'' <- peek bPtr + return (Just (Between0And1 (realToFrac r''),Between0And1 (realToFrac g''),Between0And1 (realToFrac b''))) {# fun Fl_Color_Chooser_rgb2hsv as rgb2hsv' {`Double',`Double',`Double', id `Ptr CDouble', id `Ptr CDouble',id `Ptr CDouble' } -> `()' #} rgb2Hsv :: (Between0And1, Between0And1, Between0And1) -> IO (Maybe (Between0And6, Between0And1, Between0And1)) diff --git a/src/Graphics/UI/FLTK/LowLevel/CopySurface.chs b/src/Graphics/UI/FLTK/LowLevel/CopySurface.chs --- a/src/Graphics/UI/FLTK/LowLevel/CopySurface.chs +++ b/src/Graphics/UI/FLTK/LowLevel/CopySurface.chs @@ -20,7 +20,6 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch -import qualified Data.Text as T {# fun Fl_Copy_Surface_New as copySurfaceNew' {`Int', `Int'} -> `Ptr ()' id #} copySurfaceNew :: Size -> IO (Ref CopySurface) @@ -30,10 +29,6 @@ instance (impl ~ (IO ())) => Op (Destroy ()) CopySurface orig impl where runOp _ _ copy_surface = withRef copy_surface $ \copy_surfacePtr -> copySurfaceDestroy' copy_surfacePtr -{# fun Fl_Copy_Surface_class_name as className' { id `Ptr () ' } -> `T.Text' unsafeFromCString #} -instance (impl ~ (IO (T.Text))) => Op (ClassName ()) Image orig impl where - runOp _ _ copy_surface = withRef copy_surface $ \copy_surfacePtr -> className' copy_surfacePtr - {# fun Fl_Copy_Surface_set_current as setCurrent' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (SetCurrent ()) CopySurface orig impl where runOp _ _ copy_surface = withRef copy_surface $ \copy_surfacePtr -> setCurrent' copy_surfacePtr @@ -45,8 +40,6 @@ -- $CopySurfacefunctions -- -- @ --- className :: 'Ref' 'Image' -> 'IO' ('String') --- -- destroy :: 'Ref' 'CopySurface' -> 'IO' () -- -- draw:: ('Parent' a 'Widget') => 'Ref' 'CopySurface' -> 'Ref' a -> 'Position' -> 'IO' () diff --git a/src/Graphics/UI/FLTK/LowLevel/Counter.chs b/src/Graphics/UI/FLTK/LowLevel/Counter.chs --- a/src/Graphics/UI/FLTK/LowLevel/Counter.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Counter.chs @@ -59,12 +59,13 @@ {# fun Fl_Counter_New_WithLabel as counterNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} counterNew :: Rectangle -> Maybe T.Text -> IO (Ref Counter) counterNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> counterNew' x_pos y_pos width height >>= - toRef - Just l -> counterNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Counter_Destroy as counterDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Counter orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/Dial.chs b/src/Graphics/UI/FLTK/LowLevel/Dial.chs --- a/src/Graphics/UI/FLTK/LowLevel/Dial.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Dial.chs @@ -58,12 +58,13 @@ {# fun Fl_Dial_New_WithLabel as dialNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} dialNew :: Rectangle -> Maybe T.Text -> IO (Ref Dial) dialNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> dialNew' x_pos y_pos width height >>= - toRef - Just l -> dialNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Dial_Destroy as dialDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Dial orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/DoubleWindow.chs b/src/Graphics/UI/FLTK/LowLevel/DoubleWindow.chs --- a/src/Graphics/UI/FLTK/LowLevel/DoubleWindow.chs +++ b/src/Graphics/UI/FLTK/LowLevel/DoubleWindow.chs @@ -121,9 +121,9 @@ -- -- flushSuper :: 'Ref' 'DoubleWindow' -> 'IO' () -- --- handle :: 'Ref' 'DoubleWindow' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handle :: 'Ref' 'DoubleWindow' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- --- handleSuper :: 'Ref' 'DoubleWindow' -> 'Int' -> 'IO' 'Int' +-- handleSuper :: 'Ref' 'DoubleWindow' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'DoubleWindow' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Draw.chs b/src/Graphics/UI/FLTK/LowLevel/Draw.chs --- a/src/Graphics/UI/FLTK/LowLevel/Draw.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Draw.chs @@ -2,8 +2,10 @@ module Graphics.UI.FLTK.LowLevel.Draw ( LineStyle(..), + CapStyle(..), + JoinStyle(..), + LineDrawStyle(..), flcSetColor, - flcSetColorWithC, flcSetColorWithRgb, flcColor, flcPushClip, @@ -22,17 +24,17 @@ flcRectfWithColor, flcRectfWithRgb, flcLine, - flcLineWithX2Y2, + flcLineWith2Edges, flcLoop, - flcLoopWithX3Y3, + flcLoopWith4Sides, flcPolygon, - flcPolygonWithX3Y3, + flcPolygonWith4Sides, flcXyline, - flcXylineWithX2, - flcXylineWithY2X3, - flcYxlineWithY1, - flcYxlineWithY2X2, - flcYxlineWithY2X3, + flcXylineDownByY, + flcXylineDownByYAcrossByX, + flcYxline, + flcYxlineAcrossByX, + flcYxlineAcrossByXDownByY, flcArcByWidthHeight, flcPie, flcPushMatrix, @@ -66,25 +68,17 @@ flcFont, flcSize, flcHeight, - flcSetHeight, + flcHeightOfFont, flcDescent, flcWidth, - flcWidthWithN, - flcWidthWithC, + flcWidthOfChar, flcTextExtents, - flcTextExtentsWithN, flcLatin1ToLocal, - flcLatin1ToLocalWithN, flcLocalToLatin1, - flcLocalToLatin1WithN, flcMacRomanToLocal, - flcMacRomanToLocalWithN, flcLocalToMacRoman, - flcLocalToMacRomanWithN, flcDraw, flcDrawWithAngle, - flcDrawWithN, - flcDrawWithNAngle, flcRtlDraw, flcMeasure, flcDrawInBoxWithImageReference, @@ -114,7 +108,15 @@ flcSetSpotWithWin, flcSetSpot, flcResetSpot, - flcDrawSymbol + flcDrawSymbol, + flcDrawShortcut, + flcSetDrawShortcut, + flcCreateOffscreen + , flcBeginOffscreen + , flcEndOffscreen + , flcDeleteOffscreen + , flcRescaleOffscreen + , flcCopyOffscreen ) where #include "Fl_C.h" @@ -127,34 +129,37 @@ import qualified Data.Text as T import Graphics.UI.FLTK.LowLevel.Hierarchy import Data.ByteString +import Foreign.Marshal.Utils #c enum LineStyle { - SolidLineStyle = FL_SOLID, - SolidDash = FL_DASH, - SolidDot = FL_DOT, - SolidDashDot = FL_DASHDOT, - SolidDashDotDot = FL_DASHDOTDOT, - - SolidCapFlat = FL_CAP_FLAT, - SolidCapRound = FL_CAP_ROUND, - SolidCapSquare = FL_CAP_SQUARE, - - SolidJoinMiter = FL_JOIN_MITER, - SolidJoinRound = FL_JOIN_ROUND, - SolidJoinBevel = FL_JOIN_BEVEL + LineStyleSolid = FL_SOLID, + LineStyleDash = FL_DASH, + LineStyleDot = FL_DOT, + LineStyleDashDot = FL_DASHDOT, + LineStyleDashDotDot = FL_DASHDOTDOT, }; +enum CapStyle { + CapStyleFlat = FL_CAP_FLAT, + CapStyleRound = FL_CAP_ROUND, + CapStyleSquare = FL_CAP_SQUARE, +}; +enum JoinStyle { + JoinStyleMiter = FL_JOIN_MITER, + JoinStyleRound = FL_JOIN_ROUND, + JoinStyleBevel = FL_JOIN_BEVEL +}; #endc -{#enum LineStyle {} deriving (Show) #} +{#enum LineStyle {} deriving (Show, Eq, Ord) #} +{#enum CapStyle {} deriving (Show, Eq, Ord) #} +{#enum JoinStyle {} deriving (Show, Eq, Ord) #} +data LineDrawStyle = LineDrawStyle (Maybe LineStyle) (Maybe CapStyle) (Maybe JoinStyle) + {# fun flc_set_color as flcSetColor' { cFromColor `Color' } -> `()' #} flcSetColor :: Color -> IO () flcSetColor c = flcSetColor' c -{# fun flc_set_color_with_c as flcSetColorWithC' { `Int' } -> `()' #} -flcSetColorWithC :: Int -> IO () -flcSetColorWithC c = flcSetColorWithC' c - {# fun flc_set_color_with_rgb as flcSetColorWithRgb' { id `CUChar',id `CUChar',id `CUChar' } -> `()' #} flcSetColorWithRgb :: RGB -> IO () flcSetColorWithRgb (r', g' , b') = flcSetColorWithRgb' r' g' b' @@ -175,41 +180,54 @@ flcPopClip :: IO () flcPopClip = flcPopClip' -{# fun flc_not_clipped as flcNotClipped' { `Int',`Int',`Int',`Int' } -> `Int' #} -flcNotClipped :: Rectangle -> IO (Int) +{# fun flc_not_clipped as flcNotClipped' { `Int',`Int',`Int',`Int' } -> `Bool' cToBool #} +flcNotClipped :: Rectangle -> IO (Bool) flcNotClipped rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcNotClipped' x_pos' y_pos' width' height' -{# fun flc_clip_box as flcClipBox' { `Int',`Int',`Int',`Int',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv* } -> `Int' #} -flcClipBox :: Rectangle -> IO (Int,Rectangle) +{# fun flc_clip_box as flcClipBox' { `Int',`Int',`Int',`Int',id `Ptr CInt',id `Ptr CInt',id `Ptr CInt',id `Ptr CInt' } -> `Int' #} +flcClipBox :: Rectangle -> IO (Either UnknownError Rectangle) flcClipBox rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in - do - (result, _x', _y', _w', _h') <- flcClipBox' x_pos' y_pos' width' height' - return $ (result, toRectangle (_x', _y', _w', _h')) + (alloca (\_xPtr' -> + (alloca (\_yPtr' -> + (alloca (\_wPtr' -> + (alloca (\_hPtr' -> do + res <- flcClipBox' x_pos' y_pos' width' height' _xPtr' _yPtr' _wPtr' _hPtr' + _x' <- peekIntConv _xPtr' + _y' <- peekIntConv _yPtr' + _w' <- peekIntConv _wPtr' + _h' <- peekIntConv _hPtr' + if (res == 0) then return (Left UnknownError) + else return (Right (toRectangle (fromIntegral _x', fromIntegral _y', fromIntegral _w', fromIntegral _h'))))))))))) {# fun flc_restore_clip as flcRestoreClip' { } -> `()' #} flcRestoreClip :: IO () flcRestoreClip = flcRestoreClip' {# fun flc_set_clip_region as flcSetClipRegion' { id `Ptr ()' } -> `()' #} -flcSetClipRegion :: Ref Region -> IO () +flcSetClipRegion :: Ref FlRegion -> IO () flcSetClipRegion r = withRef r $ \rPtr -> flcSetClipRegion' rPtr {# fun flc_clip_region as flcClipRegion' { } -> `Ptr ()' id #} -flcClipRegion :: IO (Maybe (Ref Region)) +flcClipRegion :: IO (Maybe (Ref FlRegion)) flcClipRegion = flcClipRegion' >>= toMaybeRef {# fun flc_point as flcPoint' { `Int',`Int' } -> `()' #} flcPoint :: Position -> IO () flcPoint (Position (X x_pos') (Y y_pos')) = flcPoint' x_pos' y_pos' -{# fun flc_line_style_with_width_dashes as flcLineStyleWithWidthDashes' {cFromEnum `LineStyle', `Int', id `Ptr CChar' } -> `()' #} -flcLineStyle :: LineStyle -> Maybe Int -> Maybe T.Text -> IO () -flcLineStyle style width' dashes' = do - let _width = maybe 0 id width' +{# fun flc_line_style_with_width_dashes as flcLineStyleWithWidthDashes' {`Int', `Int', id `Ptr CChar' } -> `()' #} +flcLineStyle :: LineDrawStyle -> Maybe Width -> Maybe T.Text -> IO () +flcLineStyle style width' dashes' = + let lineStyleMask = case style of { LineDrawStyle (Just s) _ _ -> fromEnum s; LineDrawStyle Nothing _ _ -> 0} + capStyleMask = case style of { LineDrawStyle _ (Just s) _ -> fromEnum s; LineDrawStyle _ Nothing _ -> 0} + joinStyleMask = case style of { LineDrawStyle _ _ (Just s) -> fromEnum s; LineDrawStyle _ _ Nothing -> 0} + styleMask = lineStyleMask + capStyleMask + joinStyleMask + _width = case width' of { Just (Width w) -> w ; _ -> 0 } + in do _dashes <- maybe (return nullPtr) copyTextToCString dashes' - flcLineStyleWithWidthDashes' style _width _dashes + flcLineStyleWithWidthDashes' styleMask _width _dashes {# fun flc_rect as flcRect' { `Int',`Int',`Int',`Int' } -> `()' #} flcRect :: Rectangle -> IO () @@ -236,56 +254,61 @@ flcLine (Position (X x_pos') (Y y_pos'))(Position (X x_pos'') (Y y_pos'')) = flcLine' x_pos' y_pos' x_pos'' y_pos'' {# fun flc_line_with_x2_y2 as flcLineWithX2Y2' { `Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcLineWithX2Y2 :: Position -> Int -> Int -> Int -> Int -> IO () -flcLineWithX2Y2 (Position (X x_pos') (Y y_pos')) x1 y1 x2 y2 = flcLineWithX2Y2' x_pos' y_pos' x1 y1 x2 y2 +flcLineWith2Edges :: Position -> Position -> Position -> IO () +flcLineWith2Edges (Position (X x_pos') (Y y_pos')) (Position (X x1_pos') (Y y1_pos')) (Position (X x2_pos') (Y y2_pos')) = + flcLineWithX2Y2' x_pos' y_pos' x1_pos' y1_pos' x2_pos' y2_pos' {# fun flc_loop as flcLoop' { `Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcLoop :: Position -> Int -> Int -> Int -> Int -> IO () -flcLoop (Position (X x_pos') (Y y_pos')) x1 y1 x2 y2 = flcLoop' x_pos' y_pos' x1 y1 x2 y2 +flcLoop :: Position -> Position -> Position -> IO () +flcLoop (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) = + flcLoop' x_pos' y_pos' x1 y1 x2 y2 {# fun flc_loop_with_x3_y3 as flcLoopWithX3Y3' { `Int',`Int',`Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcLoopWithX3Y3 :: Position -> Int -> Int -> Int -> Int -> Int -> Int -> IO () -flcLoopWithX3Y3 (Position (X x_pos') (Y y_pos')) x1 y1 x2 y2 x3 y3 = flcLoopWithX3Y3' x_pos' y_pos' x1 y1 x2 y2 x3 y3 +flcLoopWith4Sides :: Position -> Position -> Position -> Position -> IO () +flcLoopWith4Sides (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) (Position (X x3) (Y y3)) = + flcLoopWithX3Y3' x_pos' y_pos' x1 y1 x2 y2 x3 y3 {# fun flc_polygon as flcPolygon' { `Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcPolygon :: Position -> Int -> Int -> Int -> Int -> IO () -flcPolygon (Position (X x_pos') (Y y_pos')) x1 y1 x2 y2 = flcPolygon' x_pos' y_pos' x1 y1 x2 y2 +flcPolygon :: Position -> Position -> Position -> IO () +flcPolygon (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) = + flcPolygon' x_pos' y_pos' x1 y1 x2 y2 {# fun flc_polygon_with_x3_y3 as flcPolygonWithX3Y3' { `Int',`Int',`Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcPolygonWithX3Y3 :: Position -> Int -> Int -> Int -> Int -> Int -> Int -> IO () -flcPolygonWithX3Y3 (Position (X x_pos') (Y y_pos')) x1 y1 x2 y2 x3 y3 = flcPolygonWithX3Y3' x_pos' y_pos' x1 y1 x2 y2 x3 y3 +flcPolygonWith4Sides :: Position -> Position -> Position -> Position -> IO () +flcPolygonWith4Sides (Position (X x_pos') (Y y_pos')) (Position (X x1) (Y y1)) (Position (X x2) (Y y2)) (Position (X x3) (Y y3)) = + flcPolygonWithX3Y3' x_pos' y_pos' x1 y1 x2 y2 x3 y3 {# fun flc_xyline as flcXyline' { `Int',`Int',`Int' } -> `()' #} -flcXyline :: Position -> Int -> IO () -flcXyline (Position (X x_pos') (Y y_pos')) x1 = flcXyline' x_pos' y_pos' x1 +flcXyline :: Position -> X -> IO () +flcXyline (Position (X x_pos') (Y y_pos')) (X x1) = flcXyline' x_pos' y_pos' x1 {# fun flc_xyline_with_x2 as flcXylineWithX2' { `Int',`Int',`Int',`Int' } -> `()' #} -flcXylineWithX2 :: Position -> Int -> Int -> IO () -flcXylineWithX2 (Position (X x_pos') (Y y_pos')) x1 y2 = flcXylineWithX2' x_pos' y_pos' x1 y2 +flcXylineDownByY :: Position -> X -> Y -> IO () +flcXylineDownByY (Position (X x_pos') (Y y_pos')) (X x1) (Y y2) = flcXylineWithX2' x_pos' y_pos' x1 y2 {# fun flc_xyline_with_y2_x3 as flcXylineWithY2X3' { `Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcXylineWithY2X3 :: Position -> Int -> Int -> Int -> IO () -flcXylineWithY2X3 (Position (X x_pos') (Y y_pos')) x1 y2 x3 = flcXylineWithY2X3' x_pos' y_pos' x1 y2 x3 +flcXylineDownByYAcrossByX :: Position -> X -> Y -> X -> IO () +flcXylineDownByYAcrossByX (Position (X x_pos') (Y y_pos')) (X x1) (Y y2) (X x3) = flcXylineWithY2X3' x_pos' y_pos' x1 y2 x3 {# fun flc_yxline_with_y1 as flcYxlineWithY1' { `Int',`Int',`Int' } -> `()' #} -flcYxlineWithY1 :: Position -> Int -> IO () -flcYxlineWithY1 (Position (X x_pos') (Y y_pos')) y1 = flcYxlineWithY1' x_pos' y_pos' y1 +flcYxline :: Position -> Y -> IO () +flcYxline (Position (X x_pos') (Y y_pos')) (Y y1) = flcYxlineWithY1' x_pos' y_pos' y1 {# fun flc_yxline_with_y2_x2 as flcYxlineWithY2X2' { `Int',`Int',`Int',`Int' } -> `()' #} -flcYxlineWithY2X2 :: Position -> Int -> Int -> IO () -flcYxlineWithY2X2 (Position (X x_pos') (Y y_pos')) y1 x2 = flcYxlineWithY2X2' x_pos' y_pos' y1 x2 +flcYxlineAcrossByX :: Position -> Y -> X -> IO () +flcYxlineAcrossByX (Position (X x_pos') (Y y_pos')) (Y y1) (X x2) = flcYxlineWithY2X2' x_pos' y_pos' y1 x2 {# fun flc_yxline_with_y2_x3 as flcYxlineWithY2X3' { `Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcYxlineWithY2X3 :: Position -> Int -> Int -> Int -> IO () -flcYxlineWithY2X3 (Position (X x_pos') (Y y_pos')) y1 x2 y3 = flcYxlineWithY2X3' x_pos' y_pos' y1 x2 y3 +flcYxlineAcrossByXDownByY :: Position -> Y -> X -> Y -> IO () +flcYxlineAcrossByXDownByY (Position (X x_pos') (Y y_pos')) (Y y1) (X x2) (Y y3) = flcYxlineWithY2X3' x_pos' y_pos' y1 x2 y3 {# fun flc_arc_by_width_height as flcArcByWidthHeight' { `Int',`Int',`Int',`Int',`Double',`Double' } -> `()' #} -flcArcByWidthHeight :: Rectangle -> Double -> Double -> IO () -flcArcByWidthHeight rectangle a1 a2 = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcArcByWidthHeight' x_pos' y_pos' width' height' a1 a2 +flcArcByWidthHeight :: Rectangle -> PreciseAngle -> PreciseAngle -> IO () +flcArcByWidthHeight rectangle (PreciseAngle a1) (PreciseAngle a2) = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcArcByWidthHeight' x_pos' y_pos' width' height' a1 a2 {# fun flc_pie as flcPie' { `Int',`Int',`Int',`Int',`Double',`Double' } -> `()' #} -flcPie :: Rectangle -> Double -> Double -> IO () -flcPie rectangle a1 a2 = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcPie' x_pos' y_pos' width' height' a1 a2 +flcPie :: Rectangle -> PreciseAngle -> PreciseAngle -> IO () +flcPie rectangle (PreciseAngle a1) (PreciseAngle a2) = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcPie' x_pos' y_pos' width' height' a1 a2 {# fun flc_push_matrix as flcPushMatrix' { } -> `()' #} flcPushMatrix :: IO () @@ -308,8 +331,8 @@ flcTranslate (ByXY (ByX by_x') (ByY by_y')) = flcTranslate' by_x' by_y' {# fun flc_rotate as flcRotate' { `Double' } -> `()' #} -flcRotate :: Double -> IO () -flcRotate d = flcRotate' d +flcRotate :: PreciseAngle -> IO () +flcRotate (PreciseAngle d) = flcRotate' d {# fun flc_mult_matrix as flcMultMatrix' { `Double',`Double',`Double',`Double',`Double',`Double' } -> `()' #} flcMultMatrix :: Double -> Double -> Double -> Double -> ByXY -> IO () @@ -332,20 +355,20 @@ flcBeginPolygon = flcBeginPolygon' {# fun flc_vertex as flcVertex' { `Double',`Double' } -> `()' #} -flcVertex :: ByXY -> IO () -flcVertex (ByXY (ByX by_x') (ByY by_y')) = flcVertex' by_x' by_y' +flcVertex :: PrecisePosition -> IO () +flcVertex (PrecisePosition (PreciseX x') (PreciseY y')) = flcVertex' x' y' {# fun flc_curve as flcCurve' { `Double',`Double',`Double',`Double',`Double',`Double',`Double',`Double' } -> `()' #} -flcCurve :: Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> IO () -flcCurve x0 y0 x1 y1 x2 y2 x3 y3 = flcCurve' x0 y0 x1 y1 x2 y2 x3 y3 +flcCurve :: PrecisePosition -> PrecisePosition -> PrecisePosition -> PrecisePosition -> IO () +flcCurve (PrecisePosition (PreciseX x0) (PreciseY y0)) (PrecisePosition (PreciseX x1) (PreciseY y1)) (PrecisePosition (PreciseX x2) (PreciseY y2)) (PrecisePosition (PreciseX x3) (PreciseY y3)) = flcCurve' x0 y0 x1 y1 x2 y2 x3 y3 {# fun flc_arc_by_radius as flcArcByRadius' { `Double',`Double',`Double',`Double',`Double' } -> `()' #} -flcArcByRadius :: ByXY -> Double -> Double -> Double -> IO () -flcArcByRadius (ByXY (ByX by_x') (ByY by_y')) r start' end' = flcArcByRadius' by_x' by_y' r start' end' +flcArcByRadius :: PrecisePosition -> Double -> PreciseAngle -> PreciseAngle -> IO () +flcArcByRadius (PrecisePosition (PreciseX x') (PreciseY y')) r (PreciseAngle start') (PreciseAngle end') = flcArcByRadius' x' y' r start' end' {# fun flc_circle as flcCircle' { `Double',`Double',`Double' } -> `()' #} -flcCircle :: ByXY -> Double -> IO () -flcCircle (ByXY (ByX by_x') (ByY by_y')) r = flcCircle' by_x' by_y' r +flcCircle :: PrecisePosition -> Double -> IO () +flcCircle (PrecisePosition (PreciseX x') (PreciseY y')) r = flcCircle' x' y' r {# fun flc_end_points as flcEndPoints' { } -> `()' #} flcEndPoints :: IO () @@ -392,8 +415,8 @@ flcTransformDy (ByXY (ByX by_x') (ByY by_y')) = flcTransformDy' by_x' by_y' {# fun flc_transformed_vertex as flcTransformedVertex' { `Double',`Double' } -> `()' #} -flcTransformedVertex :: Double -> Double -> IO () -flcTransformedVertex xf yf = flcTransformedVertex' xf yf +flcTransformedVertex :: PrecisePosition -> IO () +flcTransformedVertex (PrecisePosition (PreciseX xf) (PreciseY yf)) = flcTransformedVertex' xf yf {# fun flc_set_font as flcSetFont' { cFromFont `Font',id `CInt' } -> `()' #} flcSetFont :: Font -> FontSize -> IO () @@ -408,69 +431,45 @@ flcSize = flcSize' >>= return . FontSize {# fun flc_height as flcHeight' { } -> `Int' #} -flcHeight :: IO (Int) -flcHeight = flcHeight' +flcHeight :: IO (Height) +flcHeight = flcHeight' >>= return . Height -{# fun flc_set_height as flcSetHeight' { `Int',`Int' } -> `Int' #} -flcSetHeight :: Int -> Int -> IO (Int) -flcSetHeight font' size' = flcSetHeight' font' size' +{# fun flc_set_height as flcSetHeight' { `Int',`CInt' } -> `Int' #} +flcHeightOfFont :: Font -> FontSize -> IO (Height) +flcHeightOfFont (Font font') (FontSize size') = flcSetHeight' font' size' >>= return . Height {# fun flc_descent as flcDescent' { } -> `Int' #} flcDescent :: IO (Int) flcDescent = flcDescent' {# fun flc_width as flcWidth' { unsafeToCString `T.Text' } -> `Double' #} -flcWidth :: T.Text -> IO (Double) -flcWidth txt = flcWidth' txt - -{# fun flc_width_with_n as flcWidthWithN' { unsafeToCString `T.Text',`Int' } -> `Double' #} -flcWidthWithN :: T.Text -> Int -> IO (Double) -flcWidthWithN txt n = flcWidthWithN' txt n +flcWidth :: T.Text -> IO (PreciseWidth) +flcWidth txt = flcWidth' txt >>= return . PreciseWidth {# fun flc_width_with_c as flcWidthWithC' { `Int' } -> `Double' #} -flcWidthWithC :: Int -> IO (Double) -flcWidthWithC c = flcWidthWithC' c +flcWidthOfChar :: Int -> IO (PreciseWidth) +flcWidthOfChar c = flcWidthWithC' c >>= return . PreciseWidth {# fun flc_text_extents as flcTextExtents' { unsafeToCString `T.Text',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv* } -> `()' #} flcTextExtents :: T.Text -> IO (Rectangle) flcTextExtents s = flcTextExtents' s >>= \(rectangle') -> return $ (toRectangle rectangle') -{# fun flc_text_extents_with_n as flcTextExtentsWithN' { unsafeToCString `T.Text',`Int',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv* } -> `()' #} -flcTextExtentsWithN :: T.Text -> Int -> IO (Rectangle) -flcTextExtentsWithN t n = flcTextExtentsWithN' t n >>= \(rectangle') -> return $ (toRectangle rectangle') - {# fun flc_latin1_to_local as flcLatin1ToLocal' { unsafeToCString `T.Text' } -> `T.Text' unsafeFromCString #} flcLatin1ToLocal :: T.Text -> IO T.Text flcLatin1ToLocal t = flcLatin1ToLocal' t -{# fun flc_latin1_to_local_with_n as flcLatin1ToLocalWithN' { unsafeToCString `T.Text',`Int' } -> `T.Text' unsafeFromCString #} -flcLatin1ToLocalWithN :: T.Text -> Int -> IO T.Text -flcLatin1ToLocalWithN t n = flcLatin1ToLocalWithN' t n - {# fun flc_local_to_latin1 as flcLocalToLatin1' { unsafeToCString `T.Text' } -> `T.Text' unsafeFromCString #} flcLocalToLatin1 :: T.Text -> IO T.Text flcLocalToLatin1 t = flcLocalToLatin1' t -{# fun flc_local_to_latin1_with_n as flcLocalToLatin1WithN' { unsafeToCString `T.Text',`Int' } -> `T.Text' unsafeFromCString #} -flcLocalToLatin1WithN :: T.Text -> Int -> IO T.Text -flcLocalToLatin1WithN t n = flcLocalToLatin1WithN' t n - {# fun flc_mac_roman_to_local as flcMacRomanToLocal' { unsafeToCString `T.Text' } -> `T.Text' unsafeFromCString #} flcMacRomanToLocal :: T.Text -> IO T.Text flcMacRomanToLocal t = flcMacRomanToLocal' t -{# fun flc_mac_roman_to_local_with_n as flcMacRomanToLocalWithN' { unsafeToCString `T.Text',`Int' } -> `T.Text' unsafeFromCString #} -flcMacRomanToLocalWithN :: T.Text -> Int -> IO T.Text -flcMacRomanToLocalWithN t n = flcMacRomanToLocalWithN' t n - {# fun flc_local_to_mac_roman as flcLocalToMacRoman' { unsafeToCString `T.Text' } -> `T.Text' unsafeFromCString #} flcLocalToMacRoman :: T.Text -> IO T.Text flcLocalToMacRoman t = flcLocalToMacRoman' t -{# fun flc_local_to_mac_roman_with_n as flcLocalToMacRomanWithN' { unsafeToCString `T.Text',`Int' } -> `T.Text' unsafeFromCString #} -flcLocalToMacRomanWithN :: T.Text -> Int -> IO T.Text -flcLocalToMacRomanWithN t n = flcLocalToMacRomanWithN' t n - {# fun flc_draw as flcDraw' { unsafeToCString `T.Text',`Int',`Int' } -> `()' #} flcDraw :: T.Text -> Position -> IO () flcDraw str (Position (X x_pos') (Y y_pos')) = flcDraw' str x_pos' y_pos' @@ -479,20 +478,12 @@ flcDrawWithAngle :: Int -> T.Text -> Position -> IO () flcDrawWithAngle angle str (Position (X x_pos') (Y y_pos')) = flcDrawWithAngle' angle str x_pos' y_pos' -{# fun flc_draw_with_n as flcDrawWithN' { unsafeToCString `T.Text',`Int',`Int',`Int' } -> `()' #} -flcDrawWithN :: T.Text -> Int -> Position -> IO () -flcDrawWithN str n (Position (X x_pos') (Y y_pos')) = flcDrawWithN' str n x_pos' y_pos' - -{# fun flc_draw_with_n_angle as flcDrawWithNAngle' { `Int',unsafeToCString `T.Text',`Int',`Int',`Int' } -> `()' #} -flcDrawWithNAngle :: Int -> T.Text -> Int -> Position -> IO () -flcDrawWithNAngle angle str n (Position (X x_pos') (Y y_pos')) = flcDrawWithNAngle' angle str n x_pos' y_pos' - {# fun flc_rtl_draw as flcRtlDraw' { unsafeToCString `T.Text',`Int',`Int',`Int' } -> `()' #} flcRtlDraw :: T.Text -> Int -> Position -> IO () flcRtlDraw str n (Position (X x_pos') (Y y_pos')) = flcRtlDraw' str n x_pos' y_pos' {# fun flc_measure_with_draw_symbols as flcMeasureWithDrawSymbols' { unsafeToCString `T.Text', id `Ptr CInt', id `Ptr CInt', `CInt' } -> `()' #} -flcMeasure :: T.Text -> Bool -> Bool -> IO (Size) +flcMeasure :: T.Text -> Maybe Width -> Bool -> IO (Size) flcMeasure str word_wrap draw_symbols = alloca $ \widthPtr' -> alloca $ \heightPtr' -> @@ -501,10 +492,9 @@ w' <- peekIntConv widthPtr' h' <- peekIntConv heightPtr' return $ toSize (w',h') - in - if word_wrap - then poke widthPtr' 1 >> doit - else doit + in do + poke widthPtr' (maybe 0 (\(Width w) -> fromIntegral w) word_wrap) + doit {# fun flc_draw_with_img_draw_symbols as flcDrawWithImgDrawSymbols' { unsafeToCString `T.Text',`Int',`Int',`Int',`Int',`Int', id `Ptr ()',`Bool' } -> `()' #} {# fun flc_draw_with_callthis_img_draw_symbols as flcDrawWithCallthisImgDrawSymbols' { unsafeToCString `T.Text',`Int',`Int',`Int',`Int',`Int', id `FunPtr DrawCallbackPrim', id `Ptr ()',`Bool' } -> `()' #} @@ -580,47 +570,65 @@ return bs {# fun flc_draw_pixmap_with_color as flcDrawPixmapWithColor' { id `(Ptr (Ptr CChar))',`Int',`Int',cFromColor `Color' } -> `Int' #} -flcDrawPixmapWithColor :: PixmapHs -> Position -> Color -> IO (Int) +flcDrawPixmapWithColor :: PixmapHs -> Position -> Color -> IO (Either UnknownError ()) flcDrawPixmapWithColor pixmap (Position (X x_pos') (Y y_pos')) color' = - withPixmap pixmap $ \pptr -> flcDrawPixmapWithColor' pptr x_pos' y_pos' color' + (withPixmap pixmap (\pptr -> flcDrawPixmapWithColor' pptr x_pos' y_pos' color'>>= return . successOrUnknownError ())) {# fun flc_draw_pixmap as flcDrawPixmap' { id `(Ptr(Ptr CChar))',`Int',`Int' } -> `Int' #} -flcDrawPixmap :: PixmapHs -> Position -> IO (Int) +flcDrawPixmap :: PixmapHs -> Position -> IO (Either UnknownError ()) flcDrawPixmap pixmap (Position (X x_pos') (Y y_pos')) = - withPixmap pixmap $ \pptr -> flcDrawPixmap' pptr x_pos' y_pos' + withPixmap pixmap $ \pptr -> flcDrawPixmap' pptr x_pos' y_pos' >>= return . successOrUnknownError () {# fun flc_draw_pixmap_with_cdata_color as flcDrawPixmapWithCdataColor' { id `(Ptr (Ptr CChar))',`Int',`Int',cFromColor `Color' } -> `Int' #} -flcDrawPixmapWithCdataColor :: PixmapHs -> Position -> Color -> IO (Int) +flcDrawPixmapWithCdataColor :: PixmapHs -> Position -> Color -> IO (Either UnknownError ()) flcDrawPixmapWithCdataColor pixmap (Position (X x_pos') (Y y_pos')) color' = - withPixmap pixmap $ \pptr -> flcDrawPixmapWithCdataColor' pptr x_pos' y_pos' color' + withPixmap pixmap ( \pptr -> flcDrawPixmapWithCdataColor' pptr x_pos' y_pos' color' >>= return . successOrUnknownError ()) {# fun flc_draw_pixmap_with_cdata as flcDrawPixmapWithCdata' { id `(Ptr (Ptr CChar))',`Int',`Int' } -> `Int' #} -flcDrawPixmapWithCdata :: PixmapHs -> Position -> IO (Int) +flcDrawPixmapWithCdata :: PixmapHs -> Position -> IO (Either UnknownError ()) flcDrawPixmapWithCdata pixmap (Position (X x_pos') (Y y_pos')) = - withPixmap pixmap $ \pptr -> flcDrawPixmapWithCdata' pptr x_pos' y_pos' + withPixmap pixmap $ \pptr -> flcDrawPixmapWithCdata' pptr x_pos' y_pos' >>= return . successOrUnknownError () -{# fun flc_measure_pixmap as flcMeasurePixmap' { id `(Ptr (Ptr CChar))',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv* } -> `Int' #} -flcMeasurePixmap :: PixmapHs -> IO (Int,Size) +{# fun flc_measure_pixmap as flcMeasurePixmap' { id `(Ptr (Ptr CChar))',id `Ptr CInt',id `Ptr CInt' } -> `Int' #} +flcMeasurePixmap :: PixmapHs -> IO (Either UnknownError Size) flcMeasurePixmap pixmap = - withPixmap pixmap $ \pptr -> - flcMeasurePixmap' pptr >>= \(result, width', height') -> - return $ (result, toSize (width', height')) + withPixmap pixmap + (\pptr -> + alloca (\wPtr -> + alloca (\hPtr -> do + res <- flcMeasurePixmap' pptr wPtr hPtr + if (res == 0) then return (Left UnknownError) + else do + w' <- peekIntConv wPtr + h' <- peekIntConv hPtr + return (Right (Size (Width (fromIntegral w')) (Height (fromIntegral h')))) + )) + ) -{# fun flc_measure_pixmap_with_cdata as flcMeasurePixmapWithCdata' { id `(Ptr (Ptr CChar))',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv* } -> `Int' #} -flcMeasurePixmapWithCdata :: PixmapHs -> IO (Int,Size) +{# fun flc_measure_pixmap_with_cdata as flcMeasurePixmapWithCdata' { id `(Ptr (Ptr CChar))', id `Ptr CInt', id `Ptr CInt' } -> `Int' #} +flcMeasurePixmapWithCdata :: PixmapHs -> IO (Either UnknownError Size) flcMeasurePixmapWithCdata pixmap = - withPixmap pixmap (\pptr -> do - (result, width', height') <- flcMeasurePixmapWithCdata' pptr - return (result, toSize (width', height')) - ) + withPixmap pixmap + (\pptr -> + alloca (\wPtr -> + alloca (\hPtr -> do + res <- flcMeasurePixmapWithCdata' pptr wPtr hPtr + if (res == 0) then return (Left UnknownError) + else do + w' <- peekIntConv wPtr + h' <- peekIntConv hPtr + return (Right (Size (Width (fromIntegral w')) (Height (fromIntegral h')))) + )) + ) -{# fun flc_shortcut_label as flcShortcutLabel' { `Int' } -> `T.Text' unsafeFromCString #} -flcShortcutLabel :: Int -> IO T.Text -flcShortcutLabel shortcut = flcShortcutLabel' shortcut +{# fun flc_shortcut_label as flcShortcutLabel' { `CInt' } -> `T.Text' unsafeFromCString #} +flcShortcutLabel :: ShortcutKeySequence -> IO T.Text +flcShortcutLabel (ShortcutKeySequence eventstates keytype) = + flcShortcutLabel' (keySequenceToCInt eventstates keytype) -{# fun flc_old_shortcut as flcOldShortcut' { unsafeToCString `T.Text' } -> `Int' #} -flcOldShortcut :: T.Text -> IO (Int) -flcOldShortcut s = flcOldShortcut' s +{# fun flc_old_shortcut as flcOldShortcut' { unsafeToCString `T.Text' } -> `CInt' #} +flcOldShortcut :: T.Text -> IO (Maybe ShortcutKeySequence) +flcOldShortcut s = flcOldShortcut' s >>= return . cIntToKeySequence {# fun flc_overlay_rect as flcOverlayRect' { `Int',`Int',`Int',`Int' } -> `()' #} flcOverlayRect :: Rectangle -> IO () @@ -650,18 +658,57 @@ flcSetStatus :: Rectangle -> IO () flcSetStatus rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcSetStatus' x_pos' y_pos' width' height' -{# fun flc_set_spot_with_win as flcSetSpotWithWin' { `Int',`Int',`Int',`Int',`Int',`Int',id `Ptr ()' } -> `()' #} -flcSetSpotWithWin :: (Parent a Window) => Int -> Int -> Rectangle -> Ref a -> IO () -flcSetSpotWithWin font' size' rectangle win = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withRef win $ \winPtr -> flcSetSpotWithWin' font' size' x_pos' y_pos' width' height' winPtr +{# fun flc_set_spot_with_win as flcSetSpotWithWin' { `Int',`CInt',`Int',`Int',`Int',`Int',id `Ptr ()' } -> `()' #} +flcSetSpotWithWin :: (Parent a Window) => Font -> FontSize -> Rectangle -> Ref a -> IO () +flcSetSpotWithWin (Font font') (FontSize size') rectangle win = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withRef win $ \winPtr -> flcSetSpotWithWin' font' size' x_pos' y_pos' width' height' winPtr -{# fun flc_set_spot as flcSetSpot' { `Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} -flcSetSpot :: Int -> Int -> Rectangle -> IO () -flcSetSpot font' size' rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcSetSpot' font' size' x_pos' y_pos' width' height' +{# fun flc_set_spot as flcSetSpot' { `Int',`CInt',`Int',`Int',`Int',`Int' } -> `()' #} +flcSetSpot :: Font -> FontSize -> Rectangle -> IO () +flcSetSpot (Font font') (FontSize size') rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcSetSpot' font' size' x_pos' y_pos' width' height' {# fun flc_reset_spot as flcResetSpot' { } -> `()' #} flcResetSpot :: IO () flcResetSpot = flcResetSpot' {# fun flc_draw_symbol as flcDrawSymbol' { unsafeToCString `T.Text',`Int',`Int',`Int',`Int',cFromColor `Color' } -> `Int' #} -flcDrawSymbol :: T.Text -> Rectangle -> Color -> IO (Int) -flcDrawSymbol label rectangle color' = let (x_pos', y_pos', width', height') = fromRectangle rectangle in flcDrawSymbol' label x_pos' y_pos' width' height' color' +flcDrawSymbol :: T.Text -> Rectangle -> Color -> IO (Either UnknownError ()) +flcDrawSymbol label rectangle color' = + let (x_pos', y_pos', width', height') = fromRectangle rectangle + in do + res <- flcDrawSymbol' label x_pos' y_pos' width' height' color' + if (res == 0) + then return (Right ()) + else return (Left UnknownError) + +{# fun flc_get_draw_shortcut as flcDrawShortcut' { } -> `CChar' id #} +flcDrawShortcut :: IO (Maybe DrawShortcut) +flcDrawShortcut = do + res <- flcDrawShortcut' + return (drawShortcutFromC res) + +{# fun flc_set_draw_shortcut as flcSetDrawShortcut' { id `CChar' } -> `()' #} +flcSetDrawShortcut :: Maybe DrawShortcut -> IO () +flcSetDrawShortcut sh = flcSetDrawShortcut' (drawShortcutToC sh) + +-- | Only available on FLTK version 1.4.0 and above. +flcCreateOffscreen :: Size -> IO FlOffscreen +flcCreateOffscreen (Size (Width w') (Height h')) = + {#call flc_create_offscreen as flcCreateOffscreen' #} (fromIntegral w') (fromIntegral h') >>= return . FlOffscreen +{#fun flc_begin_offscreen as flcBeginOffscreen' {id `Fl_Offscreen'} -> `()' #} +-- | Only available on FLTK version 1.4.0 and above. +flcBeginOffscreen :: FlOffscreen -> IO () +flcBeginOffscreen (FlOffscreen o) = flcBeginOffscreen' o +-- | Only available on FLTK version 1.4.0 and above. +flcEndOffscreen :: IO () +flcEndOffscreen = {# call flc_end_offscreen as flcEndOffscreen' #} +-- | Only available on FLTK version 1.4.0 and above. +{#fun flc_delete_offscreen as flcDeleteOffscreen' {id `Fl_Offscreen'} -> `()' #} +flcDeleteOffscreen :: FlOffscreen -> IO () +flcDeleteOffscreen (FlOffscreen o) = flcDeleteOffscreen' o +{#fun flc_rescale_offscreen as flcRescaleOffscreen' {id `Ptr Fl_Offscreen'} -> `()' #} +flcRescaleOffscreen :: FlOffscreen -> IO () +flcRescaleOffscreen (FlOffscreen o) = with o flcRescaleOffscreen' +{#fun flc_copy_offscreen as flcCopyOffscreen' {`Int', `Int', `Int', `Int', id `Fl_Offscreen', `Int', `Int' } -> `()' #} +flcCopyOffscreen :: Position -> Size -> FlOffscreen -> Position -> IO () +flcCopyOffscreen (Position (X x') (Y y')) (Size (Width w') (Height h')) (FlOffscreen o) (Position (X srcx) (Y srcy)) = + flcCopyOffscreen' x' y' w' h' o srcx srcy diff --git a/src/Graphics/UI/FLTK/LowLevel/FL.chs b/src/Graphics/UI/FLTK/LowLevel/FL.chs --- a/src/Graphics/UI/FLTK/LowLevel/FL.chs +++ b/src/Graphics/UI/FLTK/LowLevel/FL.chs @@ -114,13 +114,16 @@ removeFromColormap, #endif -- * Box - BoxtypeSpec, + BoxtypeSpec(..), getBoxtype, + getBoxtypePrim, setBoxtype, boxDx, boxDy, boxDw, boxDh, + adjustBoundsByBoxtype, + boxDifferences, drawBoxActive, -- * Fonts getFontName, @@ -146,8 +149,10 @@ eventButton3, eventX, eventY, + eventPosition, eventXRoot, eventYRoot, + eventRootPosition, eventDx, eventDy, eventClicks, @@ -167,7 +172,6 @@ eventText, eventLength, eventClipboardContents, -#if FLTK_API_VERSION >= 10304 setBoxColor, boxColor, abiVersion, @@ -181,7 +185,14 @@ , useHighResGL , setUseHighResGL #endif -#endif + , insertionPointLocation + , resetMarkedText + , runChecks + , screenDriver + , systemDriver + , screenXYWH + , setProgramShouldQuit + , getProgramShouldQuit ) where #include "Fl_C.h" @@ -403,14 +414,34 @@ setGrab wp = withRef wp setGrab' {# fun Fl_event as event { } -> `Event' cToEnum #} -{# fun Fl_event_x as eventX +{# fun Fl_event_x as eventX' { } -> `Int'#} -{# fun Fl_event_y as eventY +eventX :: IO X +eventX = eventX' >>= return . X +{# fun Fl_event_y as eventY' { } -> `Int'#} -{# fun Fl_event_x_root as eventXRoot +eventY :: IO Y +eventY = eventY' >>= return . Y +{# fun Fl_event_x_root as eventXRoot' { } -> `Int' #} -{# fun Fl_event_y_root as eventYRoot +eventPosition :: IO Position +eventPosition = do + x' <- eventX + y' <- eventY + return (Position x' y') + +eventXRoot :: IO X +eventXRoot = eventXRoot' >>= return . X +{# fun Fl_event_y_root as eventYRoot' { } -> `Int' #} +eventYRoot :: IO Y +eventYRoot = eventYRoot' >>= return . Y + +eventRootPosition :: IO Position +eventRootPosition = do + x' <- eventXRoot + y' <- eventYRoot + return (Position x' y') {# fun Fl_event_dx as eventDx { } -> `Int' #} {# fun Fl_event_dy as eventDy @@ -648,7 +679,6 @@ alloca- `Int' peekIntConv* , alloca- `Int' peekIntConv* } -> `()' #} - {# fun Fl_screen_xywh_with_mxmy as screenXYWYWithMXMY { alloca- `Int' peekIntConv* , @@ -658,7 +688,6 @@ `Int', `Int' } -> `()' #} - {# fun Fl_screen_xywh_with_n as screenXYWNWithN { alloca- `Int' peekIntConv* , @@ -667,7 +696,6 @@ alloca- `Int' peekIntConv* , `Int' } -> `()' #} - {# fun Fl_screen_xywh_with_mxmymwmh as screenXYWHWithNMXMYMWMH { alloca- `Int' peekIntConv* , @@ -756,9 +784,9 @@ (fromIntegral g) (fromIntegral b) {# fun Fl_set_color as setColor - { cFromColor `Color',`Int' } -> `()' supressWarningAboutRes #} + { cFromColor `Color', cFromColor `Color' } -> `()' supressWarningAboutRes #} {# fun Fl_get_color as getColor - { cFromColor `Color' } -> `Int' #} + { cFromColor `Color' } -> `Color' cToColor #} {# fun Fl_get_color_rgb as getColorRgb' { cFromColor `Color', @@ -776,8 +804,8 @@ { cFromColor `Color' } -> `()' supressWarningAboutRes #} {# fun Fl_free_color_with_overlay as freeColorWithOverlay' { cFromColor `Color', `Int' } -> `()' supressWarningAboutRes #} -removeFromColormap :: Maybe Int -> Color -> IO () -removeFromColormap (Just overlay) c = freeColorWithOverlay' c overlay +removeFromColormap :: Maybe Color -> Color -> IO () +removeFromColormap (Just (Color overlay)) c = freeColorWithOverlay' c (fromIntegral overlay) removeFromColormap Nothing c = freeColor' c #endif {# fun Fl_get_font as getFont @@ -854,11 +882,11 @@ removeFd :: CInt -> IO () removeFd fd = removeFd' fd -{# fun Fl_get_boxtype as getBoxtype' +{# fun Fl_get_boxtype as getBoxtypePrim { cFromEnum `Boxtype' } -> `FunPtr BoxDrawFPrim' id #} getBoxtype :: Boxtype -> IO BoxDrawF getBoxtype bt = do - wrappedFunPtr <- getBoxtype' bt + wrappedFunPtr <- getBoxtypePrim bt let boxDrawPrim = unwrapBoxDrawFPrim wrappedFunPtr return $ toBoxDrawF boxDrawPrim @@ -879,6 +907,7 @@ data BoxtypeSpec = FromSpec BoxDrawF Word8 Word8 Word8 Word8 | FromBoxtype Boxtype + | FromFunPtr (FunPtr BoxDrawFPrim) Word8 Word8 Word8 Word8 setBoxtype :: Boxtype -> BoxtypeSpec -> IO () setBoxtype bt (FromSpec f dx dy dw dh) = do @@ -886,6 +915,8 @@ setBoxtype' bt funPtr dx dy dw dh setBoxtype bt (FromBoxtype template) = setBoxtypeByBoxtype' bt template +setBoxtype bt (FromFunPtr funPtr dx dy dw dh) = + setBoxtype' bt funPtr dx dy dw dh {# fun Fl_box_dx as boxDx { cFromEnum `Boxtype' } -> `Int' #} @@ -895,6 +926,23 @@ { cFromEnum `Boxtype' } -> `Int' #} {# fun Fl_box_dh as boxDh { cFromEnum `Boxtype' } -> `Int' #} + +adjustBoundsByBoxtype :: Rectangle -> Boxtype -> IO Rectangle +adjustBoundsByBoxtype rect bt = + let (x',y',w',h') = fromRectangle rect + in do + dx <- boxDx bt + dy <- boxDy bt + dw <- boxDw bt + dh <- boxDh bt + return (toRectangle (x'+dx,y'+dy,w'-dw,h'-dh)) + +boxDifferences :: Rectangle -> Rectangle -> (Int, Int, Int, Int) +boxDifferences r1 r2 = + let (r1x,r1y,r1w,r1h) = fromRectangle r1 + (r2x,r2y,r2w,r2h) = fromRectangle r2 + in (r2x-r1x,r2y-r1y,r1w-r2w,r1h-r2h) + {# fun Fl_draw_box_active as drawBoxActive { } -> `Bool' toBool #} {# fun Fl_event_shift as eventShift @@ -936,7 +984,6 @@ releaseWidgetPointer wp = withRef wp {#call Fl_release_widget_pointer as fl_release_widget_pointer #} clearWidgetPointer :: (Parent a Widget) => Ref a -> IO () clearWidgetPointer wp = withRef wp {#call Fl_clear_widget_pointer as fl_Clear_Widget_Pointer #} -#if FLTK_API_VERSION >= 10304 -- | Only available on FLTK version 1.3.4 and above. setBoxColor :: Color -> IO () setBoxColor c = {#call Fl_set_box_color as fl_set_box_color #} (cFromColor c) @@ -972,7 +1019,21 @@ setUseHighResGL :: Bool -> IO () setUseHighResGL use' = {#call Fl_set_use_high_res_GL as fl_set_use_high_res_GL #} (cFromBool use') #endif -#endif +insertionPointLocation :: Position -> Height -> IO () +insertionPointLocation (Position (X x') (Y y')) (Height h') + = {#call Fl_insertion_point_location as fl_insertion_point_location #} (fromIntegral x') (fromIntegral y') (fromIntegral h') +resetMarkedText :: IO () +resetMarkedText = {#call Fl_reset_marked_text as fl_reset_marked_text #} +runChecks :: IO () +runChecks = {#call Fl_run_checks as fl_run_checks #} +screenDriver :: IO (Maybe (Ref ScreenDriver)) +screenDriver = {#call Fl_screen_driver as fl_screen_driver #} >>= toMaybeRef +systemDriver :: IO (Maybe (Ref SystemDriver)) +systemDriver = {#call Fl_system_driver as fl_system_driver #} >>= toMaybeRef +setProgramShouldQuit :: Bool -> IO () +setProgramShouldQuit = {#call Fl_set_program_should_quit as fl_set_program_should_quit #} . cFromBool +getProgramShouldQuit :: IO Bool +getProgramShouldQuit = {#call Fl_get_program_should_quit as fl_get_program_should_quit #} >>= return . cToBool -- | Use this function to run a GUI in GHCi. diff --git a/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs b/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs --- a/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs +++ b/src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs @@ -8,15 +8,19 @@ -- -- $Goals + -- * Look And Feel + -- + -- $LookAndFeel + -- * Obstacles -- -- $Obstacles - -- * Installation + -- * Installation #Installation# -- -- $InstallationSummary - -- ** Build With Bundled FLTK + -- ** Build With Bundled FLTK #BundledBuild# -- *** Linux & *BSD -- @@ -30,7 +34,7 @@ -- -- $InstallationWindowsBundled - -- ** Compile FLTK Yourself + -- ** Compile FLTK Yourself #SelfCompilation# -- *** Linux & *BSD -- @@ -52,7 +56,7 @@ -- -- $GettingStarted - -- * Fluid Support + -- * Fluid Support #FluidSupport# -- -- $FluidSupport @@ -68,7 +72,7 @@ -- -- $Compilation - -- * Running in the REPL + -- * Running in the REPL #RunningInTheREPL# -- -- $REPL @@ -76,6 +80,8 @@ module Graphics.UI.FLTK.LowLevel.Fl_Types, -- * Widgets module Graphics.UI.FLTK.LowLevel.Adjuster, + module Graphics.UI.FLTK.LowLevel.Ask, + module Graphics.UI.FLTK.LowLevel.BMPImage, module Graphics.UI.FLTK.LowLevel.Bitmap, module Graphics.UI.FLTK.LowLevel.Box, module Graphics.UI.FLTK.LowLevel.Browser, @@ -83,13 +89,17 @@ module Graphics.UI.FLTK.LowLevel.CheckButton, module Graphics.UI.FLTK.LowLevel.Choice, module Graphics.UI.FLTK.LowLevel.Clock, + module Graphics.UI.FLTK.LowLevel.ColorChooser, module Graphics.UI.FLTK.LowLevel.CopySurface, module Graphics.UI.FLTK.LowLevel.Counter, module Graphics.UI.FLTK.LowLevel.Dial, module Graphics.UI.FLTK.LowLevel.DoubleWindow, module Graphics.UI.FLTK.LowLevel.Draw, + module Graphics.UI.FLTK.LowLevel.FileBrowser, + module Graphics.UI.FLTK.LowLevel.FileInput, module Graphics.UI.FLTK.LowLevel.FillDial, module Graphics.UI.FLTK.LowLevel.FillSlider, + module Graphics.UI.FLTK.LowLevel.GIFImage, module Graphics.UI.FLTK.LowLevel.Group, module Graphics.UI.FLTK.LowLevel.HorFillSlider, module Graphics.UI.FLTK.LowLevel.HorNiceSlider, @@ -98,36 +108,49 @@ module Graphics.UI.FLTK.LowLevel.Image, module Graphics.UI.FLTK.LowLevel.ImageSurface, module Graphics.UI.FLTK.LowLevel.Input, - module Graphics.UI.FLTK.LowLevel.Output, - module Graphics.UI.FLTK.LowLevel.IntInput, - module Graphics.UI.FLTK.LowLevel.FileInput, + module Graphics.UI.FLTK.LowLevel.JPEGImage, module Graphics.UI.FLTK.LowLevel.LightButton, module Graphics.UI.FLTK.LowLevel.LineDial, - module Graphics.UI.FLTK.LowLevel.MenuPrim, + module Graphics.UI.FLTK.LowLevel.MenuBar, module Graphics.UI.FLTK.LowLevel.MenuButton, module Graphics.UI.FLTK.LowLevel.MenuItem, + module Graphics.UI.FLTK.LowLevel.MenuPrim, + module Graphics.UI.FLTK.LowLevel.MultiLabel, + module Graphics.UI.FLTK.LowLevel.NativeFileChooser, module Graphics.UI.FLTK.LowLevel.NiceSlider, + module Graphics.UI.FLTK.LowLevel.Output, module Graphics.UI.FLTK.LowLevel.OverlayWindow, + module Graphics.UI.FLTK.LowLevel.PNGImage, + module Graphics.UI.FLTK.LowLevel.PNMImage, + module Graphics.UI.FLTK.LowLevel.Pack, module Graphics.UI.FLTK.LowLevel.Pixmap, module Graphics.UI.FLTK.LowLevel.Positioner, module Graphics.UI.FLTK.LowLevel.Progress, + module Graphics.UI.FLTK.LowLevel.RGBImage, module Graphics.UI.FLTK.LowLevel.RadioLightButton, module Graphics.UI.FLTK.LowLevel.RepeatButton, module Graphics.UI.FLTK.LowLevel.ReturnButton, module Graphics.UI.FLTK.LowLevel.Roller, module Graphics.UI.FLTK.LowLevel.RoundButton, + module Graphics.UI.FLTK.LowLevel.SVGImage, module Graphics.UI.FLTK.LowLevel.Scrollbar, + module Graphics.UI.FLTK.LowLevel.Scrolled, module Graphics.UI.FLTK.LowLevel.SelectBrowser, - module Graphics.UI.FLTK.LowLevel.SimpleCounter, + module Graphics.UI.FLTK.LowLevel.SimpleTerminal, module Graphics.UI.FLTK.LowLevel.SingleWindow, module Graphics.UI.FLTK.LowLevel.Slider, module Graphics.UI.FLTK.LowLevel.Spinner, - module Graphics.UI.FLTK.LowLevel.MenuBar, module Graphics.UI.FLTK.LowLevel.SysMenuBar, - module Graphics.UI.FLTK.LowLevel.Tabs, module Graphics.UI.FLTK.LowLevel.Table, module Graphics.UI.FLTK.LowLevel.TableRow, + module Graphics.UI.FLTK.LowLevel.Tabs, + module Graphics.UI.FLTK.LowLevel.TextBuffer, + module Graphics.UI.FLTK.LowLevel.TextDisplay, + module Graphics.UI.FLTK.LowLevel.TextEditor, + module Graphics.UI.FLTK.LowLevel.TextSelection, + module Graphics.UI.FLTK.LowLevel.Tile, module Graphics.UI.FLTK.LowLevel.ToggleButton, + module Graphics.UI.FLTK.LowLevel.Tooltip, module Graphics.UI.FLTK.LowLevel.Tree, module Graphics.UI.FLTK.LowLevel.TreeItem, module Graphics.UI.FLTK.LowLevel.TreePrefs, @@ -138,116 +161,101 @@ module Graphics.UI.FLTK.LowLevel.Widget, module Graphics.UI.FLTK.LowLevel.Window, module Graphics.UI.FLTK.LowLevel.Wizard, - module Graphics.UI.FLTK.LowLevel.TextSelection, - module Graphics.UI.FLTK.LowLevel.TextBuffer, - module Graphics.UI.FLTK.LowLevel.TextDisplay, - module Graphics.UI.FLTK.LowLevel.TextEditor, - module Graphics.UI.FLTK.LowLevel.NativeFileChooser, - module Graphics.UI.FLTK.LowLevel.Tile, - module Graphics.UI.FLTK.LowLevel.Pack, - module Graphics.UI.FLTK.LowLevel.Scrolled, - module Graphics.UI.FLTK.LowLevel.Ask, - module Graphics.UI.FLTK.LowLevel.ColorChooser, - module Graphics.UI.FLTK.LowLevel.FileBrowser, - module Graphics.UI.FLTK.LowLevel.JPEGImage, - module Graphics.UI.FLTK.LowLevel.RGBImage, - module Graphics.UI.FLTK.LowLevel.BMPImage, - module Graphics.UI.FLTK.LowLevel.GIFImage, module Graphics.UI.FLTK.LowLevel.XBMImage, module Graphics.UI.FLTK.LowLevel.XPMImage, - module Graphics.UI.FLTK.LowLevel.PNGImage, - module Graphics.UI.FLTK.LowLevel.PNMImage, -- * Machinery for static dispatch module Graphics.UI.FLTK.LowLevel.Dispatch, -- * Association of widgets and functions module Graphics.UI.FLTK.LowLevel.Hierarchy ) where -import Graphics.UI.FLTK.LowLevel.SingleWindow -import Graphics.UI.FLTK.LowLevel.Window -import Graphics.UI.FLTK.LowLevel.DoubleWindow -import Graphics.UI.FLTK.LowLevel.OverlayWindow +import Graphics.UI.FLTK.LowLevel.Adjuster +import Graphics.UI.FLTK.LowLevel.Ask +import Graphics.UI.FLTK.LowLevel.BMPImage +import Graphics.UI.FLTK.LowLevel.Bitmap +import Graphics.UI.FLTK.LowLevel.Box +import Graphics.UI.FLTK.LowLevel.Browser import Graphics.UI.FLTK.LowLevel.Button -import Graphics.UI.FLTK.LowLevel.LightButton -import Graphics.UI.FLTK.LowLevel.RadioLightButton import Graphics.UI.FLTK.LowLevel.CheckButton -import Graphics.UI.FLTK.LowLevel.ReturnButton -import Graphics.UI.FLTK.LowLevel.RoundButton -import Graphics.UI.FLTK.LowLevel.RepeatButton -import Graphics.UI.FLTK.LowLevel.ToggleButton -import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Choice +import Graphics.UI.FLTK.LowLevel.Clock +import Graphics.UI.FLTK.LowLevel.ColorChooser +import Graphics.UI.FLTK.LowLevel.CopySurface +import Graphics.UI.FLTK.LowLevel.Counter +import Graphics.UI.FLTK.LowLevel.Dial import Graphics.UI.FLTK.LowLevel.Dispatch -import Graphics.UI.FLTK.LowLevel.Hierarchy -import Graphics.UI.FLTK.LowLevel.Group -import Graphics.UI.FLTK.LowLevel.Widget -import Graphics.UI.FLTK.LowLevel.Valuator -import Graphics.UI.FLTK.LowLevel.Slider -import Graphics.UI.FLTK.LowLevel.Spinner -import Graphics.UI.FLTK.LowLevel.HorSlider +import Graphics.UI.FLTK.LowLevel.DoubleWindow +import Graphics.UI.FLTK.LowLevel.Draw +import Graphics.UI.FLTK.LowLevel.FileBrowser +import Graphics.UI.FLTK.LowLevel.FileInput +import Graphics.UI.FLTK.LowLevel.FillDial import Graphics.UI.FLTK.LowLevel.FillSlider +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.GIFImage +import Graphics.UI.FLTK.LowLevel.Group +import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.HorFillSlider import Graphics.UI.FLTK.LowLevel.HorNiceSlider +import Graphics.UI.FLTK.LowLevel.HorSlider import Graphics.UI.FLTK.LowLevel.HorValueSlider -import Graphics.UI.FLTK.LowLevel.NiceSlider -import Graphics.UI.FLTK.LowLevel.MenuItem -import Graphics.UI.FLTK.LowLevel.MenuPrim -import Graphics.UI.FLTK.LowLevel.MenuBar -import Graphics.UI.FLTK.LowLevel.SysMenuBar -import Graphics.UI.FLTK.LowLevel.Choice -import Graphics.UI.FLTK.LowLevel.MenuButton import Graphics.UI.FLTK.LowLevel.Image -import Graphics.UI.FLTK.LowLevel.Bitmap -import Graphics.UI.FLTK.LowLevel.Pixmap -import Graphics.UI.FLTK.LowLevel.Draw -import Graphics.UI.FLTK.LowLevel.CopySurface import Graphics.UI.FLTK.LowLevel.ImageSurface -import Graphics.UI.FLTK.LowLevel.Adjuster -import Graphics.UI.FLTK.LowLevel.Dial -import Graphics.UI.FLTK.LowLevel.FillDial +import Graphics.UI.FLTK.LowLevel.Input +import Graphics.UI.FLTK.LowLevel.JPEGImage +import Graphics.UI.FLTK.LowLevel.LightButton import Graphics.UI.FLTK.LowLevel.LineDial +import Graphics.UI.FLTK.LowLevel.MenuBar +import Graphics.UI.FLTK.LowLevel.MenuButton +import Graphics.UI.FLTK.LowLevel.MenuItem +import Graphics.UI.FLTK.LowLevel.MenuPrim +import Graphics.UI.FLTK.LowLevel.MultiLabel +import Graphics.UI.FLTK.LowLevel.NativeFileChooser +import Graphics.UI.FLTK.LowLevel.NiceSlider +import Graphics.UI.FLTK.LowLevel.Output +import Graphics.UI.FLTK.LowLevel.OverlayWindow +import Graphics.UI.FLTK.LowLevel.PNGImage +import Graphics.UI.FLTK.LowLevel.PNMImage +import Graphics.UI.FLTK.LowLevel.Pack +import Graphics.UI.FLTK.LowLevel.Pixmap +import Graphics.UI.FLTK.LowLevel.Positioner +import Graphics.UI.FLTK.LowLevel.Progress +import Graphics.UI.FLTK.LowLevel.RGBImage +import Graphics.UI.FLTK.LowLevel.RadioLightButton +import Graphics.UI.FLTK.LowLevel.RepeatButton +import Graphics.UI.FLTK.LowLevel.ReturnButton import Graphics.UI.FLTK.LowLevel.Roller -import Graphics.UI.FLTK.LowLevel.Counter -import Graphics.UI.FLTK.LowLevel.SimpleCounter +import Graphics.UI.FLTK.LowLevel.RoundButton +import Graphics.UI.FLTK.LowLevel.SVGImage import Graphics.UI.FLTK.LowLevel.Scrollbar -import Graphics.UI.FLTK.LowLevel.ValueSlider -import Graphics.UI.FLTK.LowLevel.ValueInput -import Graphics.UI.FLTK.LowLevel.ValueOutput -import Graphics.UI.FLTK.LowLevel.Progress -import Graphics.UI.FLTK.LowLevel.Positioner -import Graphics.UI.FLTK.LowLevel.Input -import Graphics.UI.FLTK.LowLevel.Output -import Graphics.UI.FLTK.LowLevel.Wizard -import Graphics.UI.FLTK.LowLevel.Tabs +import Graphics.UI.FLTK.LowLevel.Scrolled +import Graphics.UI.FLTK.LowLevel.SelectBrowser +import Graphics.UI.FLTK.LowLevel.SimpleTerminal +import Graphics.UI.FLTK.LowLevel.SingleWindow +import Graphics.UI.FLTK.LowLevel.Slider +import Graphics.UI.FLTK.LowLevel.Spinner +import Graphics.UI.FLTK.LowLevel.SysMenuBar import Graphics.UI.FLTK.LowLevel.Table import Graphics.UI.FLTK.LowLevel.TableRow -import Graphics.UI.FLTK.LowLevel.Box -import Graphics.UI.FLTK.LowLevel.Browser -import Graphics.UI.FLTK.LowLevel.SelectBrowser -import Graphics.UI.FLTK.LowLevel.IntInput -import Graphics.UI.FLTK.LowLevel.FileInput -import Graphics.UI.FLTK.LowLevel.Clock -import Graphics.UI.FLTK.LowLevel.TreePrefs -import Graphics.UI.FLTK.LowLevel.TreeItem -import Graphics.UI.FLTK.LowLevel.Tree -import Graphics.UI.FLTK.LowLevel.TextSelection() +import Graphics.UI.FLTK.LowLevel.Tabs import Graphics.UI.FLTK.LowLevel.TextBuffer import Graphics.UI.FLTK.LowLevel.TextDisplay import Graphics.UI.FLTK.LowLevel.TextEditor -import Graphics.UI.FLTK.LowLevel.NativeFileChooser +import Graphics.UI.FLTK.LowLevel.TextSelection() import Graphics.UI.FLTK.LowLevel.Tile -import Graphics.UI.FLTK.LowLevel.Pack -import Graphics.UI.FLTK.LowLevel.Scrolled -import Graphics.UI.FLTK.LowLevel.Ask -import Graphics.UI.FLTK.LowLevel.ColorChooser -import Graphics.UI.FLTK.LowLevel.FileBrowser -import Graphics.UI.FLTK.LowLevel.JPEGImage -import Graphics.UI.FLTK.LowLevel.RGBImage -import Graphics.UI.FLTK.LowLevel.BMPImage -import Graphics.UI.FLTK.LowLevel.GIFImage +import Graphics.UI.FLTK.LowLevel.ToggleButton +import Graphics.UI.FLTK.LowLevel.Tooltip +import Graphics.UI.FLTK.LowLevel.Tree +import Graphics.UI.FLTK.LowLevel.TreeItem +import Graphics.UI.FLTK.LowLevel.TreePrefs +import Graphics.UI.FLTK.LowLevel.Valuator +import Graphics.UI.FLTK.LowLevel.ValueInput +import Graphics.UI.FLTK.LowLevel.ValueOutput +import Graphics.UI.FLTK.LowLevel.ValueSlider +import Graphics.UI.FLTK.LowLevel.Widget +import Graphics.UI.FLTK.LowLevel.Window +import Graphics.UI.FLTK.LowLevel.Wizard import Graphics.UI.FLTK.LowLevel.XBMImage import Graphics.UI.FLTK.LowLevel.XPMImage -import Graphics.UI.FLTK.LowLevel.PNGImage -import Graphics.UI.FLTK.LowLevel.PNMImage -- $Module Documentation -- This module re-exports all the available widgets and @@ -285,7 +293,7 @@ -- These are all great projects and produce really nice UIs, but they all fail -- at least one of criterion listed under the __Goals__ section below. -- --- To my knowledge, as of the second quarter of 2017, no other package +-- To my knowledge, as of the last quarter of 2018, no other package -- in the Haskell ecosystem meets all those constraints. -- @@ -324,6 +332,14 @@ -- comes with a number of demos that show how Fluid integrates with FLTKS. -- +-- $LookAndFeel +-- Now FLTKHS has a [themes +-- package](https://hackage.haskell.org/package/fltkhs/docs/Graphics-UI-FLTK-Theme-Light.html) +-- which considerably improves look and feel. The documentation for this package +-- still applies because the theme mostly just re-draws widgets to look a little +-- nicer so the fundamentals of the API are not touched. + + -- $Obstacles -- This section attempts to briefly highlight some possible dealbreakers users -- might want to know about before proceeding. To be clear, building and deploying @@ -331,16 +347,6 @@ -- library is considered usable. And most of these issues are being aggressively -- addressed but in the interests of full disclosure ... -- --- == Look & Feel --- The default look of FLTK apps can be charitably described as /retro/. And --- FLTK has no support for theming since it was designed for the --- embedded domain and trades off slickness for speed, portability and --- binary size. --- --- But that doesn't mean the user is limited to the default! FLTK is quite flexible --- and it is pretty easy to change the way a widget looks and behaves, but there is no --- "theme file" that applies uniformly to all widgets in the app. --- -- == Compile Times -- Currently a dense app with ~ 160-180 widgets crammed into the same window takes -- 9-12 seconds to compile with GHC 7.10.3 on a 32GB quad-core machine. @@ -403,9 +409,21 @@ -- -- $InstallationSummary --- There are two ways to install FLTKHS, building with the , or compiling and installing FLTK . The bundled way is --- by far the easiest on all platforms. It is completely self-contained, you don't need any sudo access to your system. +-- There are two ways to install FLTKHS, building with the bundled build +-- ("Graphics.UI.FLTK.LowLevel.FLTKHS#BundledBuild"), or compiling and +-- installing FLTK from scratch yourself +-- ("Graphics.UI.FLTK.LowLevel.FLTKHS#SelfCompilation"). The bundled way is by +-- far the easiest on all platforms. It is completely self-contained, you don't +-- need any sudo access to your system. -- +-- For now FLTKHS tracks the [1.4 version Github repo](https://github.com/fltk/fltk) instead +-- of the stable releases. The reason is that it's been quite a while the FLTK +-- project cut an official release but the development branch is actually quite +-- stable and has acquired a lot of useful features including HiDPI and SVG +-- support which are exposed via these bindings. +-- +-- NOTE: Since we are temporarily using stable releases please don't install FLTK with your package manager. +-- -- $InstallationLinuxBundled -- The steps are: -- @@ -464,32 +482,31 @@ -- -- - Make sure you have OpenGL installed. -- - Download & install . --- - Download & install . +-- - Download & install . -- - Download & install the . -- - Verify the install by running `fltkhs-hello-world`. -- -- == Download & Install Stack -- Pick the that matches your distribution and install according the instructions. -- --- == Download & Install FLTK-1.3.4-1 --- Please make sure to only download version --- . +-- == Download & Install FLTK-1.4 +-- Please make sure to only download version . -- It should build and install smoothly with the standard: -- -- @ --- > ./configure --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng +-- > ./configure --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng --enable-xft -- or if you need OpenGL support --- > ./configure --enable-gl --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng +-- > ./configure --enable-gl --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng --enable-xft -- > make -- > sudo make install -- @ -- -- --- If you didn't install FLTK from source, you can use the 'fltk-config' tool to ensure that version 1.3.4-1 is installed: +-- If you didn't install FLTK from source, you can use the 'fltk-config' tool to ensure that version 1.4 is installed: -- -- @ -- > fltk-config --version --- 1.3.4-1 +-- 1.4 -- @ -- -- The FLTK headers should be in the include path, along with @@ -533,8 +550,8 @@ -- @ -- -- __Note:__ If the `install` step produces a flood of `undefined reference` errors, --- please ensure that you have the right version of FLTK (1.3.4-1) installed and --- that the headers are in the expected locations. Some package +-- please ensure that you have the right version of FLTK (1.4) installed and +-- that the headers are in the expected locations. Some package -- managers put the libraries and headers in nonstandard places, so it -- is best to build from source. -- @@ -545,7 +562,7 @@ -- > stack exec fltkhs-hello-world -- @ -- --- You will be greeted by an incredibly boring little window with a button that says "Hello world". +-- You will be greeted by an incredibly boring little window with a button that says "Hello world". -- If you click it, it will change to "Goodbye world." -- $InstallationMacBundled @@ -637,16 +654,16 @@ -- -- -- @ --- > wget http://fltk.org/pub/fltk/1.3.4/fltk-1.3.4-1-source.tar.gz +-- > wget https://github.com/fltk/fltk/archive/master.tar.gz -- > tar -zxf fltk-1.3.4-1-source.tar.gz --- > cd fltk-1.3.4-1 --- > ./configure --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng +-- > cd fltk-master +-- > ./configure --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng --enable-xft -- or if you need OpenGL support --- > ./configure --enable-gl --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng +-- > ./configure --enable-gl --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng --enable-xft -- > make -- > sudo make install -- > fltk-config --version --- 1.3.4-1 +-- 1.4 -- @ -- -- == Download & Install the FLTKHS Hello World Skeleton @@ -859,22 +876,22 @@ -- Download the latest stable build of FLTK: -- -- @ --- > wget --no-check-certificate http://fltk.org/pub/fltk/1.3.4/fltk-1.3.4-1-source.tar.gz +-- > wget --no-check-certificate https://github.com/fltk/fltk/archive/master.tar.gz -- @ -- -- Untar the FLTK archive and enter the directory: -- -- @ --- > tar -zxf fltk-1.3.4-1-source.tar.gz --- > cd fltk-1.3.4-1 +-- > tar -zxf master.tar.gz +-- > cd fltk-master -- @ -- -- Configure, make and install: -- -- @ --- > ./configure --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng +-- > ./configure --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng --enable-xft -- or if you need OpenGL support --- > ./configure --enable-gl --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng +-- > ./configure --enable-gl --enable-shared --enable-localjpeg --enable-localzlib --enable-localpng --enable-xft -- > make -- > make install -- @ @@ -883,7 +900,7 @@ -- -- @ -- > fltk-config --- 1.3.4-1 +-- 1.4 -- @ -- -- == Download And Install The FLTKHS Hello World Skeleton @@ -913,7 +930,7 @@ -- You will be greeted by an incredibly boring little window with a button that says "Hello world". -- If you click it, it will change to "Goodbye world". -- --- == Packaging A Windows Executable +-- == Packaging A Windows Executable #PackagingAWindowsExecutable# -- -- While the 'fltkhs-hello-world' application can mostly stand alone, the MSYS2 environment bundled with 'stack' seems to require 3 runtime DLLs. The DLLs are bundled with 'stack', so you can zip them up with the executable and deploy. The required DLLs are: 'libstdc++-6.dll', 'libgcc_s_seh-1.dll' and 'libwinpthread-1.dll'. -- @@ -993,7 +1010,7 @@ -- -- -- The documentation provided with this API is not yet self-contained and is --- meant to be used in tandem with the . +-- meant to be used in tandem with the . -- The rest of this document is about how the Haskell -- functions and datatypes map to the C++ ones. -- @@ -1005,12 +1022,12 @@ -- that this reference is a pointer to a void pointer to a C++ object. -- -- For instance, 'windowNew' creates a 'Ref' 'Window', which is a pointer to a --- C++ object of type , the FLTK class that knows how to draw, +-- C++ object of type , the FLTK class that knows how to draw, -- display, and handle window events. -- -- This value of type 'Ref' 'Window' is then passed along to various functions -- which transparently extract the pointer and pass it to the --- appropriate instance method. +-- appropriate instance method. -- -- == Widget Methods -- @@ -1028,7 +1045,7 @@ -- navigate to the corresponding widget's module, find the __Functions__ header -- and scroll down to the desired function. Haddock, unfortunately, does not -- support anchors that link to a named point in the page. I'm /very/ --- open to ideas on how to make this easier. -- JULIE HAS A QUESTION: wait, so which signatures are listed where exactly? like, what is this opposed to? +-- open to ideas on how to make this easier. -- -- Carrying on the previous example from the __Widget Creation__ section, the -- methods on a 'Ref' 'Window' widget are documented in @@ -1040,7 +1057,7 @@ -- possible in name and argument list to the underlying C++. This allows users -- familiar with the FLTK API to use this library with less learning overhead -- and it lets newcomers to FLTK take advantage of the already extensive --- . +-- . -- -- Functions are named to make it as easy as possible to find the corresponding -- C++ function, however there are some naming conventions to keep in mind: @@ -1079,29 +1096,41 @@ -- -- For instance, the __Functions__ section under -- "Graphics.UI.FLTK.LowLevel.Window" shows that a 'Ref' 'Window' can be passed --- to /getModal/ to check if the window is modal, but it can also be passed to --- /children/ in "Graphics.UI.FLTK.LowLevel.Group" which counts up the number of --- widgets inside the 'Window' and /getX/ in "Graphics.UI.FLTK.LowLevel.Widget" --- which returns the X coordinate of the 'Window''s top-left hand corner. JULIE: should these emph'd words be straight-quoted? +-- to @getModal@ to check if the window is modal, but it can also be passed to +-- @children@ in "Graphics.UI.FLTK.LowLevel.Group" which counts up the number of +-- widgets inside the 'Window' and @getX@ in "Graphics.UI.FLTK.LowLevel.Widget" +-- which returns the X coordinate of the 'Window''s top-left hand corner. -- -- The hierarchy corresponds almost exactly to the underlying C++ class -- hierarchy so, again, you should be able to take advantage of the --- to use the +-- to use the -- binding API. -- -- === Overriding C++ methods -- --- The binding API allows a limited but powerful form of "inheritance" allowing users to --- override certain key FLTK methods with Haskell functions. All GUI elements --- that derive from the C++ base class --- and the Haskell analog --- now allow Haskell to be passed at --- widget construction time that give Haskell complete control on , --- . This means that the Haskell user has --- complete control of the look and feel as well as the event loop. The demos are --- an example of drawing in Haskell. An example of taking over the event loop is an FLTKHS that --- the FLTKHS event loop with the allowing --- native functional reactive programming. The sky is the limit! +-- The binding API allows a limited but powerful form of "inheritance" allowing +-- users to override certain key FLTK methods with Haskell functions. All GUI +-- elements that derive from the C++ base class +-- and the Haskell +-- analog +-- now allow Haskell +-- to be passed at widget construction time that give Haskell +-- complete control on +-- , +-- . This means that the Haskell user +-- has complete control of the look and feel as well as the event loop. The +-- demos are an example of drawing in Haskell. An example of taking over +-- the event loop is an FLTKHS that +-- the FLTKHS event loop with the +-- allowing native +-- functional reactive programming. The sky is the limit! -- -- When providing custom methods, the object constructor is no longer -- `New` but `Custom`, which, in addition to the parameters @@ -1123,7 +1152,7 @@ -- Its custom constructor 'windowCustom', in fact, takes two records: a -- 'CustomWidgetFuncs' which allows you to override methods in its -- "Graphics.UI.FLTK.LowLevel.Widget" parent class, and also a --- 'CustomWindowFuncs' record which allows you to override /flush/, a +-- 'CustomWindowFuncs' record which allows you to override @flush@, a -- method on the Window class which tells the window how to force a redraw. For -- example, the demo /src\/Examples\/doublebuffer.hs/ (which corresponds to the -- executable 'ftlkhs-doublebuffer') tells both windows how to draw themselves @@ -1184,7 +1213,7 @@ -- compiling executables, dramatically decreases compile time but also bloats -- the resulting executable size and probably makes runtime performance much -- slower. In this package and --- it is enabled by default since the executables are +-- it is enabled by default since the executables are -- demos that are not meant to show off performance. To disable this flag, tell -- Stack to ignore it during the `build` step: -- @@ -1234,10 +1263,10 @@ -- @ -- -- Unfortunately since FLTKHS is hybrid Haskell/C++ there are limitations compared to --- running a plain 'ol Haskell library on the REPL: +-- running a normal Haskell library on the REPL: -- -- 1. The 'stack build ...' is an essential first step before running 'stack --- ghci ...'. The reason is it uses '-fobject-code' to link in all the C++ +-- ghci ...'. The reason is the REPL uses '-fobject-code' to link in all the C++ -- libraries which must be built first. -- 2. The use of 'replMain' instead of just ':main' as you might expect. This -- is because @@ -1250,7 +1279,7 @@ -- GUI window is still visible but unable to accept any keyboard/mouse -- input. The reason for the ghosted GUI is that ':main' delegates to the -- FLTK C++ event loop which is unable to listen for user interrupts on --- the Haskell side and so has no of knowing that it should destroy +-- the Haskell side and so has no way of knowing that it should destroy -- itself.'replMain' emulates the event loop on the Haskell side allowing -- it to stop, clean up and return control when it 'catch'es a -- 'UserInterrupt'. Thus the 'replMain' is slower than the optimized C++ diff --git a/src/Graphics/UI/FLTK/LowLevel/FileBrowser.chs b/src/Graphics/UI/FLTK/LowLevel/FileBrowser.chs --- a/src/Graphics/UI/FLTK/LowLevel/FileBrowser.chs +++ b/src/Graphics/UI/FLTK/LowLevel/FileBrowser.chs @@ -59,12 +59,13 @@ {# fun Fl_File_Browser_New_WithLabel as fileBrowserNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} fileBrowserNew :: Rectangle -> Maybe T.Text -> IO (Ref FileBrowser) fileBrowserNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> fileBrowserNew' x_pos y_pos width height >>= - toRef - Just l -> fileBrowserNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_File_Browser_set_iconsize as setIconsize' { id `Ptr ()', id `CUChar' } -> `()' #} instance (impl ~ (CUChar -> IO ())) => Op (SetIconsize ()) FileBrowser orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/FileInput.chs b/src/Graphics/UI/FLTK/LowLevel/FileInput.chs --- a/src/Graphics/UI/FLTK/LowLevel/FileInput.chs +++ b/src/Graphics/UI/FLTK/LowLevel/FileInput.chs @@ -47,12 +47,13 @@ {# fun Fl_File_Input_New_WithLabel as fileInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} fileInputNew :: Rectangle -> Maybe T.Text -> IO (Ref FileInput) fileInputNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> fileInputNew' x_pos y_pos width height >>= - toRef - Just l -> fileInputNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_File_Input_down_box as downBox' { id `Ptr ()' } -> `Boxtype' cToEnum #} instance (impl ~ ( IO (Boxtype))) => Op (GetDownBox ()) FileInput orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/FillDial.chs b/src/Graphics/UI/FLTK/LowLevel/FillDial.chs --- a/src/Graphics/UI/FLTK/LowLevel/FillDial.chs +++ b/src/Graphics/UI/FLTK/LowLevel/FillDial.chs @@ -15,13 +15,17 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import qualified Data.Text as T - +import Graphics.UI.FLTK.LowLevel.Widget {# fun Fl_Fill_Dial_New as fillDialNew' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text' } -> `Ptr ()' id #} fillDialNew :: Rectangle -> T.Text -> IO (Ref FillDial) fillDialNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle - in - fillDialNew' x_pos y_pos width height l' >>= toRef + in do + ref <- fillDialNew' x_pos y_pos width height l' >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref + -- $hierarchy -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/FillSlider.chs b/src/Graphics/UI/FLTK/LowLevel/FillSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/FillSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/FillSlider.chs @@ -17,17 +17,19 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import qualified Data.Text as T - +import Graphics.UI.FLTK.LowLevel.Widget {# fun Fl_Fill_Slider_New as fillSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Fill_Slider_New_WithLabel as fillSliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} fillSliderNew :: Rectangle -> Maybe T.Text -> IO (Ref FillSlider) fillSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle in case l' of - Nothing -> fillSliderNew' x_pos y_pos width height >>= - toRef - Just l -> fillSliderNewWithLabel' x_pos y_pos width height l >>= - toRef + Nothing -> fillSliderNew' x_pos y_pos width height >>= toRef + Just l -> do + ref <- fillSliderNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs b/src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs --- a/src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs @@ -12,10 +12,8 @@ TreeConnector(..), TreeSelect(..), SearchDirection(..), -#if FLTK_ABI_VERSION >= 10302 TreeItemReselectMode(..), TreeItemDrawMode(..), -#endif -- * Keyboard and mouse codes SpecialKey(..), allSpecialKeys, @@ -36,7 +34,8 @@ Modes(..), single, allModes, - -- * Alignment + allTreeItemDrawModes, + -- * Alignmenkt Alignments(..), AlignType(..), alignCenter, @@ -78,6 +77,7 @@ defineOvalBox, definePlasticUpBox, defineGtkUpBox, + defineIconLabel, -- * Fonts Font(..), FontAttribute(..), @@ -113,7 +113,7 @@ -- ** Various Color Functions inactive, contrast, - color_average, + colorAverage, lighter, darker, rgbColorWithRgb, @@ -162,6 +162,9 @@ defineShadowLabel, defineEngravedLabel, defineEmbossedLabel, + defineMultiLabel, + -- defineIconLabel, + defineImageLabel, -- * Color RGB ) @@ -201,7 +204,8 @@ DndLeave = FL_DND_LEAVE, DndRelease = FL_DND_RELEASE, ScreenConfigurationChanged = FL_SCREEN_CONFIGURATION_CHANGED, - Fullscreen = FL_FULLSCREEN + Fullscreen = FL_FULLSCREEN, + ZoomGesture = FL_ZOOM_GESTURE }; enum When { WhenNever = FL_WHEN_NEVER, @@ -246,7 +250,6 @@ SearchDirectionDown = FL_Down, SearchDirectionUp = FL_Up }; -#if FLTK_ABI_VERSION >= 10302 enum TreeItemReselectMode{ TreeSelectableOnce = FL_TREE_SELECTABLE_ONCE, TreeSelectableAlways = FL_TREE_SELECTABLE_ALWAYS @@ -256,7 +259,6 @@ TreeItemDrawLabelAndWidget = FL_TREE_ITEM_DRAW_LABEL_AND_WIDGET, TreeItemHeightFromWidget = FL_TREE_ITEM_HEIGHT_FROM_WIDGET }; -#endif enum SpecialKey { Button = FL_Button, Kb_Clear = FL_Clear, @@ -381,10 +383,8 @@ ModeStereo = FL_STEREO, ModeFakeSingle = FL_FAKE_SINGLE #ifdef GLSUPPORT -#if FLTK_API_VERSION >= 10304 , ModeOpenGL3 = FL_OPENGL3 #endif -#endif }; enum AlignType { AlignTypeCenter = 0, @@ -412,11 +412,9 @@ {#enum TreeConnector {} deriving (Show, Eq) #} {#enum TreeSelect {} deriving (Show, Eq) #} {#enum SearchDirection {} deriving (Show, Eq) #} -#if FLTK_ABI_VERSION >= 10302 {#enum TreeItemReselectMode {} deriving (Show, Eq) #} -{#enum TreeItemDrawMode {} deriving (Show, Eq) #} -#endif -{#enum SpecialKey {} deriving (Show, Eq) #} +{#enum TreeItemDrawMode {} deriving (Show, Eq, Ord) #} +{#enum SpecialKey {} deriving (Show, Eq, Ord) #} allShortcutSpecialKeys :: [CInt] allShortcutSpecialKeys = [ @@ -557,15 +555,13 @@ ModeMultisample, ModeStereo, ModeFakeSingle -#if FLTK_API_VERSION >= 10304 #ifdef GLSUPPORT , ModeOpenGL3 #endif -#endif ] {#enum AlignType {} deriving (Show, Eq, Ord) #} -newtype Alignments = Alignments [AlignType] deriving Show +newtype Alignments = Alignments [AlignType] deriving (Eq, Show, Ord) alignCenter :: Alignments alignCenter = Alignments [AlignTypeCenter] alignTop :: Alignments @@ -658,6 +654,14 @@ Mouse_Button2State, Mouse_Button3State ] + +allTreeItemDrawModes :: [TreeItemDrawMode] +allTreeItemDrawModes = [ + TreeItemDrawDefault, + TreeItemDrawLabelAndWidget, + TreeItemHeightFromWidget + ] + data Boxtype = NoBox | FlatBox | UpBox @@ -715,7 +719,7 @@ | GleamRoundUpBox | GleamRoundDownBox | FreeBoxtype - deriving (Show) + deriving (Show, Eq, Ord) instance Enum Boxtype where fromEnum NoBox = 0 fromEnum FlatBox = 1 @@ -841,8 +845,8 @@ -- Fonts -newtype Font = Font Int deriving Show -data FontAttribute = Bold | Italic | BoldItalic deriving (Show, Enum) +newtype Font = Font Int deriving (Eq, Show, Ord) +data FontAttribute = Bold | Italic | BoldItalic deriving (Show, Eq, Ord, Enum) cFromFont :: Font -> CInt cFromFont (Font f) = fromIntegral f cToFont :: CInt -> Font @@ -900,7 +904,7 @@ -- Colors -newtype Color = Color CUInt deriving Show +newtype Color = Color CUInt deriving (Eq,Show,Ord) foregroundColor :: Color foregroundColor = Color 0 background2Color :: Color @@ -974,30 +978,40 @@ -- Fl_LabelType -data Labeltype = NormalLabel - | NoLabel - | ShadowLabel - | EngravedLabel - | EmbossedLabel - | FreeLabelType deriving Show +data Labeltype = NormalLabelType + | NoLabelType + | ShadowLabelType + | EngravedLabelType + | EmbossedLabelType + | IconLabelType + | MultiLabelType + | ImageLabelType + | FreeLabelType deriving (Eq, Show, Ord) instance Enum Labeltype where - fromEnum NormalLabel = 0 - fromEnum NoLabel = 1 - fromEnum ShadowLabel = defineShadowLabel_ - fromEnum EngravedLabel = defineEngravedLabel_ - fromEnum EmbossedLabel = defineEmbossedLabel_ + fromEnum NormalLabelType = 0 + fromEnum NoLabelType = 1 + fromEnum ShadowLabelType = defineShadowLabel_ + fromEnum EngravedLabelType = defineEngravedLabel_ + fromEnum EmbossedLabelType = defineEmbossedLabel_ + fromEnum MultiLabelType = defineMultiLabel_ + fromEnum ImageLabelType = defineImageLabel_ + fromEnum IconLabelType = defineIconLabel_ fromEnum FreeLabelType = 8 - toEnum 0 = NormalLabel - toEnum 1 = NoLabel - toEnum x | x == defineShadowLabel_ = ShadowLabel - | x == defineEngravedLabel_ = EngravedLabel - | x == defineEmbossedLabel_ = EmbossedLabel + toEnum 0 = NormalLabelType + toEnum 1 = NoLabelType + toEnum x | x == defineShadowLabel_ = ShadowLabelType + | x == defineEngravedLabel_ = EngravedLabelType + | x == defineEmbossedLabel_ = EmbossedLabelType + | x == defineMultiLabel_ = MultiLabelType + | x == defineIconLabel_ = IconLabelType + | x == defineImageLabel_ = ImageLabelType toEnum 8 = FreeLabelType + toEnum otherwise = error ("LabelType.toEnum: Cannot match " ++ show otherwise) symbolLabel :: Labeltype -symbolLabel = NormalLabel +symbolLabel = NormalLabelType defineRoundUpBox_ :: (Num a) => a defineRoundUpBox_ = @@ -1081,6 +1095,27 @@ defineEmbossedLabel :: Labeltype defineEmbossedLabel = toEnum defineEmbossedLabel_ +defineIconLabel_ :: (Num a) => a +defineIconLabel_ = + fromIntegral $ {#call pure unsafe fl_define_FL_ICON_LABELC #} + +defineIconLabel :: Labeltype +defineIconLabel = toEnum defineIconLabel_ + +defineMultiLabel_ :: (Num a) => a +defineMultiLabel_ = + fromIntegral $ {#call pure unsafe fl_define_FL_MULTI_LABELC #} + +defineMultiLabel :: Labeltype +defineMultiLabel = toEnum defineMultiLabel_ + +defineImageLabel_ :: (Num a) => a +defineImageLabel_ = + fromIntegral $ {#call pure unsafe fl_define_FL_IMAGE_LABELC #} + +defineImageLabel :: Labeltype +defineImageLabel = toEnum defineImageLabel_ + cFromColor :: Color -> CUInt cFromColor (Color c) = fromIntegral c cToColor :: CUInt-> Color @@ -1094,7 +1129,7 @@ contrast {cFromColor `Color',cFromColor `Color'} -> `Color' cToColor#} {#fun pure fl_color_averageC as - color_average {cFromColor `Color', + colorAverage {cFromColor `Color', cFromColor `Color', realToFrac `Double'} -> `Color' cToColor#} diff --git a/src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs b/src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs --- a/src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs @@ -7,6 +7,7 @@ module Graphics.UI.FLTK.LowLevel.Fl_Types where #include "Fl_Types.h" #include "Fl_Text_EditorC.h" +#include "FL/platform_types.h" import Foreign import Foreign.C hiding (CClock) import Graphics.UI.FLTK.LowLevel.Fl_Enumerations @@ -79,9 +80,7 @@ TreeReasonNone = FL_TREE_REASON_NONE, TreeReasonSelected = FL_TREE_REASON_SELECTED, TreeReasonDeselected = FL_TREE_REASON_DESELECTED, -#if FLTK_ABI_VERSION >= 10302 TreeReasonReselected = FL_TREE_REASON_RESELECTED, -#endif /*FLTK_ABI_VERSION*/ TreeReasonOpened = FL_TREE_REASON_OPENED, TreeReasonClosed = FL_TREE_REASON_CLOSED, TreeReasonDragged = FL_TREE_REASON_DRAGGED @@ -200,8 +199,6 @@ PackVertical = PACK_VERTICAL, PackHorizontal = PACK_HORIZONTAL }; - typedef FL_SOCKET Fl_Socket; - enum ColorChooserMode { RgbMode = 0, ByteMode = 1, @@ -209,19 +206,19 @@ HsvMode = 3 }; #endc -{#enum SliderType {} deriving (Show, Eq) #} -{#enum ScrollbarType {} deriving (Show, Eq) #} -{#enum BrowserType {} deriving (Show, Eq) #} -{#enum SortType {} deriving (Show, Eq) #} -{#enum FileBrowserType {} deriving (Show, Eq) #} -{#enum FileIconType {} deriving (Show, Eq) #} -{#enum FileIconProps {} deriving (Show, Eq) #} -{#enum FileChooserType {} deriving (Show, Eq) #} -{#enum ButtonType {} deriving (Show, Eq) #} -{#enum TreeReasonType {} deriving (Show, Eq) #} +{#enum SliderType {} deriving (Show, Eq, Ord) #} +{#enum ScrollbarType {} deriving (Show, Eq, Ord) #} +{#enum BrowserType {} deriving (Show, Eq, Ord) #} +{#enum SortType {} deriving (Show, Eq, Ord) #} +{#enum FileBrowserType {} deriving (Show, Eq, Ord) #} +{#enum FileIconType {} deriving (Show, Eq, Ord) #} +{#enum FileIconProps {} deriving (Show, Eq, Ord) #} +{#enum FileChooserType {} deriving (Show, Eq, Ord) #} +{#enum ButtonType {} deriving (Show, Eq, Ord) #} +{#enum TreeReasonType {} deriving (Show, Eq, Ord) #} {#enum MenuItemFlag {} deriving (Show, Eq, Ord) #} {#enum ColorChooserMode {} deriving (Show, Eq, Ord) #} -newtype MenuItemFlags = MenuItemFlags [MenuItemFlag] deriving Show +newtype MenuItemFlags = MenuItemFlags [MenuItemFlag] deriving (Eq, Show, Ord) allMenuItemFlags :: [MenuItemFlag] allMenuItemFlags = [ @@ -235,19 +232,18 @@ MenuItemDivider, MenuItemHorizontal ] -{#enum CursorType {} deriving (Show, Eq) #} -{#enum PositionType {} deriving (Show, Eq) #} -{#enum DragType {} deriving (Show, Eq) #} -{#enum WrapTypeFl {} deriving (Show, Eq) #} -data WrapType = WrapNone | WrapAtColumn ColumnNumber | WrapAtPixel PixelPosition | WrapAtBounds deriving (Eq, Show) -{#enum PageFormat {} deriving (Show, Eq) #} -{#enum PageLayout {} deriving (Show, Eq) #} -{#enum TableRowSelectMode {} deriving (Show, Eq) #} -{#enum TableContext {} deriving (Show, Eq) #} -{#enum LinePosition {} deriving (Show, Eq) #} -{#enum ScrollbarMode {} deriving (Show, Eq) #} -data StyleTableEntry = StyleTableEntry (Maybe Color) (Maybe Font) (Maybe FontSize) deriving Show - +{#enum CursorType {} deriving (Show, Eq, Ord) #} +{#enum PositionType {} deriving (Show, Eq, Ord) #} +{#enum DragType {} deriving (Show, Eq, Ord) #} +{#enum WrapTypeFl {} deriving (Show, Eq, Ord) #} +data WrapType = WrapNone | WrapAtColumn ColumnNumber | WrapAtPixel PixelPosition | WrapAtBounds deriving (Eq, Show, Ord) +{#enum PageFormat {} deriving (Show, Eq, Ord) #} +{#enum PageLayout {} deriving (Show, Eq, Ord) #} +{#enum TableRowSelectMode {} deriving (Show, Eq, Ord) #} +{#enum TableContext {} deriving (Show, Eq, Ord) #} +{#enum LinePosition {} deriving (Show, Eq, Ord) #} +{#enum ScrollbarMode {} deriving (Show, Eq, Ord) #} +data StyleTableEntry = StyleTableEntry (Maybe Color) (Maybe Font) (Maybe FontSize) deriving (Eq, Show, Ord) {#enum PackType{} deriving (Show, Eq, Ord) #} type FlShortcut = {#type Fl_Shortcut #} type FlColor = {#type Fl_Color #} @@ -258,8 +254,18 @@ type FlIntPtr = {#type fl_intptr_t #} type FlUIntPtr = {#type fl_uintptr_t#} type ID = {#type ID#} +type Fl_Offscreen = {#type Fl_Offscreen #} +type Fl_Socket = {#type FL_SOCKET #} +type Fl_Bitmask = {#type Fl_Bitmask #} +type Fl_Region = {#type Fl_Region #} newtype WindowHandle = WindowHandle (Ptr ()) -data Ref a = Ref !(ForeignPtr (Ptr ())) deriving (Eq, Show) + +newtype NumInserted = NumInserted Int deriving (Show, Eq, Ord) +newtype NumDeleted = NumDeleted Int deriving (Show, Eq, Ord) +newtype NumRestyled = NumRestyled Int deriving (Show, Eq, Ord) +newtype DeletedText = DeletedText T.Text deriving (Show, Eq, Ord) + +data Ref a = Ref !(ForeignPtr (Ptr ())) deriving (Eq, Show, Ord) data FunRef = FunRef !(FunPtr ()) -- * The FLTK widget hierarchy data CBase parent @@ -268,9 +274,9 @@ type GlobalCallback = IO () type CallbackWithUserDataPrim = Ptr () -> Ptr () -> IO () type CallbackPrim = Ptr () -> IO () -type ColorAverageCallbackPrim = Ptr () -> CUInt -> CFloat -> IO () -type ImageDrawCallbackPrim = Ptr () -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () -type ImageCopyCallbackPrim = Ptr () -> CInt -> CInt -> IO (Ptr ()) +type CustomColorAveragePrim = Ptr () -> CUInt -> CFloat -> IO () +type CustomImageDrawPrim = Ptr () -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () +type CustomImageCopyPrim = Ptr () -> CInt -> CInt -> IO (Ptr ()) type GlobalEventHandlerPrim = CInt -> IO CInt type GlobalEventHandlerF = Event -> IO Int type DrawCallback = T.Text -> Position -> IO () @@ -280,37 +286,46 @@ type SharedImageHandler = FunPtr (CString -> CUChar -> CInt -> Ptr ()) type BoxDrawF = Rectangle -> Color -> IO () type BoxDrawFPrim = CInt -> CInt -> CInt -> CInt -> FlColor -> IO () -#ifdef WIN64 -type FDHandlerPrim = CULLong -> Ptr () -> IO () -type FDHandler = CULLong -> IO () -#else -type FDHandlerPrim = CInt -> Ptr () -> IO () -type FDHandler = CInt -> IO () -#endif -type TextModifyCb = Int -> Int -> Int -> Int -> T.Text -> IO () +type FDHandlerPrim = Fl_Socket -> Ptr () -> IO () +type FDHandler = FlSocket -> IO () +type TextModifyCb = AtIndex -> NumInserted -> NumDeleted -> NumRestyled -> DeletedText -> IO () type TextModifyCbPrim = CInt -> CInt -> CInt -> CInt -> Ptr CChar -> Ptr () -> IO () -type TextPredeleteCb = BufferOffset -> Int -> IO () +type TextPredeleteCb = AtIndex -> NumDeleted -> IO () type TextPredeleteCbPrim = CInt -> CInt -> Ptr () -> IO () -type UnfinishedStyleCb = BufferOffset -> IO () +type UnfinishedStyleCb = AtIndex -> IO () type UnfinishedStyleCbPrim = CInt -> Ptr () -> IO () +type MenuItemDrawF = Ptr () -> CInt -> CInt -> CInt -> CInt -> Ptr () -> CInt -> IO () +type TabPositionsPrim = Ptr () -> Ptr CInt -> Ptr CInt -> IO CInt +type TabHeightPrim = Ptr () -> IO CInt +type TabWhichPrim = Ptr () -> CInt -> CInt -> IO (Ptr ()) +type TabClientAreaPrim = Ptr () -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CInt -> CInt -> IO () +type GetDoublePrim = Ptr () -> IO (CDouble) +type GetIntPrim = Ptr () -> IO CInt +type SetIntPrim = Ptr () -> CInt -> IO () +type ColorSetPrim = Ptr () -> CDouble -> CDouble -> CDouble -> IO CInt -newtype Width = Width Int deriving (Eq, Show) -newtype Height = Height Int deriving (Eq, Show) -newtype Depth = Depth Int deriving Show -newtype LineSize = LineSize Int deriving Show -newtype X = X Int deriving (Eq, Show) -newtype Y = Y Int deriving (Eq, Show) -newtype ByX = ByX Double deriving Show -newtype ByY = ByY Double deriving Show -newtype Angle = Angle CShort deriving Show -data Position = Position X Y deriving (Eq,Show) -data CountDirection = CountUp | CountDown deriving Show -data DPI = DPI Float Float deriving Show -newtype TextDisplayStyle = TextDisplayStyle CInt deriving Show -newtype BufferOffset = BufferOffset Int deriving Show -data BufferRange = BufferRange BufferOffset BufferOffset deriving Show -statusToBufferRange :: (Ptr CInt -> Ptr CInt -> IO Int) -> IO (Maybe BufferRange) -statusToBufferRange f = +newtype Width = Width Int deriving (Eq, Show, Ord) +newtype Height = Height Int deriving (Eq, Show, Ord) +newtype PreciseWidth = PreciseWidth Double deriving (Eq, Show, Ord) +newtype PreciseHeight = PreciseHeight Double deriving (Eq, Show, Ord) +newtype Depth = Depth Int deriving (Eq, Show, Ord) +newtype LineSize = LineSize Int deriving (Eq, Show, Ord) +newtype X = X Int deriving (Eq, Show, Ord) +newtype PreciseX = PreciseX Double deriving (Eq, Show, Ord) +newtype Y = Y Int deriving (Eq, Show, Ord) +newtype PreciseY = PreciseY Double deriving (Eq, Show, Ord) +newtype ByX = ByX Double deriving (Eq, Show, Ord) +newtype ByY = ByY Double deriving (Eq, Show, Ord) +newtype Angle = Angle CShort deriving (Eq, Show, Ord) +newtype PreciseAngle = PreciseAngle Double deriving (Eq, Show, Ord) +data Position = Position X Y deriving (Eq, Show, Ord) +data PrecisePosition = PrecisePosition PreciseX PreciseY deriving (Eq, Show, Ord) +data CountDirection = CountUp | CountDown deriving (Eq, Show, Ord) +data DPI = DPI Float Float deriving (Eq, Show, Ord) +newtype TextDisplayStyle = TextDisplayStyle CInt deriving (Eq, Show, Ord) +data IndexRange = IndexRange AtIndex AtIndex deriving (Eq, Show, Ord) +statusToIndexRange :: (Ptr CInt -> Ptr CInt -> IO Int) -> IO (Maybe IndexRange) +statusToIndexRange f = alloca $ \start' -> alloca $ \end' -> f start' end' >>= \status' -> @@ -319,46 +334,61 @@ _ -> do start'' <- peekIntConv start' end'' <- peekIntConv end' - return (Just (BufferRange (BufferOffset start'') (BufferOffset end''))) + return (Just (IndexRange (AtIndex start'') (AtIndex end''))) -data ColorChooserRGB = Decimals (Between0And1, Between0And1, Between0And1) | Words RGB deriving Show -data Rectangle = Rectangle Position Size deriving (Eq,Show) -data ByXY = ByXY ByX ByY deriving Show -data Intersection = Contained | Partial deriving Show -data Size = Size Width Height deriving (Eq, Show) +data ColorChooserRGB = Decimals (Between0And1, Between0And1, Between0And1) | Words RGB deriving (Eq, Show, Ord) +data Rectangle = Rectangle { rectanglePosition :: Position , rectangleSize :: Size } deriving (Eq, Show, Ord) +data ByXY = ByXY ByX ByY deriving (Eq, Show, Ord) +data Intersection = Contained | Partial deriving (Eq, Show, Ord) +data Size = Size Width Height deriving (Eq, Show, Ord) +data PreciseSize = PreciseSize PreciseWidth PreciseHeight deriving (Eq, Show, Ord) +newtype Lines = Lines Int deriving (Eq,Show,Ord) newtype LineNumber = LineNumber Int deriving (Eq,Show,Ord) newtype ColumnNumber = ColumnNumber Int deriving (Eq, Show, Ord) newtype PixelPosition = PixelPosition Int deriving (Eq,Show,Ord) -data KeyType = SpecialKeyType SpecialKey | NormalKeyType Char deriving (Show, Eq) -data ShortcutKeySequence = ShortcutKeySequence [EventState] KeyType deriving Show -data Shortcut = KeySequence ShortcutKeySequence | KeyFormat T.Text deriving Show -data KeyBindingKeySequence = KeyBindingKeySequence (Maybe [EventState]) KeyType deriving Show -newtype Between0And1 = Between0And1 Double deriving Show -newtype Between0And6 = Between0And6 Double deriving Show +newtype AtIndex = AtIndex Int deriving (Eq,Show,Ord) +newtype Rows = Rows Int deriving (Eq,Show,Ord) +newtype Columns = Columns Int deriving (Eq,Show,Ord) +data KeyType = SpecialKeyType SpecialKey | NormalKeyType Char deriving (Eq, Show, Ord) +data ShortcutKeySequence = ShortcutKeySequence [EventState] KeyType deriving (Eq, Show, Ord) +data Shortcut = KeySequence ShortcutKeySequence | KeyFormat T.Text deriving (Eq, Show, Ord) +data KeyBindingKeySequence = KeyBindingKeySequence (Maybe [EventState]) KeyType deriving (Eq, Show, Ord) +newtype Between0And1 = Between0And1 Double deriving (Eq, Show, Ord) +newtype Between0And6 = Between0And6 Double deriving (Eq, Show, Ord) data ScreenLocation = Intersect Rectangle | ScreenNumber Int - | ScreenPosition Position deriving Show -newtype FontSize = FontSize CInt deriving Show -newtype PixmapHs = PixmapHs [T.Text] deriving Show -data BitmapHs = BitmapHs B.ByteString Size deriving Show -data Clipboard = InternalClipboard | SharedClipboard deriving Show -data OutOfRangeOrNotSubmenu = OutOfRangeOrNotSubmenu deriving Show + | ScreenPosition Position deriving (Eq, Show, Ord) +newtype FontSize = FontSize CInt deriving (Eq, Show, Ord) +newtype PixmapHs = PixmapHs [T.Text] deriving (Eq, Show, Ord) +data BitmapHs = BitmapHs B.ByteString Size deriving (Eq, Show, Ord) +data Clipboard = InternalClipboard | SharedClipboard deriving (Eq, Show, Ord) +data OutOfRangeOrNotSubmenu = OutOfRangeOrNotSubmenu deriving (Eq, Show, Ord) +-- | The type of 'Fl_Offscreen' varies wildly from platform to platform. Feel free to examine the insides when debugging +-- but any computation based on it will probably not be portable. +newtype FlOffscreen = FlOffscreen Fl_Offscreen +newtype FlBitmask = FlBitmask Fl_Bitmask +newtype FlRegion = FlRegion Fl_Region +newtype FlSocket = FlSocket Fl_Socket +#if GLSUPPORT +type Fl_GlContext = {#type GLContext #} +newtype FlGlContext = FlGlContext Fl_GlContext +#endif successOrOutOfRangeOrNotSubmenu :: Int -> Either OutOfRangeOrNotSubmenu () successOrOutOfRangeOrNotSubmenu status = if (status == (-1)) then Left OutOfRangeOrNotSubmenu else Right () -data AwakeRingFull = AwakeRingFull deriving Show +data AwakeRingFull = AwakeRingFull deriving (Eq, Show, Ord) successOrAwakeRingFull :: Int -> Either AwakeRingFull () successOrAwakeRingFull status = if (status == (-1)) then Left AwakeRingFull else Right () -data UnknownEvent = UnknownEvent deriving Show +data UnknownEvent = UnknownEvent deriving (Eq, Show, Ord) successOrUnknownEvent :: Int -> Either UnknownEvent () successOrUnknownEvent status = if (status == 0) then Left UnknownEvent else Right () -data UnknownError = UnknownError deriving Show -successOrUnknownError :: a -> Bool -> (a -> IO b) -> IO (Either UnknownError b) -successOrUnknownError a pred' tr = if pred' then return (Left UnknownError) else tr a >>= return . Right -data NotFound = NotFound deriving Show -data OutOfRange = OutOfRange deriving Show +data UnknownError = UnknownError deriving (Eq, Show, Ord) +successOrUnknownError :: a -> Int -> Either UnknownError a +successOrUnknownError a result = if (result == 0) then (Left UnknownError) else (Right a) +data NotFound = NotFound deriving (Eq, Show, Ord) +data OutOfRange = OutOfRange deriving (Eq, Show, Ord) successOrOutOfRange :: a -> Bool -> (a -> IO b) -> IO (Either OutOfRange b) successOrOutOfRange a pred' tr = if pred' then return (Left OutOfRange) else tr a >>= return . Right -data NoChange = NoChange deriving Show +data NoChange = NoChange deriving (Eq, Show, Ord) successOrNoChange :: Int -> Either NoChange () successOrNoChange status = if (status == 0) then Left NoChange else Right () data DataProcessingError = NoDataProcessedError | PartialDataProcessedError | UnknownDataError Int @@ -368,6 +398,11 @@ 1 -> Left NoDataProcessedError 2 -> Left PartialDataProcessedError x -> Left $ UnknownDataError x +newtype PreferredSize = PreferredSize Int deriving (Eq, Show, Ord) +newtype GapSize = GapSize Int deriving (Eq, Show, Ord) +data DrawShortcut = NormalDrawShortcut | ElideAmpersandDrawShortcut deriving (Eq,Show,Ord) +data ResolveImageLabelConflict = ResolveImageLabelOverwrite | ResolveImageLabelDoNothing deriving (Show) +data MultiLabelShrinkError = MultiLabelShrinkError deriving Show toRectangle :: (Int,Int,Int,Int) -> Rectangle toRectangle (x_pos, y_pos, width, height) = Rectangle (Position @@ -391,6 +426,18 @@ toPosition :: (Int,Int) -> Position toPosition (xPos', yPos') = Position (X xPos') (Y yPos') + +toPrecisePosition :: Position -> PrecisePosition +toPrecisePosition (Position (X xPos') (Y yPos')) = + PrecisePosition + (PreciseX (fromIntegral xPos')) + (PreciseY (fromIntegral yPos')) + +toPreciseSize :: Size -> PreciseSize +toPreciseSize (Size (Width w) (Height h)) = + PreciseSize + (PreciseWidth (fromIntegral w)) + (PreciseHeight (fromIntegral h)) throwStackOnError :: IO a -> IO a throwStackOnError f = diff --git a/src/Graphics/UI/FLTK/LowLevel/GlWindow.chs b/src/Graphics/UI/FLTK/LowLevel/GlWindow.chs --- a/src/Graphics/UI/FLTK/LowLevel/GlWindow.chs +++ b/src/Graphics/UI/FLTK/LowLevel/GlWindow.chs @@ -131,14 +131,14 @@ {# fun Fl_Gl_Window_set_mode as setMode' { id `Ptr ()',`Int' } -> `Int' #} instance (impl ~ (Modes -> IO ())) => Op (SetMode ()) GlWindow orig impl where runOp _ _ win a = withRef win $ \winPtr -> setMode' winPtr (modesToInt a) >> return () -{# fun Fl_Gl_Window_context as context' { id `Ptr ()' } -> `Ref GlContext' unsafeToRef #} -instance (impl ~ ( IO (Ref GlContext))) => Op (GetContext ()) GlWindow orig impl where +{# fun Fl_Gl_Window_context as context' { id `Ptr ()' } -> `Ref FlGlContext' unsafeToRef #} +instance (impl ~ ( IO (Ref FlGlContext))) => Op (GetContext ()) GlWindow orig impl where runOp _ _ win = withRef win $ \winPtr -> context' winPtr {# fun Fl_Gl_Window_set_context as setContext' { id `Ptr ()',id `Ptr ()' } -> `()' supressWarningAboutRes #} -instance (impl ~ ( Ref GlContext -> IO ())) => Op (SetContext ()) GlWindow orig impl where +instance (impl ~ ( Ref FlGlContext -> IO ())) => Op (SetContext ()) GlWindow orig impl where runOp _ _ win context = withRef win $ \winPtr -> withRef context $ \contextPtr -> setContext' winPtr contextPtr {# fun Fl_Gl_Window_set_context_with_destroy_flag as setContextWithDestroyFlag' { id `Ptr ()',id `Ptr ()', fromBool `Bool'} -> `()' supressWarningAboutRes #} -instance (impl ~ ( Ref GlContext -> Bool -> IO ())) => Op (SetContextWithDestroyFlag ()) GlWindow orig impl where +instance (impl ~ ( Ref FlGlContext -> Bool -> IO ())) => Op (SetContextWithDestroyFlag ()) GlWindow orig impl where runOp _ _ win context destroyFlag= withRef win $ \winPtr -> withRef context $ \contextPtr -> setContextWithDestroyFlag' winPtr contextPtr destroyFlag {# fun Fl_Gl_Window_swap_buffers as swapBuffers' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (SwapBuffers ()) GlWindow orig impl where @@ -159,7 +159,6 @@ instance (impl ~ ( IO ())) => Op (MakeOverlayCurrent ()) GlWindow orig impl where runOp _ _ win = withRef win $ \winPtr -> makeOverlayCurrent' winPtr {# fun Fl_Gl_Window_pixels_per_unit as pixelsPerUnit' { id `Ptr ()'} -> `Float' #} -#if FLTK_API_VERSION >= 10304 instance (impl ~ ( IO (Float))) => Op (PixelsPerUnit ()) GlWindow orig impl where runOp _ _ win = withRef win $ \winPtr -> pixelsPerUnit' winPtr {# fun Fl_Gl_Window_pixel_h as pixelH' { id `Ptr ()'} -> `Int' #} @@ -168,7 +167,7 @@ {# fun Fl_Gl_Window_pixel_w as pixelW' { id `Ptr ()'} -> `Int' #} instance (impl ~ ( IO (Int))) => Op (PixelW ()) GlWindow orig impl where runOp _ _ win = withRef win $ \winPtr -> pixelW' winPtr -#endif + -- $GlWindowfunctions -- @ -- canDo :: 'Ref' 'GlWindow' -> 'IO' ('Bool') @@ -183,7 +182,7 @@ -- -- flushSuper :: 'Ref' 'GlWindow' -> 'IO' () -- --- getContext :: 'Ref' 'GlWindow' -> 'IO' ('Ref' 'GlContext') +-- getContext :: 'Ref' 'GlWindow' -> 'IO' ('Ref' 'FlGlContext') -- -- getContextValid :: 'Ref' 'GlWindow' -> 'IO' ('Bool') -- @@ -207,17 +206,23 @@ -- -- ortho :: 'Ref' 'GlWindow' -> 'IO' () -- +-- pixelH :: 'Ref' 'GlWindow' -> 'IO' ('Int') +-- +-- pixelW :: 'Ref' 'GlWindow' -> 'IO' ('Int') +-- +-- pixelsPerUnit :: 'Ref' 'GlWindow' -> 'IO' ('Float') +-- -- redrawOverlay :: 'Ref' 'GlWindow' -> 'IO' () -- -- resize :: 'Ref' 'GlWindow' -> 'Rectangle' -> 'IO' () -- -- resizeSuper :: 'Ref' 'GlWindow' -> 'Rectangle' -> 'IO' () -- --- setContext :: 'Ref' 'GlWindow' -> 'Ref' 'GlContext' -> 'IO' () +-- setContext :: 'Ref' 'GlWindow' -> 'Ref' 'FlGlContext' -> 'IO' () -- -- setContextValid :: 'Ref' 'GlWindow' -> 'Bool' -> 'IO' () -- --- setContextWithDestroyFlag :: 'Ref' 'GlWindow' -> 'Ref' 'GlContext' -> 'Bool' -> 'IO' () +-- setContextWithDestroyFlag :: 'Ref' 'GlWindow' -> 'Ref' 'FlGlContext' -> 'Bool' -> 'IO' () -- -- setMode :: 'Ref' 'GlWindow' -> 'Modes' -> 'IO' () -- @@ -228,14 +233,6 @@ -- showWidgetSuper :: 'Ref' 'GlWindow' -> 'IO' () -- -- swapBuffers :: 'Ref' 'GlWindow' -> 'IO' () --- --- Available in FLTK 1.3.4 only: --- --- pixelH :: 'Ref' 'GlWindow' -> 'IO' ('Int') --- --- pixelW :: 'Ref' 'GlWindow' -> 'IO' ('Int') --- --- pixelsPerUnit :: 'Ref' 'GlWindow' -> 'IO' ('Float') -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/Group.chs b/src/Graphics/UI/FLTK/LowLevel/Group.chs --- a/src/Graphics/UI/FLTK/LowLevel/Group.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Group.chs @@ -24,6 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch import qualified Data.Text as T import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Widget @@ -42,10 +43,13 @@ {# fun Fl_Group_New_WithLabel as groupNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} groupNew :: Rectangle -> Maybe T.Text -> IO (Ref Group) groupNew rectangle label' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case label' of - (Just l') -> groupNewWithLabel' x_pos y_pos width height l' >>= toRef - Nothing -> groupNew' x_pos y_pos width height >>= toRef + widgetMaker + rectangle + label' + Nothing + Nothing + overriddenGroupNew' + overriddenGroupNewWithLabel' {# fun Fl_OverriddenGroup_New_WithLabel as overriddenGroupNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenGroup_New as overriddenGroupNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} @@ -96,20 +100,20 @@ finally action ((end (castTo group :: Ref orig)) :: IO ()) {# fun Fl_Group_find as find' { id `Ptr ()',id `Ptr ()' } -> `Int' #} -instance (Parent a Widget, impl ~ (Ref a -> IO (Int))) => Op (Find ()) Group orig impl where - runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> find' groupPtr wPtr +instance (Parent a Widget, impl ~ (Ref a -> IO (AtIndex))) => Op (Find ()) Group orig impl where + runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> find' groupPtr wPtr >>= return . AtIndex {# fun Fl_Group_add as add' { id `Ptr ()',id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (Parent a Widget, impl ~ (Ref a-> IO ())) => Op (Add ()) Group orig impl where runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> add' groupPtr wPtr {# fun Fl_Group_insert as insert' { id `Ptr ()',id `Ptr ()',`Int' } -> `()' supressWarningAboutRes #} -instance (Parent a Widget, impl ~ (Ref a-> Int -> IO ())) => Op (Insert ()) Group orig impl where - runOp _ _ group w i = withRef group $ \groupPtr -> withRef w $ \wPtr -> insert' groupPtr wPtr i +instance (Parent a Widget, impl ~ (Ref a-> AtIndex -> IO ())) => Op (Insert ()) Group orig impl where + runOp _ _ group w (AtIndex i) = withRef group $ \groupPtr -> withRef w $ \wPtr -> insert' groupPtr wPtr i {# fun Fl_Group_remove_index as removeIndex' { id `Ptr ()',`Int' } -> `()' supressWarningAboutRes #} -instance (impl ~ ( Int -> IO ())) => Op (RemoveIndex ()) Group orig impl where - runOp _ _ group index' = withRef group $ \groupPtr -> removeIndex' groupPtr index' +instance (impl ~ ( AtIndex -> IO ())) => Op (RemoveIndex ()) Group orig impl where + runOp _ _ group (AtIndex index') = withRef group $ \groupPtr -> removeIndex' groupPtr index' {# fun Fl_Group_remove_widget as removeWidget' { id `Ptr ()',id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (Parent a Widget, impl ~ (Ref a -> IO ())) => Op (RemoveWidget ()) Group orig impl where @@ -159,7 +163,7 @@ runOp _ _ group = withRef group $ \groupPtr -> ddfdesignKludge' groupPtr >>= toMaybeRef {# fun Fl_Group_insert_with_before as insertWithBefore' { id `Ptr ()',id `Ptr ()',id `Ptr ()' } -> `()' supressWarningAboutRes #} -instance (Parent a Widget, impl ~ (Ref a -> Ref b -> IO ())) => Op (InsertWithBefore ()) Group orig impl where +instance (Parent a Widget, impl ~ (Ref a -> Ref b -> IO ())) => Op (InsertBefore ()) Group orig impl where runOp _ _ self w before = withRef self $ \selfPtr -> withRef w $ \wPtr -> withRef before $ \beforePtr -> insertWithBefore' selfPtr wPtr beforePtr {# fun Fl_Group_array as array' { id `Ptr ()' } -> `Ptr (Ptr ())' id#} @@ -170,9 +174,17 @@ arrayToRefs childArrayPtr numChildren {# fun Fl_Group_child as child' { id `Ptr ()',`Int' } -> `Ptr ()' id #} -instance (impl ~ (Int -> IO (Maybe (Ref Widget)))) => Op (GetChild ()) Group orig impl where - runOp _ _ self n = withRef self $ \selfPtr -> child' selfPtr n >>= toMaybeRef +instance (impl ~ (AtIndex -> IO (Maybe (Ref Widget)))) => Op (GetChild ()) Group orig impl where + runOp _ _ self (AtIndex n) = withRef self $ \selfPtr -> child' selfPtr n >>= toMaybeRef +{#fun Fl_Group_handle as groupHandle' { id `Ptr ()', id `CInt' } -> `Int' #} +instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (Handle ()) Group orig impl where + runOp _ _ group event = withRef group (\p -> groupHandle' p (fromIntegral . fromEnum $ event)) >>= return . successOrUnknownEvent + +{# fun Fl_Group_handle_super as handleSuper' { id `Ptr ()',`Int' } -> `Int' #} +instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (HandleSuper ()) Group orig impl where + runOp _ _ group event = withRef group $ \groupPtr -> handleSuper' groupPtr (fromIntegral (fromEnum event)) >>= return . successOrUnknownEvent + -- $groupfunctions -- @ -- add:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a-> 'IO' () @@ -199,23 +211,27 @@ -- -- end :: 'Ref' 'Group' -> 'IO' () -- --- find:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'IO' ('Int') +-- find:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'IO' ('AtIndex') -- -- focus:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'IO' () -- -- getArray :: 'Ref' 'Group' -> 'IO' ['Ref' 'Widget'] -- --- getChild :: 'Ref' 'Group' -> 'Int' -> 'IO' ('Maybe' ('Ref' 'Widget')) +-- getChild :: 'Ref' 'Group' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- -- getResizable :: 'Ref' 'Group' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- +-- handle :: 'Ref' 'Group' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- handleSuper :: 'Ref' 'Group' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- -- initSizes :: 'Ref' 'Group' -> 'IO' () -- --- insert:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a-> 'Int' -> 'IO' () +-- insert:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a-> 'AtIndex' -> 'IO' () -- --- insertWithBefore:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'Ref' b -> 'IO' () +-- insertBefore:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'Ref' b -> 'IO' () -- --- removeIndex :: 'Ref' 'Group' -> 'Int' -> 'IO' () +-- removeIndex :: 'Ref' 'Group' -> 'AtIndex' -> 'IO' () -- -- removeWidget:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'IO' () -- @@ -227,7 +243,7 @@ -- -- updateChild:: ('Parent' a 'Widget') => 'Ref' 'Group' -> 'Ref' a -> 'IO' () -- --- within:: 'Ref' 'Group' -> 'IO' a -> 'IO' a +-- within:: ('Match' obj ~ 'FindOp' orig orig ('Begin' ()), 'Match' obj ~ 'FindOp' orig orig ('End' ()), 'Op' ('Begin' ()) obj orig ('IO' ()), 'Op' ('End' ()) obj orig ('IO' ()),) => 'Ref' 'Group' -> 'IO' a -> 'IO' a -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs b/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs --- a/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs +++ b/src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs @@ -22,10 +22,6 @@ module Graphics.UI.FLTK.LowLevel.Hierarchy ( - -- * Region - Region, - -- * GlContext - GlContext, -- * Widget Widget, WidgetFuncs, @@ -173,8 +169,8 @@ redrawLabel, GetDamage, getDamage, - ClearDamageExcept, - clearDamageExcept, + ClearDamageThenSet, + clearDamageThenSet, ClearDamage, clearDamage, SetDamage, @@ -205,6 +201,12 @@ drawBackdrop, DrawFocus, drawFocus, + Flags, + flags, + SetFlag, + setFlag, + ClearFlag, + clearFlag, -- * Group Group, DrawChild, @@ -253,8 +255,8 @@ focus, DdfdesignKludge, ddfdesignKludge, - InsertWithBefore, - insertWithBefore, + InsertBefore, + insertBefore, GetArray, getArray, GetChild, @@ -411,8 +413,8 @@ getStep, Precision, precision, - SetFormat, - setFormat, + Format, + format, Round, round, Clamp, @@ -535,6 +537,8 @@ setTextcolor, DownBox, downBox, + AddAndGetMenuItem, + addAndGetMenuItem, -- * MenuBar MenuBar, -- * SysMenuBar @@ -563,18 +567,34 @@ uncache, Fail, fail, + Scale, + scale, + GetDataW, + getDataW, + GetDataH, + getDataH, + GetDataSize, + getDataSize, -- * Bitmap Bitmap, -- * Pixmap Pixmap, -- * CopySurface CopySurface, - ClassName, - className, SetCurrent, setCurrent, -- * ImageSurface ImageSurface, + GetOrigin, + getOrigin, + PrintableRect, + printableRect, + SetOrigin, + setOrigin, + GetOffscreenBeforeDelete, + getOffscreenBeforeDelete, + GetOffscreen, + getOffscreen, -- * Adjuster Adjuster, SetSoft, @@ -603,16 +623,12 @@ Counter, SetLstep, setLstep, - -- * SimpleCounter - SimpleCounter, -- * Scrollbar Scrollbar, SetLinesize, setLinesize, GetLinesize, getLinesize, - SetScrollValue, - setScrollValue, -- * ValueSlider ValueSlider, -- * HorValueSlider @@ -667,6 +683,8 @@ getTabNav, SetTabNav, setTabNav, + DrawText, + drawText, -- * Output Output, -- * ValueInput @@ -831,6 +849,10 @@ setRowsSuper, SetColsSuper, setColsSuper, + SetTabCellNav, + setTabCellNav, + GetTabCellNav, + getTabCellNav, -- * TableRow TableRow, GetRowSelected, @@ -943,6 +965,10 @@ getScrollbarWidth, SetScrollbarWidth, setScrollbarWidth, + SetScrollbarColor, + setScrollbarColor, + SetScrollbarSelectionColor, + setScrollbarSelectionColor, Sort, sort, SortWithSortType, @@ -955,6 +981,10 @@ Clock, GetValueSinceEpoch, getValueSinceEpoch, + GetShadow, + getShadow, + SetShadow, + setShadow, -- * TreePrefs TreePrefs, GetItemLabelfont, @@ -1103,8 +1133,8 @@ isClose, OpenToggle, openToggle, - SelectWithVal, - selectWithVal, + SelectSet, + selectSet, SelectToggle, selectToggle, SelectAll, @@ -1217,6 +1247,24 @@ setCallbackReason, GetCallbackReason, getCallbackReason, + RecalcTree, + recalcTree, + SetMarginbottom, + setMarginbottom, + GetMarginbottom, + getMarginbottom, + SetWidgetmarginleft, + setWidgetmarginleft, + GetWidgetmarginleft, + getWidgetmarginleft, + SetItemReselectMode, + setItemReselectMode, + GetItemReselectMode, + getItemReselectMode, + SetItemDrawMode, + setItemDrawMode, + GetItemDrawMode, + getItemDrawMode, -- * TextSelection TextSelection, Update, @@ -1492,7 +1540,7 @@ GetSpacing, isHorizontal, IsHorizontal, - -- Scrolled AKA Scroll + -- * Scrolled AKA Scroll Scrolled, ScrollTo, scrollTo, @@ -1500,7 +1548,7 @@ xposition, Yposition, yposition, - -- Tabs + -- * Tabs Tabs, GetPush, getPush, @@ -1510,11 +1558,21 @@ which, ClientArea, clientArea, - -- Spinner + TabPositions, + tabPositions, + TabHeight, + tabHeight, + GetTabAlign, + getTabAlign, + SetTabAlign, + setTabAlign, + -- * Spinner Spinner, GetFormat, getFormat, - -- ColorChooser + SetFormat, + setFormat, + -- * ColorChooser ColorChooser, GetHue, getHue, @@ -1530,7 +1588,11 @@ setHsv, SetRgb, setRgb, - -- FileBrowser + GetRgb, + getRgb, + GetHsv, + getHsv, + -- * FileBrowser FileBrowser, SetIconsize, setIconsize, @@ -1540,28 +1602,68 @@ setFiletype, GetFiletype, getFiletype, - -- RGBImage + -- * RGBImage RGBImage, - -- JPEGImage + -- * JPEGImage JPEGImage, - -- BMPImage + -- * BMPImage BMPImage, - -- GIFImage + -- * GIFImage GIFImage, - -- XBMImage + -- * XBMImage XBMImage, - -- XPMImage + -- * XPMImage XPMImage, - -- PNGImage + -- * PNGImage PNGImage, - -- PNMImage + -- * PNMImage PNMImage, - -- FileInput + -- * FileInput FileInput, GetErrorColor, getErrorColor, SetErrorColor, - setErrorColor + setErrorColor, + ScreenDriver, + SystemDriver, + -- * SVGImage + SVGImage, + -- * SimpleTerminal + SimpleTerminal, + SetStayAtBottom, + setStayAtBottom, + GetStayAtBottom, + getStayAtBottom, + SetHistoryLines, + setHistoryLines, + GetHistoryLines, + getHistoryLines, + SetAnsi, + setAnsi, + GetAnsi, + getAnsi, + SetStyleTable, + setStyleTable, + GetStyleTable, + getStyleTable, + GetStyleTableSize, + getStyleTableSize, + SetNormalStyleIndex, + setNormalStyleIndex, + GetNormalStyleIndex, + getNormalStyleIndex, + SetCurrentStyleIndex, + setCurrentStyleIndex, + GetCurrentStyleIndex, + getCurrentStyleIndex, + RemoveLines, + removeLines, + -- MultiLabel + MultiLabel, + WidgetLabel, + widgetLabel, + MenuItemLabel, + menuItemLabel ) where import Prelude hiding (round, fail) @@ -1572,14 +1674,7 @@ import System.IO.Unsafe #endif type instance Functions Base = () -data CRegion parent -type Region = CRegion Base -type instance Functions Region = () -data CGlContext parent -type GlContext = CGlContext Base -type instance Functions GlContext = () - data CWidget parent type Widget = CWidget Base type WidgetFuncs = @@ -1655,7 +1750,7 @@ (Redraw (RedrawLabel (GetDamage - (ClearDamageExcept + (ClearDamageThenSet (ClearDamage (SetDamage (SetDamageInside @@ -1671,7 +1766,10 @@ (DrawBoxWithBoxtype (DrawBackdrop (DrawFocus - ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + (Flags + (SetFlag + (ClearFlag + ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions Widget = WidgetFuncs MAKE_METHOD(Destroy, destroy) @@ -1745,7 +1843,7 @@ MAKE_METHOD(Redraw,redraw) MAKE_METHOD(RedrawLabel,redrawLabel) MAKE_METHOD(GetDamage,getDamage) -MAKE_METHOD(ClearDamageExcept,clearDamageExcept) +MAKE_METHOD(ClearDamageThenSet,clearDamageThenSet) MAKE_METHOD(ClearDamage,clearDamage) MAKE_METHOD(SetDamage,setDamage) MAKE_METHOD(SetDamageInside,setDamageInside) @@ -1761,6 +1859,9 @@ MAKE_METHOD(DrawBoxWithBoxtype,drawBoxWithBoxtype) MAKE_METHOD(DrawBackdrop,drawBackdrop) MAKE_METHOD(DrawFocus,drawFocus) +MAKE_METHOD(Flags,flags) +MAKE_METHOD(SetFlag, setFlag) +MAKE_METHOD(ClearFlag, clearFlag) -- * Group data CGroup parent @@ -1772,6 +1873,8 @@ (DrawOutsideLabel (UpdateChild (Begin + (Handle + (HandleSuper (End (Within (Find @@ -1790,10 +1893,10 @@ (ClipChildren (Focus (DdfdesignKludge - (InsertWithBefore + (InsertBefore (GetArray (GetChild - ()))))))))))))))))))))))))))) + ()))))))))))))))))))))))))))))) type instance Functions Group = GroupFuncs MAKE_METHOD(DrawChild,drawChild) @@ -1819,7 +1922,7 @@ MAKE_METHOD(ClipChildren,clipChildren) MAKE_METHOD(Focus,focus) MAKE_METHOD(DdfdesignKludge,ddfdesignKludge) -MAKE_METHOD(InsertWithBefore,insertWithBefore) +MAKE_METHOD(InsertBefore,insertBefore) MAKE_METHOD(GetArray,getArray) MAKE_METHOD(GetChild,getChild) @@ -2054,7 +2157,7 @@ (Hide (HideSuper (Destroy ()))))))))) -type CheckButton = CCheckButton Button +type CheckButton = CCheckButton LightButton type instance Functions CheckButton = CheckButtonFuncs @@ -2075,7 +2178,7 @@ type instance Functions ReturnButton = ReturnButtonFuncs data CRoundButton parent -type RoundButton = CRoundButton Button +type RoundButton = CRoundButton LightButton type RoundButtonFuncs = (Destroy (Draw @@ -2136,7 +2239,7 @@ (Precision (GetValue (SetValue - (SetFormat + (Format (Round (Clamp (Increment @@ -2152,10 +2255,11 @@ MAKE_METHOD(GetMaximum,getMaximum) MAKE_METHOD(SetMaximum,setMaximum) MAKE_METHOD(Range,range) +-- MAKE_METHOD(SetRange,setRange) MAKE_METHOD(SetStep,setStep) MAKE_METHOD(GetStep,getStep) MAKE_METHOD(Precision,precision) -MAKE_METHOD(SetFormat,setFormat) +MAKE_METHOD(Format,format) MAKE_METHOD(Round,round) MAKE_METHOD(Clamp,clamp) MAKE_METHOD(Increment,increment) @@ -2337,13 +2441,9 @@ (SetDownBox (GetDownColor (SetDownColor -#if FLTK_API_VERSION >= 10304 (Setonly -#endif - ()))))))))))))))))))))))))))))))))))))))))))))) -#if FLTK_API_VERSION >= 10304 - ) -#endif + (AddAndGetMenuItem + ()))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions MenuPrim = MenuPrimFuncs @@ -2372,6 +2472,7 @@ MAKE_METHOD(GetTextcolor,getTextcolor) MAKE_METHOD(SetTextcolor,setTextcolor) MAKE_METHOD(DownBox,downBox) +MAKE_METHOD(AddAndGetMenuItem, addAndGetMenuItem) data CMenuBar parent type MenuBar = CMenuBar MenuPrim @@ -2470,13 +2571,12 @@ (DrawResize (Draw (Uncache -#if FLTK_API_VERSION >= 10304 + (Scale + (GetDataW + (GetDataH + (GetDataSize (Fail -#endif - ()))))))))))))) -#if FLTK_API_VERSION >= 10304 - ) -#endif + ())))))))))))))))))) type instance Functions Image = ImageFuncs @@ -2489,6 +2589,10 @@ MAKE_METHOD(DrawResize,drawResize) MAKE_METHOD(Uncache,uncache) MAKE_METHOD(Fail,fail) +MAKE_METHOD(Scale,scale) +MAKE_METHOD(GetDataW,getDataW) +MAKE_METHOD(GetDataH,getDataH) +MAKE_METHOD(GetDataSize,getDataSize) data CBitmap parent type Bitmap = CBitmap Image @@ -2534,27 +2638,34 @@ type CopySurface = CCopySurface Base type CopySurfaceFuncs = (Destroy - (ClassName (SetCurrent (Draw - ())))) + ()))) type instance Functions CopySurface = CopySurfaceFuncs -MAKE_METHOD(ClassName,className) MAKE_METHOD(SetCurrent,setCurrent) data CImageSurface parent type ImageSurface = CImageSurface Base type ImageSurfaceFuncs = (Destroy - (ClassName (SetCurrent (Draw - ())))) + (GetOrigin + (PrintableRect + (SetOrigin + (GetOffscreenBeforeDelete + (GetOffscreen + ())))))))) type instance Functions ImageSurface = ImageSurfaceFuncs +MAKE_METHOD(GetOrigin, getOrigin) +MAKE_METHOD(PrintableRect, printableRect) +MAKE_METHOD(SetOrigin, setOrigin) +MAKE_METHOD(GetOffscreenBeforeDelete, getOffscreenBeforeDelete) +MAKE_METHOD(GetOffscreen, getOffscreen) data CAdjuster parent type Adjuster = CAdjuster Valuator @@ -2660,16 +2771,11 @@ MAKE_METHOD(SetLstep,setLstep) -data CSimpleCounter parent -type SimpleCounter = CSimpleCounter Counter - -type instance Functions SimpleCounter = () - data CScrollbar parent type Scrollbar = CScrollbar Slider type ScrollbarFuncs = (Destroy - (SetScrollValue + (Scrollvalue (SetLinesize (GetLinesize (SetType @@ -2688,7 +2794,6 @@ MAKE_METHOD(SetLinesize,setLinesize) MAKE_METHOD(GetLinesize,getLinesize) -MAKE_METHOD(SetScrollValue,setScrollValue) data CValueSlider parent type ValueSlider = CValueSlider Slider @@ -2769,7 +2874,8 @@ (ShowWidgetSuper (Hide (HideSuper - ()))))))))))))))))))))))))))))))))))))))))))))))))) + (DrawText + ())))))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions Input = InputFuncs @@ -2797,6 +2903,7 @@ MAKE_METHOD(SetWrap,setWrap) MAKE_METHOD(GetTabNav,getTabNav) MAKE_METHOD(SetTabNav,setTabNav) +MAKE_METHOD(DrawText,drawText) data COutput parent type Output = COutput Input @@ -3045,7 +3152,7 @@ (InitSizes (Add (Insert - (InsertWithBefore + (InsertBefore (Begin (End (GetArray @@ -3070,7 +3177,9 @@ (ShowWidgetSuper (Hide (HideSuper - ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + (GetTabCellNav + (SetTabCellNav + ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions Table = TableFuncs @@ -3125,6 +3234,8 @@ MAKE_METHOD(ClearSuper,clearSuper) MAKE_METHOD(SetRowsSuper,setRowsSuper) MAKE_METHOD(SetColsSuper,setColsSuper) +MAKE_METHOD(SetTabCellNav, setTabCellNav) +MAKE_METHOD(GetTabCellNav, getTabCellNav) data CTableRow parent type TableRow = CTableRow Table @@ -3184,15 +3295,10 @@ (RedrawOverlay (HideOverlay (MakeOverlayCurrent -#if FLTK_API_VERSION >= 10304 (PixelsPerUnit (PixelH (PixelW -#endif - ()))))))))))))))))))))))))))))) -#if FLTK_API_VERSION >= 10304 - ))) -#endif + ())))))))))))))))))))))))))))))))) type instance Functions GlWindow = GlWindowFuncs @@ -3277,11 +3383,15 @@ (SetScrollbarSize (GetScrollbarWidth (SetScrollbarWidth + (SetScrollbarColor + (SetScrollbarSelectionColor (Sort (SortWithSortType (SetType (GetType_ - ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + (DrawSuper + (HandleSuper + ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions Browser = BrowserFuncs @@ -3319,6 +3429,8 @@ MAKE_METHOD(SetScrollbarSize,setScrollbarSize) MAKE_METHOD(GetScrollbarWidth,getScrollbarWidth) MAKE_METHOD(SetScrollbarWidth,setScrollbarWidth) +MAKE_METHOD(SetScrollbarColor,setScrollbarColor) +MAKE_METHOD(SetScrollbarSelectionColor,setScrollbarSelectionColor) MAKE_METHOD(SortWithSortType,sortWithSortType) MAKE_METHOD(Sort,sort) @@ -3348,11 +3460,15 @@ (ShowWidgetSuper (Hide (HideSuper - ()))))))))))))) + (SetShadow + (GetShadow + ()))))))))))))))) type instance Functions Clock = ClockFuncs MAKE_METHOD(GetValueSinceEpoch,getValueSinceEpoch) +MAKE_METHOD(GetShadow,getShadow) +MAKE_METHOD(SetShadow,setShadow) data CTreePrefs parent type TreePrefs = CTreePrefs Base @@ -3406,7 +3522,13 @@ (SetShowroot (GetSelectmode (SetSelectmode - ()))))))))))))))))))))))))))))))))))))))))))))))))) + (GetMarginbottom + (SetMarginbottom + (GetWidgetmarginleft + (SetWidgetmarginleft + (GetItemReselectMode + (SetItemReselectMode + ()))))))))))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions TreePrefs = TreePrefsFuncs @@ -3514,7 +3636,7 @@ (IsClose (OpenToggle (Select - (SelectWithVal + (SelectSet (SelectToggle (SelectAll (Deselect @@ -3569,7 +3691,7 @@ MAKE_METHOD(IsOpen,isOpen) MAKE_METHOD(IsClose,isClose) MAKE_METHOD(OpenToggle,openToggle) -MAKE_METHOD(SelectWithVal,selectWithVal) +MAKE_METHOD(SelectSet,selectSet) MAKE_METHOD(SelectToggle,selectToggle) MAKE_METHOD(SelectAll,selectAll) MAKE_METHOD(DeselectAll,deselectAll) @@ -3705,7 +3827,14 @@ (ShowWidgetSuper (Hide (HideSuper - ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + (RecalcTree + (GetMarginbottom + (SetMarginbottom + (GetWidgetmarginleft + (SetWidgetmarginleft + (GetItemReselectMode + (SetItemReselectMode + ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) type instance Functions Tree = TreeFuncs @@ -3750,6 +3879,15 @@ MAKE_METHOD(GetCallbackItem,getCallbackItem) MAKE_METHOD(SetCallbackReason,setCallbackReason) MAKE_METHOD(GetCallbackReason,getCallbackReason) +MAKE_METHOD(RecalcTree, recalcTree) +MAKE_METHOD(SetMarginbottom,setMarginbottom) +MAKE_METHOD(GetMarginbottom,getMarginbottom) +MAKE_METHOD(SetWidgetmarginleft,setWidgetmarginleft) +MAKE_METHOD(GetWidgetmarginleft,getWidgetmarginleft) +MAKE_METHOD(SetItemReselectMode,setItemReselectMode) +MAKE_METHOD(GetItemReselectMode,getItemReselectMode) +MAKE_METHOD(SetItemDrawMode,setItemDrawMode) +MAKE_METHOD(GetItemDrawMode,getItemDrawMode) data CTextSelection parent type TextSelection = CTextSelection Base @@ -4174,6 +4312,8 @@ (HandleSuper (ShowWidget (ShowWidgetSuper + (Resize + (ResizeSuper (Hide (HideSuper (GetValue @@ -4181,7 +4321,11 @@ (GetPush (SetPush (Which - (ClientArea ())))))))))))))) + (ClientArea + (TabPositions + (TabHeight + (GetTabAlign + (SetTabAlign ())))))))))))))))))))) type instance Functions Tabs = TabsFuncs @@ -4189,6 +4333,10 @@ MAKE_METHOD(SetPush,setPush) MAKE_METHOD(Which,which) MAKE_METHOD(ClientArea,clientArea) +MAKE_METHOD(TabPositions, tabPositions) +MAKE_METHOD(TabHeight, tabHeight) +MAKE_METHOD(GetTabAlign,getTabAlign) +MAKE_METHOD(SetTabAlign,setTabAlign) data CSpinner parent type Spinner = CSpinner Group @@ -4221,11 +4369,14 @@ (ShowWidgetSuper (Hide (HideSuper - ())))))))))))))))))))))))))))) + (GetWrap + (SetWrap + ())))))))))))))))))))))))))))))) type instance Functions Spinner = SpinnerFuncs MAKE_METHOD(GetFormat,getFormat) +MAKE_METHOD(SetFormat,setFormat) data CColorChooser parent type ColorChooser = CColorChooser Group @@ -4248,7 +4399,9 @@ (ShowWidgetSuper (Hide (HideSuper - ())))))))))))))))))) + (GetRgb + (GetHsv + ())))))))))))))))))))) type instance Functions ColorChooser = ColorChooserFuncs @@ -4259,6 +4412,8 @@ MAKE_METHOD(GetB, getB) MAKE_METHOD(SetHsv, setHsv) MAKE_METHOD(SetRgb, setRgb) +MAKE_METHOD(GetRgb, getRgb) +MAKE_METHOD(GetHsv, getHsv) data CFileBrowser parent type FileBrowser = CFileBrowser Browser @@ -4358,3 +4513,78 @@ type instance Functions FileInput = FileInputFuncs MAKE_METHOD(SetErrorColor, setErrorColor) MAKE_METHOD(GetErrorColor, getErrorColor) + +data CScreenDriver parent +type ScreenDriver = CScreenDriver Base +type instance Functions ScreenDriver = () + +data CSystemDriver parent +type SystemDriver = CSystemDriver Base +type instance Functions SystemDriver = () + +data CSVGImage parent +type SVGImage = CSVGImage RGBImage +type SVGImageFuncs = + (Destroy + (Copy + (ColorAverage + (Desaturate + (DrawResize + (Draw + (Resize + ()))))))) +type instance Functions SVGImage = SVGImageFuncs + +data CSimpleTerminal parent +type SimpleTerminal = CSimpleTerminal TextDisplay +type SimpleTerminalFuncs = + (SetStayAtBottom + (GetStayAtBottom + (SetHistoryLines + (GetHistoryLines + (SetAnsi + (GetAnsi + (SetStyleTable + (GetStyleTable + (GetStyleTableSize + (SetNormalStyleIndex + (GetNormalStyleIndex + (SetCurrentStyleIndex + (GetCurrentStyleIndex + (SetText + (GetText + (Clear + (RemoveLines + (DrawSuper + (ResizeSuper + (HandleSuper + (HideSuper + (ShowWidgetSuper + ())))))))))))))))))))))) +type instance Functions SimpleTerminal = SimpleTerminalFuncs + +MAKE_METHOD(SetStayAtBottom,setStayAtBottom) +MAKE_METHOD(GetStayAtBottom,getStayAtBottom) +MAKE_METHOD(SetHistoryLines,setHistoryLines) +MAKE_METHOD(GetHistoryLines,getHistoryLines) +MAKE_METHOD(SetAnsi,setAnsi) +MAKE_METHOD(GetAnsi,getAnsi) +MAKE_METHOD(SetStyleTable,setStyleTable) +MAKE_METHOD(GetStyleTable,getStyleTable) +MAKE_METHOD(GetStyleTableSize,getStyleTableSize) +MAKE_METHOD(SetNormalStyleIndex,setNormalStyleIndex) +MAKE_METHOD(GetNormalStyleIndex,getNormalStyleIndex) +MAKE_METHOD(SetCurrentStyleIndex,setCurrentStyleIndex) +MAKE_METHOD(GetCurrentStyleIndex,getCurrentStyleIndex) +MAKE_METHOD(RemoveLines,removeLines) + +data CMultiLabel parent +type MultiLabel = CMultiLabel Base +type MultiLabelFuncs = + (WidgetLabel + (MenuItemLabel + (()))) +type instance Functions MultiLabel = MultiLabelFuncs + +MAKE_METHOD(WidgetLabel, widgetLabel) +MAKE_METHOD(MenuItemLabel, menuItemLabel) diff --git a/src/Graphics/UI/FLTK/LowLevel/HorFillSlider.chs b/src/Graphics/UI/FLTK/LowLevel/HorFillSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/HorFillSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/HorFillSlider.chs @@ -17,7 +17,7 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import qualified Data.Text as T - +import Graphics.UI.FLTK.LowLevel.Widget {# fun Fl_Hor_Fill_Slider_New as horFillSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Hor_Fill_Slider_New_WithLabel as horFillSliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} horFillSliderNew :: Rectangle -> Maybe T.Text -> IO (Ref HorFillSlider) @@ -26,8 +26,11 @@ in case l' of Nothing -> horFillSliderNew' x_pos y_pos width height >>= toRef - Just l -> horFillSliderNewWithLabel' x_pos y_pos width height l >>= - toRef + Just l -> do + ref <- horFillSliderNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- @ -- diff --git a/src/Graphics/UI/FLTK/LowLevel/HorNiceSlider.chs b/src/Graphics/UI/FLTK/LowLevel/HorNiceSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/HorNiceSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/HorNiceSlider.chs @@ -16,6 +16,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Hor_Nice_Slider_New as horNiceSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Hor_Nice_Slider_New_WithLabel as horNiceSliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -25,9 +26,11 @@ in case l' of Nothing -> horNiceSliderNew' x_pos y_pos width height >>= toRef - Just l -> horNiceSliderNewWithLabel' x_pos y_pos width height l >>= - toRef - + Just l -> do + ref <- horNiceSliderNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ -- "Graphics.UI.FLTK.LowLevel.Widget" diff --git a/src/Graphics/UI/FLTK/LowLevel/HorSlider.chs b/src/Graphics/UI/FLTK/LowLevel/HorSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/HorSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/HorSlider.chs @@ -16,6 +16,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Hor_Slider_New as horSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Hor_Slider_New_WithLabel as horSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -25,9 +26,11 @@ in case l' of Nothing -> horSliderNew' x_pos y_pos width height >>= toRef - Just l -> horSliderNewWithLabel' x_pos y_pos width height l >>= - toRef - + Just l -> do + ref <- horSliderNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ -- "Graphics.UI.FLTK.LowLevel.Widget" diff --git a/src/Graphics/UI/FLTK/LowLevel/HorValueSlider.chs b/src/Graphics/UI/FLTK/LowLevel/HorValueSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/HorValueSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/HorValueSlider.chs @@ -16,6 +16,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Hor_Value_Slider_New as horValueSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Hor_Value_Slider_New_WithLabel as horValueSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -25,8 +26,11 @@ in case l' of Nothing -> horValueSliderNew' x_pos y_pos width height >>= toRef - Just l -> horValueSliderNewWithLabel' x_pos y_pos width height l >>= - toRef + Just l -> do + ref <- horValueSliderNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Image.chs b/src/Graphics/UI/FLTK/LowLevel/Image.chs --- a/src/Graphics/UI/FLTK/LowLevel/Image.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Image.chs @@ -2,18 +2,16 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.Image ( -#if FLTK_API_VERSION >= 10304 ImageFail(..), -#endif ImageFuncs(..), defaultImageFuncs, imageNew, - ColorAverageCallback, - ImageDrawCallback, - ImageCopyCallback, - toImageDrawCallbackPrim, - toColorAverageCallbackPrim, - toImageCopyCallbackPrim + CustomColorAverage, + CustomImageDraw, + CustomImageCopy, + toCustomImageDrawPrim, + toCustomColorAveragePrim, + toCustomImageCopyPrim -- * Hierarchy -- -- $hierarchy @@ -33,7 +31,6 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch -#if FLTK_API_VERSION >= 10304 #c enum ImageFail { ImageErrNoImage = ERR_NO_IMAGE, @@ -43,14 +40,13 @@ #endc -- | Only available on FLTK version 1.3.4 and above. {#enum ImageFail {} deriving (Show, Eq, Ord) #} -#endif -type ColorAverageCallback = Ref Image -> Color -> Float -> IO () -type ImageDrawCallback = Ref Image -> Position -> Size -> Maybe X -> Maybe Y -> IO () -type ImageCopyCallback = Ref Image -> Size -> IO (Ref Image) -toImageDrawCallbackPrim :: ImageDrawCallback -> IO (FunPtr ImageDrawCallbackPrim) -toImageDrawCallbackPrim f = - mkImageDrawCallbackPrimPtr +type CustomColorAverage = Ref Image -> Color -> Float -> IO () +type CustomImageDraw = Ref Image -> Position -> Size -> Maybe X -> Maybe Y -> IO () +type CustomImageCopy = Ref Image -> Size -> IO (Ref Image) +toCustomImageDrawPrim :: CustomImageDraw -> IO (FunPtr CustomImageDrawPrim) +toCustomImageDrawPrim f = + mkCustomImageDrawPrimPtr (\ptr x_pos' y_pos' width' height' x_offset' y_offset' -> let _x_offset = fmap X $ integralToMaybe x_offset' _y_offset = fmap Y $ integralToMaybe y_offset' @@ -62,19 +58,19 @@ toRef ptr >>= \refPtr -> f refPtr position' size' _x_offset _y_offset ) -toColorAverageCallbackPrim :: ColorAverageCallback -> IO (FunPtr ColorAverageCallbackPrim) -toColorAverageCallbackPrim f = - mkColorAverageCallbackPtr +toCustomColorAveragePrim :: CustomColorAverage -> IO (FunPtr CustomColorAveragePrim) +toCustomColorAveragePrim f = + mkCustomColorAveragePtr (\ptr cint cfloat -> - wrapNonNull ptr "Null pointer. toColorAverageCallbackPrim" >>= \pp -> + wrapNonNull ptr "Null pointer. toCustomColorAveragePrim" >>= \pp -> f (wrapInRef pp) (Color (fromIntegral cint)) (realToFrac cfloat) ) -toImageCopyCallbackPrim :: ImageCopyCallback -> IO (FunPtr ImageCopyCallbackPrim) -toImageCopyCallbackPrim f = - mkImageCopyCallbackPrimPtr +toCustomImageCopyPrim :: CustomImageCopy -> IO (FunPtr CustomImageCopyPrim) +toCustomImageCopyPrim f = + mkCustomImageCopyPrimPtr (\ptr width' height' -> do - pp <- wrapNonNull ptr "Null pointer. toImageCopyCallbackPrim" + pp <- wrapNonNull ptr "Null pointer. toCustomImageCopyPrim" refPtr <- f (wrapInRef pp) (Size (Width $ fromIntegral width') (Height $ fromIntegral height')) unsafeRefToPtr refPtr @@ -84,9 +80,9 @@ data ImageFuncs a b = ImageFuncs { - imageDrawOverride :: Maybe (ImageDrawCallback), - imageColorAverageOverride :: Maybe (ColorAverageCallback), - imageCopyOverride :: Maybe (ImageCopyCallback), + imageDrawOverride :: Maybe (CustomImageDraw), + imageColorAverageOverride :: Maybe (CustomColorAverage), + imageCopyOverride :: Maybe (CustomImageCopy), imageDesaturateOverride :: Maybe (Ref Image -> IO ()), imageUncacheOverride :: Maybe (Ref Image -> IO ()) } @@ -95,11 +91,11 @@ imageFunctionStruct :: (ImageFuncs a b) -> IO (Ptr ()) imageFunctionStruct funcs = do p <- virtualFuncs' - toImageDrawCallbackPrim `orNullFunPtr` (imageDrawOverride funcs) >>= + toCustomImageDrawPrim `orNullFunPtr` (imageDrawOverride funcs) >>= {# set fl_Image_Virtual_Funcs->draw #} p - toColorAverageCallbackPrim `orNullFunPtr` (imageColorAverageOverride funcs) >>= + toCustomColorAveragePrim `orNullFunPtr` (imageColorAverageOverride funcs) >>= {# set fl_Image_Virtual_Funcs->color_average #} p - toImageCopyCallbackPrim `orNullFunPtr` (imageCopyOverride funcs) >>= + toCustomImageCopyPrim `orNullFunPtr` (imageCopyOverride funcs) >>= {# set fl_Image_Virtual_Funcs->copy #} p toCallbackPrim `orNullFunPtr` (imageDesaturateOverride funcs) >>= {# set fl_Image_Virtual_Funcs->desaturate #} p @@ -126,11 +122,11 @@ instance (impl ~ (IO ())) => Op (Destroy ()) Image orig impl where runOp _ _ image = withRef image $ \imagePtr -> flImageDestroy' imagePtr {# fun Fl_Image_w as w' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetW ()) Image orig impl where - runOp _ _ image = withRef image $ \imagePtr -> w' imagePtr +instance (impl ~ ( IO (Width))) => Op (GetW ()) Image orig impl where + runOp _ _ image = withRef image $ \imagePtr -> w' imagePtr >>= return . Width {# fun Fl_Image_h as h' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetH ()) Image orig impl where - runOp _ _ image = withRef image $ \imagePtr -> h' imagePtr +instance (impl ~ ( IO (Height))) => Op (GetH ()) Image orig impl where + runOp _ _ image = withRef image $ \imagePtr -> h' imagePtr >>= return . Height {# fun Fl_Image_d as d' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (GetD ()) Image orig impl where runOp _ _ image = withRef image $ \imagePtr -> d' imagePtr @@ -185,7 +181,6 @@ instance (impl ~ ( IO ())) => Op (Uncache ()) Image orig impl where runOp _ _ image = withRef image $ \imagePtr -> uncache' imagePtr -#if FLTK_API_VERSION >= 10304 {#fun Fl_Image_fail as fail' { id `Ptr ()'} -> `CInt' #} -- | Only available on FLTK version 1.3.4 and above. instance (impl ~ (IO (Either ImageFail ()))) => Op (Fail ()) Image orig impl where @@ -194,7 +189,21 @@ if (res == 0) then return (Right ()) else return (Left (cToEnum res)) -#endif +{# fun Fl_Image_data_w as dataw' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Width))) => Op (GetDataW ()) Image orig impl where + runOp _ _ image = withRef image $ \imagePtr -> dataw' imagePtr >>= return . Width +{# fun Fl_Image_data_h as datah' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Height))) => Op (GetDataH ()) Image orig impl where + runOp _ _ image = withRef image $ \imagePtr -> datah' imagePtr >>= return . Height +instance (impl ~ ( IO (Size))) => Op (GetDataSize ()) Image orig impl where + runOp _ _ image = do + w' <- getDataW image + h' <- getDataH image + return (Size w' h') +{# fun Fl_Image_scale as scale' { id `Ptr ()' , `Int' , `Int' , cFromBool `Bool' , cFromBool `Bool'} -> `()' #} +instance (impl ~ (Size -> Maybe Bool -> Maybe Bool -> IO ())) => Op (Scale ()) Image orig impl where + runOp _ _ image (Size (Width w') (Height h')) proportional can_expand = + withRef image $ \imagePtr -> scale' imagePtr w' h' (maybe True id proportional) (maybe False id can_expand) -- $functions -- @ @@ -210,22 +219,29 @@ -- -- drawResize :: 'Ref' 'Image' -> 'Position' -> 'Size' -> 'Maybe' 'X' -> 'Maybe' 'Y' -> 'IO' () -- +-- fail :: 'Ref' 'Image' -> 'IO' ('Either' 'ImageFail' ()) +-- -- getCount :: 'Ref' 'Image' -> 'IO' ('Int') -- -- getD :: 'Ref' 'Image' -> 'IO' ('Int') -- --- getH :: 'Ref' 'Image' -> 'IO' ('Int') +-- getDataH :: 'Ref' 'Image' -> 'IO' ('Height') -- +-- getDataSize :: 'Ref' 'Image' -> 'IO' ('Size') +-- +-- getDataW :: 'Ref' 'Image' -> 'IO' ('Width') +-- +-- getH :: 'Ref' 'Image' -> 'IO' ('Height') +-- -- getLd :: 'Ref' 'Image' -> 'IO' ('Int') -- --- getW :: 'Ref' 'Image' -> 'IO' ('Int') +-- getW :: 'Ref' 'Image' -> 'IO' ('Width') -- -- inactive :: 'Ref' 'Image' -> 'IO' () -- --- uncache :: 'Ref' 'Image' -> 'IO' () +-- scale :: 'Ref' 'Image' -> 'Size' -> 'Maybe' 'Bool' -> 'Maybe' 'Bool' -> 'IO' () -- --- Available in FLTK 1.3.4 only: --- fail :: 'Ref' 'Image' -> 'IO' ('Either' 'ImageFail' ()) +-- uncache :: 'Ref' 'Image' -> 'IO' () -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs b/src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs --- a/src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ImageSurface.chs @@ -2,7 +2,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.ImageSurface ( - imageSurfaceNew + imageSurfaceNew, + imageSurfaceRescale -- * Hierarchy -- -- $hierarchy @@ -22,8 +23,11 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch -import qualified Data.Text as T +{# fun Fl_Image_Surface_rescale as imageSurfaceRescale' {id `Ptr ()'} -> `()' #} +imageSurfaceRescale :: (Parent a ImageSurface) => Ref a -> IO () +imageSurfaceRescale is = withRef is $ \imageSurfacePtr -> imageSurfaceRescale' imageSurfacePtr + {# fun Fl_Image_Surface_New as imageSurfaceNew' {`Int', `Int'} -> `Ptr ()' id #} imageSurfaceNew :: Size -> IO (Ref ImageSurface) imageSurfaceNew (Size (Width w') (Height h')) = imageSurfaceNew' w' h' >>= toRef @@ -32,10 +36,6 @@ instance (impl ~ (IO ())) => Op (Destroy ()) ImageSurface orig impl where runOp _ _ image_surface = withRef image_surface $ \image_surfacePtr -> imageSurfaceDestroy' image_surfacePtr -{# fun Fl_Image_Surface_class_name as className' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} -instance (impl ~ ( IO (T.Text))) => Op (ClassName ()) ImageSurface orig impl where - runOp _ _ image_surface = withRef image_surface $ \image_surfacePtr -> className' image_surfacePtr - {# fun Fl_Image_Surface_set_current as setCurrent' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (SetCurrent ()) ImageSurface orig impl where runOp _ _ image_surface = withRef image_surface $ \image_surfacePtr -> setCurrent' image_surfacePtr @@ -44,7 +44,33 @@ instance (Parent a Widget, impl ~ ( Ref a -> Position -> IO ())) => Op (Draw ()) ImageSurface orig impl where runOp _ _ image_surface widget (Position (X delta_x) (Y delta_y)) = withRef image_surface $ \image_surfacePtr -> withRef widget $ \widgetPtr -> draw' image_surfacePtr widgetPtr delta_x delta_y +{# fun Fl_Image_Surface_get_origin as getOrigin' {id `Ptr()', alloca- `CInt' peekIntConv*, alloca- `CInt' peekIntConv*} -> `()' #} +instance (impl ~ (IO (Position))) => Op (GetOrigin ()) ImageSurface orig impl where + runOp _ _ image_surface = + withRef image_surface (\ptr -> do + (x',y') <- getOrigin' ptr + return (Position (X (fromIntegral x')) (Y (fromIntegral y'))) + ) +{# fun Fl_Image_Surface_printable_rect as printableRect' {id `Ptr()', alloca- `CInt' peekIntConv*, alloca- `CInt' peekIntConv*} -> `Int' #} +instance (impl ~ (IO (Either UnknownError Size))) => Op (PrintableRect ()) ImageSurface orig impl where + runOp _ _ image_surface = + withRef image_surface (\ptr -> do + (status, w',h') <- printableRect' ptr + if (status == (0 :: Int)) + then return (Right (Size (Width (fromIntegral w')) (Height (fromIntegral h')))) + else return (Left UnknownError) + ) +{# fun Fl_Image_Surface_set_origin as setOrigin' {id `Ptr()', `Int', `Int'} -> `()' #} +instance (impl ~ (Position -> IO ())) => Op (SetOrigin ()) ImageSurface orig impl where + runOp _ _ image_surface (Position (X x') (Y y')) = + withRef image_surface (\ptr -> setOrigin' ptr (fromIntegral x') (fromIntegral y')) + +{# fun Fl_Image_Surface_offscreen as offscreen' {id `Ptr()' } -> `Fl_Offscreen' id #} +instance (impl ~ ( IO (FlOffscreen))) => Op (GetOffscreen ()) ImageSurface orig impl where + runOp _ _ image_surface = + withRef image_surface (\ptr -> offscreen' ptr >>= return . FlOffscreen ) + -- $hierarchy -- @ -- "Graphics.UI.FLTK.LowLevel.ImageSurface" @@ -52,11 +78,17 @@ -- $functions -- @ --- className :: 'Ref' 'ImageSurface' -> 'IO' ('T.Text') --- -- destroy :: 'Ref' 'ImageSurface' -> 'IO' () -- -- draw:: ('Parent' a 'Widget') => 'Ref' 'ImageSurface' -> 'Ref' a -> 'Position' -> 'IO' () -- +-- getOffscreen :: 'Ref' 'ImageSurface' -> 'IO' ('FlOffscreen') +-- +-- getOrigin :: 'Ref' 'ImageSurface' -> 'IO' ('Position') +-- +-- printableRect :: 'Ref' 'ImageSurface' -> 'IO' ('Either' 'UnknownError' 'Size') +-- -- setCurrent :: 'Ref' 'ImageSurface' -> 'IO' () +-- +-- setOrigin :: 'Ref' 'ImageSurface' -> 'Position' -> 'IO' () -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Input.chs b/src/Graphics/UI/FLTK/LowLevel/Input.chs --- a/src/Graphics/UI/FLTK/LowLevel/Input.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Input.chs @@ -41,7 +41,8 @@ FlFloatInput = FL_FLOAT_INPUT, FlIntInput = FL_INT_INPUT, FlMultilineInput = FL_MULTILINE_INPUT, - FlSecretInput = FL_SECRET_INPUT + FlSecretInput = FL_SECRET_INPUT, + FlHiddenInput = FL_HIDDEN_INPUT }; #endc {#enum FlInputType {}#} @@ -50,17 +51,34 @@ inputCustom :: Rectangle -- ^ The bounds of this Input -> Maybe T.Text -- ^ The Input label - -> Maybe (Ref Input -> IO ()) -- ^ Optional custom drawing function - -> Maybe (CustomWidgetFuncs Input) -- ^ Optional custom widget functions + -> Maybe FlInputType -- ^ The input type + -> Maybe (Ref Input -> IO ()) -- ^ Optional custom drawing function + -> Maybe (CustomWidgetFuncs Input) -- ^ Optional custom widget functions -> IO (Ref Input) -inputCustom rectangle l' draw' funcs' = - widgetMaker - rectangle - l' - draw' - funcs' - overriddenWidgetNew' - overriddenWidgetNewWithLabel' +inputCustom rectangle l' itMaybe draw' funcs' = do + i <- widgetMaker + rectangle + l' + draw' + funcs' + overriddenWidgetNew' + overriddenWidgetNewWithLabel' + maybe + (return ()) + (\it -> do + setInputType i it + case it of + FlNormalInput -> return () + FlFloatInput -> clearFlag i WidgetFlagMacUseAccentsMenu + FlIntInput -> clearFlag i WidgetFlagMacUseAccentsMenu + FlMultilineInput -> return () + FlSecretInput -> clearFlag i WidgetFlagMacUseAccentsMenu + FlHiddenInput -> return () + ) + itMaybe + setFlag i WidgetFlagCopiedLabel + setFlag i WidgetFlagCopiedTooltip + return i {# fun Fl_Input_New as inputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Input_New_WithLabel as inputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -81,9 +99,14 @@ Just FlIntInput -> maybe intInputNew' (\l -> (\x y w h -> intInputNewWithLabel' x y w h l)) l' Just FlMultilineInput -> maybe multilineInputNew' (\l -> (\x y w h -> multilineInputNewWithLabel' x y w h l)) l' Just FlSecretInput -> maybe secretInputNew' (\l -> (\x y w h -> secretInputNewWithLabel' x y w h l)) l' + Just FlHiddenInput -> maybe inputNew' (\l -> (\x y w h -> inputNewWithLabel' x y w h l)) l' Nothing -> inputNew' - in - constructor x_pos y_pos width height >>= toRef + in do + i <- constructor x_pos y_pos width height >>= toRef + case flInputType of { Just FlHiddenInput -> setInputType i FlHiddenInput; _ -> return () } + setFlag i WidgetFlagCopiedLabel + setFlag i WidgetFlagCopiedTooltip + return i {# fun Fl_Input_Destroy as inputDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Input orig impl where @@ -105,31 +128,21 @@ ) >>= return . successOrUnknownEvent -{# fun Fl_Widget_set_type as setType' { id `Ptr ()',`Word8' } -> `()' supressWarningAboutRes #} -instance (impl ~ (FlInputType -> IO ())) => Op (SetType ()) Input orig impl where - runOp _ _ widget t = withRef widget $ \widgetPtr -> setType' widgetPtr (fromInteger $ toInteger $ fromEnum t) - {# fun Fl_Input_set_value as setValue' { id `Ptr ()', unsafeToCString `T.Text' } -> `Int' #} -{# fun Fl_Input_set_value_with_length as setValueWithLength' { id `Ptr ()', unsafeToCString `T.Text',`Int' } -> `Int' #} -instance (impl ~ (T.Text -> Maybe Int -> IO (Int))) => Op (SetValue ()) Input orig impl where - runOp _ _ input text l' = - case l' of - Nothing -> withRef input $ \inputPtr -> setValue' inputPtr text - Just l -> withRef input $ \inputPtr -> setValueWithLength' inputPtr text l +instance (impl ~ (T.Text -> IO (Either NoChange ()))) => Op (SetValue ()) Input orig impl where + runOp _ _ input text = withRef input $ \inputPtr -> setValue' inputPtr text >>= return . successOrNoChange + {# fun Fl_Input_static_value as staticValue' { id `Ptr ()', unsafeToCString `T.Text' } -> `Int' #} -{# fun Fl_Input_static_value_with_length as staticValueWithLength' { id `Ptr ()', unsafeToCString `T.Text',`Int' } -> `Int' #} -instance (impl ~ (T.Text -> Maybe Int -> IO (Either NoChange ()))) => Op (StaticValue ()) Input orig impl where - runOp _ _ input text l'= do - status' <- case l' of - Nothing -> withRef input $ \inputPtr -> staticValue' inputPtr text - Just l -> withRef input $ \inputPtr -> staticValueWithLength' inputPtr text l +instance (impl ~ (T.Text -> IO (Either NoChange ()))) => Op (StaticValue ()) Input orig impl where + runOp _ _ input text = do + status' <- withRef input $ \inputPtr -> staticValue' inputPtr text return $ successOrNoChange status' {# fun Fl_Input_value as value' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} instance (impl ~ ( IO T.Text)) => Op (GetValue ()) Input orig impl where runOp _ _ input = withRef input $ \inputPtr -> value' inputPtr {# fun Fl_Input_index as index' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (Int -> IO (Char))) => Op (Index ()) Input orig impl where - runOp _ _ input i = withRef input $ \inputPtr -> index' inputPtr i >>= return . toEnum +instance (impl ~ (AtIndex -> IO (Char))) => Op (Index ()) Input orig impl where + runOp _ _ input (AtIndex i) = withRef input $ \inputPtr -> index' inputPtr i >>= return . toEnum {# fun Fl_Input_set_size as setSize' { id `Ptr ()',`Int',`Int' } -> `()' #} instance (impl ~ (Size -> IO ())) => Op (SetSize ()) Input orig impl where runOp _ _ input (Size (Width w') (Height h')) = withRef input $ \inputPtr -> setSize' inputPtr w' h' @@ -160,8 +173,8 @@ instance (impl ~ (Int -> IO (Either NoChange ()))) => Op (SetMark ()) Input orig impl where runOp _ _ input m = withRef input $ \inputPtr -> setMark' inputPtr m >>= return . successOrNoChange {# fun Fl_Input_replace as replace' { id `Ptr ()',`Int',`Int', unsafeToCString `T.Text' } -> `Int' #} -instance (impl ~ (Int -> Int -> T.Text -> IO (Either NoChange ()))) => Op (Replace ()) Input orig impl where - runOp _ _ input b e text = withRef input $ \inputPtr -> replace' inputPtr b e text >>= return . successOrNoChange +instance (impl ~ (IndexRange -> T.Text -> IO (Either NoChange ()))) => Op (Replace ()) Input orig impl where + runOp _ _ input (IndexRange (AtIndex b) (AtIndex e)) text = withRef input $ \inputPtr -> replace' inputPtr b e text >>= return . successOrNoChange {# fun Fl_Input_cut as cut' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Either NoChange ()))) => Op (Cut ()) Input orig impl where runOp _ _ input = withRef input $ \inputPtr -> cut' inputPtr >>= return . successOrNoChange @@ -169,8 +182,8 @@ instance (impl ~ (Int -> IO (Either NoChange ()))) => Op (CutFromCursor ()) Input orig impl where runOp _ _ input n = withRef input $ \inputPtr -> cutBytes' inputPtr n >>= return . successOrNoChange {# fun Fl_Input_cut_range as cutRange' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance (impl ~ (Int -> Int -> IO (Either NoChange ()))) => Op (CutRange ()) Input orig impl where - runOp _ _ input a b = withRef input $ \inputPtr -> cutRange' inputPtr a b >>= return . successOrNoChange +instance (impl ~ (IndexRange -> IO (Either NoChange ()))) => Op (CutRange ()) Input orig impl where + runOp _ _ input (IndexRange (AtIndex a) (AtIndex b)) = withRef input $ \inputPtr -> cutRange' inputPtr a b >>= return . successOrNoChange {# fun Fl_Input_insert as insert' { id `Ptr ()', unsafeToCString `T.Text' } -> `Int' #} instance (impl ~ (T.Text -> IO (Either NoChange ()))) => Op (Insert ()) Input orig impl where runOp _ _ input t = withRef input $ \inputPtr -> insert' inputPtr t >>= return . successOrNoChange @@ -227,11 +240,11 @@ {# fun Fl_Input_set_input_type as setInputType' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ (FlInputType -> IO ())) => Op (SetInputType ()) Input orig impl where runOp _ _ input t = withRef input $ \inputPtr -> setInputType' inputPtr (fromIntegral (fromEnum t)) -{# fun Fl_Input_readonly as readonly' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetReadonly ()) Input orig impl where +{# fun Fl_Input_readonly as readonly' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (GetReadonly ()) Input orig impl where runOp _ _ input = withRef input $ \inputPtr -> readonly' inputPtr -{# fun Fl_Input_set_readonly as setReadonly' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetReadonly ()) Input orig impl where +{# fun Fl_Input_set_readonly as setReadonly' { id `Ptr ()',cFromBool `Bool' } -> `()' #} +instance (impl ~ (Bool -> IO ())) => Op (SetReadonly ()) Input orig impl where runOp _ _ input b = withRef input $ \inputPtr -> setReadonly' inputPtr b {# fun Fl_Input_wrap as wrap' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Bool))) => Op (GetWrap ()) Input orig impl where @@ -277,6 +290,11 @@ instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Input orig impl where runOp _ _ input = withRef input $ \inputPtr -> showSuper' inputPtr +{# fun Fl_Input_drawtext as drawtext' { id `Ptr ()', `Int', `Int', `Int', `Int' } -> `()' supressWarningAboutRes #} +instance (impl ~ (Rectangle -> IO ())) => Op (DrawText ()) Input orig impl where + runOp _ _ input rectangle = withRef input (\inputPtr -> do + let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle + drawtext' inputPtr x_pos y_pos w_pos h_pos) -- $Input -- @ @@ -288,7 +306,7 @@ -- -- cutFromCursor :: 'Ref' 'Input' -> 'Int' -> 'IO' ('Either' 'NoChange' ()) -- --- cutRange :: 'Ref' 'Input' -> 'Int' -> 'Int' -> 'IO' ('Either' 'NoChange' ()) +-- cutRange :: 'Ref' 'Input' -> 'IndexRange' -> 'IO' ('Either' 'NoChange' ()) -- -- destroy :: 'Ref' 'Input' -> 'IO' () -- @@ -296,6 +314,8 @@ -- -- drawSuper :: 'Ref' 'Input' -> 'IO' () -- +-- drawText :: 'Ref' 'Input' -> 'Rectangle' -> 'IO' () +-- -- getCursorColor :: 'Ref' 'Input' -> 'IO' ('Color') -- -- getInputType :: 'Ref' 'Input' -> 'IO' ('FlInputType') @@ -306,7 +326,7 @@ -- -- getPosition :: 'Ref' 'Input' -> 'IO' ('Int') -- --- getReadonly :: 'Ref' 'Input' -> 'IO' ('Int') +-- getReadonly :: 'Ref' 'Input' -> 'IO' ('Bool') -- -- getShortcut :: 'Ref' 'Input' -> 'IO' ('Maybe' 'ShortcutKeySequence') -- @@ -332,13 +352,13 @@ -- -- hideSuper :: 'Ref' 'Input' -> 'IO' () -- --- index :: 'Ref' 'Input' -> 'Int' -> 'IO' ('Char') +-- index :: 'Ref' 'Input' -> 'AtIndex' -> 'IO' ('Char') -- -- insert :: 'Ref' 'Input' -> 'T.Text' -> 'IO' ('Either' 'NoChange' ()) -- -- insertWithLength :: 'Ref' 'Input' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'NoChange' ()) -- --- replace :: 'Ref' 'Input' -> 'Int' -> 'Int' -> 'T.Text' -> 'IO' ('Either' 'NoChange' ()) +-- replace :: 'Ref' 'Input' -> 'IndexRange' -> 'T.Text' -> 'IO' ('Either' 'NoChange' ()) -- -- resize :: 'Ref' 'Input' -> 'Rectangle' -> 'IO' () -- @@ -354,7 +374,7 @@ -- -- setPosition :: 'Ref' 'Input' -> 'Int' -> 'Maybe' 'Int' -> 'IO' ('Either' 'NoChange' ()) -- --- setReadonly :: 'Ref' 'Input' -> 'Int' -> 'IO' () +-- setReadonly :: 'Ref' 'Input' -> 'Bool' -> 'IO' () -- -- setShortcut :: 'Ref' 'Input' -> 'ShortcutKeySequence' -> 'IO' () -- @@ -368,9 +388,7 @@ -- -- setTextsize :: 'Ref' 'Input' -> 'FontSize' -> 'IO' () -- --- setType :: 'Ref' 'Input' -> 'FlInputType' -> 'IO' () --- --- setValue :: 'Ref' 'Input' -> 'T.Text' -> 'Maybe' 'Int' -> 'IO' ('Int') +-- setValue :: 'Ref' 'Input' -> 'T.Text' -> 'IO' ('Either' 'NoChange' ()) -- -- setWrap :: 'Ref' 'Input' -> 'Bool' -> 'IO' () -- @@ -378,7 +396,7 @@ -- -- showWidgetSuper :: 'Ref' 'Input' -> 'IO' () -- --- staticValue :: 'Ref' 'Input' -> 'T.Text' -> 'Maybe' 'Int' -> 'IO' ('Either' 'NoChange' ()) +-- staticValue :: 'Ref' 'Input' -> 'T.Text' -> 'IO' ('Either' 'NoChange' ()) -- -- undo :: 'Ref' 'Input' -> 'IO' ('Either' 'NoChange' ()) -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/IntInput.chs b/src/Graphics/UI/FLTK/LowLevel/IntInput.chs deleted file mode 100644 --- a/src/Graphics/UI/FLTK/LowLevel/IntInput.chs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Graphics.UI.FLTK.LowLevel.IntInput - ( - intInputNew - -- * Hierarchy - -- - -- $hierarchy - ) -where -#include "Fl_ExportMacros.h" -#include "Fl_Types.h" -#include "Fl_Int_InputC.h" -import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) -import Graphics.UI.FLTK.LowLevel.Fl_Types -import Graphics.UI.FLTK.LowLevel.Utils -import Graphics.UI.FLTK.LowLevel.Hierarchy -import qualified Data.Text as T -{# fun Fl_Int_Input_New as intInputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Int_Input_New_WithLabel as intInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} -intInputNew :: Rectangle -> Maybe T.Text -> IO (Ref IntInput) -intInputNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> intInputNew' x_pos y_pos width height >>= - toRef - Just l -> intInputNewWithLabel' x_pos y_pos width height l >>= - toRef - --- $hierarchy --- @ --- "Graphics.UI.FLTK.LowLevel.Widget" --- | --- v --- "Graphics.UI.FLTK.LowLevel.Input" --- | --- v --- "Graphics.UI.FLTK.LowLevel.IntInput" --- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/LightButton.chs b/src/Graphics/UI/FLTK/LowLevel/LightButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/LightButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/LightButton.chs @@ -46,10 +46,13 @@ {# fun Fl_Light_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} lightButtonNew :: Rectangle -> Maybe T.Text -> IO (Ref LightButton) lightButtonNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Light_Button_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) LightButton orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/LineDial.chs b/src/Graphics/UI/FLTK/LowLevel/LineDial.chs --- a/src/Graphics/UI/FLTK/LowLevel/LineDial.chs +++ b/src/Graphics/UI/FLTK/LowLevel/LineDial.chs @@ -14,6 +14,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Line_Dial_New as lineDialNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Line_Dial_New_WithLabel as lineDialNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -21,10 +22,12 @@ lineDialNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle in case l' of - Nothing -> lineDialNew' x_pos y_pos width height >>= - toRef - Just l -> lineDialNewWithLabel' x_pos y_pos width height l >>= - toRef + Nothing -> lineDialNew' x_pos y_pos width height >>= toRef + Just l -> do + ref <- lineDialNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/MenuBar.chs b/src/Graphics/UI/FLTK/LowLevel/MenuBar.chs --- a/src/Graphics/UI/FLTK/LowLevel/MenuBar.chs +++ b/src/Graphics/UI/FLTK/LowLevel/MenuBar.chs @@ -47,12 +47,13 @@ {# fun Fl_Menu_Bar_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} menuBarNew :: Rectangle -> Maybe T.Text -> IO (Ref MenuBar) menuBarNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= - toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Menu_Bar_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) MenuBar orig impl where @@ -98,7 +99,6 @@ -- $functions -- -- @ --- -- destroy :: 'Ref' 'MenuBar' -> 'IO' () -- -- draw :: 'Ref' 'MenuBar' -> 'IO' () diff --git a/src/Graphics/UI/FLTK/LowLevel/MenuButton.chs b/src/Graphics/UI/FLTK/LowLevel/MenuButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/MenuButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/MenuButton.chs @@ -62,12 +62,13 @@ {# fun Fl_Menu_Button_New_WithLabel as menuButtonNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} menuButtonNew :: Rectangle -> Maybe T.Text -> IO (Ref MenuButton) menuButtonNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> menuButtonNew' x_pos y_pos width height >>= - toRef - Just l -> menuButtonNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Menu_Button_Destroy as menuButtonDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (Destroy ()) MenuButton orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/MenuItem.chs b/src/Graphics/UI/FLTK/LowLevel/MenuItem.chs --- a/src/Graphics/UI/FLTK/LowLevel/MenuItem.chs +++ b/src/Graphics/UI/FLTK/LowLevel/MenuItem.chs @@ -3,12 +3,13 @@ module Graphics.UI.FLTK.LowLevel.MenuItem ( menuItemNew, + menuItemCustom, addMenuItem, - MenuItemIndex(..), MenuItemName(..), MenuItemPointer(..), MenuItemReference(..), - MenuItemLocator(..) + MenuItemLocator(..), + toMenuItemDrawF -- * Hierarchy -- -- $hierarchy @@ -30,16 +31,33 @@ import Graphics.UI.FLTK.LowLevel.Dispatch import qualified Data.Text as T -newtype MenuItemIndex = MenuItemIndex Int data MenuItemPointer = forall a. (Parent a MenuItem) => MenuItemPointer (Ref a) newtype MenuItemName = MenuItemName T.Text -data MenuItemReference = MenuItemByIndex MenuItemIndex | MenuItemByPointer MenuItemPointer +data MenuItemReference = MenuItemByIndex AtIndex | MenuItemByPointer MenuItemPointer data MenuItemLocator = MenuItemPointerLocator MenuItemPointer | MenuItemNameLocator MenuItemName +toMenuItemDrawF :: + (Parent a MenuItem) => (Ref a -> Rectangle -> Maybe (Ref MenuPrim) -> Bool -> IO ()) -> + IO (FunPtr MenuItemDrawF) +toMenuItemDrawF f = + mkMenuItemDrawFPtr (\menuItemPtr x' y' w' h' menuPtr selected -> do + pp <- wrapNonNull menuItemPtr "Null pointer : toMenuItemDrawFPrim" + maybeMenu <- toMaybeRef menuPtr + let rectangle = toRectangle (fromIntegral x',fromIntegral y',fromIntegral w',fromIntegral h') + f (castTo (wrapInRef pp)) rectangle maybeMenu (cToBool selected) + ) + {# fun Fl_Menu_Item_New as new' { } -> `Ptr ()' id #} menuItemNew :: IO (Ref MenuItem) menuItemNew = new' >>= toRef +{# fun Fl_Menu_Item_New_With_Draw as newWithDraw' { id `FunPtr MenuItemDrawF' } -> `Ptr ()' id #} +menuItemCustom :: (Parent a MenuItem) => (Ref a -> Rectangle -> Maybe (Ref MenuPrim) -> Bool -> IO ()) -> IO (Ref MenuItem) +menuItemCustom drawF = do + fPtr <- toMenuItemDrawF drawF + p <- newWithDraw' fPtr + toRef p + {# fun Fl_Menu_Item_Destroy as destroy' { id `Ptr ()' } -> `()' id #} instance (impl ~ IO ()) => Op (Destroy ()) MenuItem orig impl where runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> destroy' menu_itemPtr @@ -176,11 +194,11 @@ instance (Parent a MenuPrim, impl ~ (Ref a -> IO (Size))) => Op (Measure ()) MenuItem orig impl where runOp _ _ menu_item menu' = withRef menu_item $ \menu_itemPtr -> withRef menu' $ \menuPtr -> measure' menu_itemPtr menuPtr >>= \(h', w') -> return (Size (Width w') (Height h')) -{# fun Fl_Menu_Item_draw_with_t as drawWithT' { id `Ptr ()',`Int',`Int',`Int',`Int',id `Ptr ()',`Int' } -> `()' #} -instance (Parent a MenuPrim, impl ~ (Rectangle -> Ref a -> Int -> IO ())) => Op (DrawWithT ()) MenuItem orig impl where - runOp _ _ menu_item rectangle menu' t = +{# fun Fl_Menu_Item_draw_with_t as drawWithT' { id `Ptr ()',`Int',`Int',`Int',`Int',id `Ptr ()',cFromBool `Bool' } -> `()' #} +instance (Parent a MenuPrim, impl ~ (Rectangle -> Ref a -> Bool -> IO ())) => Op (DrawWithT ()) MenuItem orig impl where + runOp _ _ menu_item rectangle menu' selected = let (x_pos', y_pos', width', height') = fromRectangle rectangle in - withRef menu_item $ \menu_itemPtr -> withRef menu' $ \menuPtr -> drawWithT' menu_itemPtr x_pos' y_pos' width' height' menuPtr t + withRef menu_item $ \menu_itemPtr -> withRef menu' $ \menuPtr -> drawWithT' menu_itemPtr x_pos' y_pos' width' height' menuPtr selected {# fun Fl_Menu_Item_draw as draw' { id `Ptr ()',`Int',`Int',`Int',`Int',id `Ptr ()' } -> `()' #} instance (Parent a MenuPrim, impl ~ (Rectangle -> Ref a -> IO ())) => Op (Draw ()) MenuItem orig impl where @@ -227,10 +245,10 @@ runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> testShortcut' menu_itemPtr >>= toMaybeRef {# fun Fl_Menu_Item_find_shortcut_with_ip_require_alt as findShortcutWithIpRequireAlt' { id `Ptr ()',id `Ptr CInt',`Bool' } -> `Ptr ()' id #} -instance (Parent a MenuItem, impl ~ (Maybe Int -> Bool -> IO (Maybe (Ref a)))) => Op (FindShortcut ()) MenuItem orig impl where +instance (Parent a MenuItem, impl ~ (Maybe AtIndex -> Bool -> IO (Maybe (Ref a)))) => Op (FindShortcut ()) MenuItem orig impl where runOp _ _ menu_item index' require_alt = withRef menu_item $ \menu_itemPtr -> - maybeNew (new . fromIntegral) index' >>= \index_Ptr -> + maybeNew (new . fromIntegral) (fmap (\(AtIndex i) -> i) index') >>= \index_Ptr -> findShortcutWithIpRequireAlt' menu_itemPtr index_Ptr require_alt >>= toMaybeRef {# fun Fl_Menu_Item_do_callback as doCallback' { id `Ptr ()',id `Ptr ()' } -> `()' #} @@ -246,14 +264,14 @@ MenuItemFlags -> (Ptr () -> T.Text -> CInt -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) -> (Ptr () -> T.Text -> T.Text -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) -> - IO (MenuItemIndex) + IO (AtIndex) addMenuItem refMenuOrMenuItem name shortcut cb flags addWithFlags addWithShortcutnameFlags = either (\menu -> withRef menu (go "Menu_.add: Shortcut format string cannot be empty" )) (\menuItem -> withRef menuItem (go "MenuItem.add: Shortcut format string cannot be empty")) refMenuOrMenuItem where - go :: String -> Ptr () -> IO MenuItemIndex + go :: String -> Ptr () -> IO AtIndex go errorMsg menu_Ptr = do let combinedFlags = menuItemFlagsToInt flags ptr <- maybe (return (castPtrToFunPtr nullPtr)) toCallbackPrim cb @@ -282,17 +300,17 @@ 0 (castFunPtr ptr) combinedFlags - return (MenuItemIndex idx') + return (AtIndex idx') {# fun Fl_Menu_Item_insert_with_flags as insertWithFlags' { id `Ptr ()',`Int', unsafeToCString `T.Text',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Menu_Item_add_with_flags as addWithFlags' { id `Ptr ()', unsafeToCString `T.Text',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Menu_Item_add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `T.Text', unsafeToCString `T.Text',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} -instance (Parent a MenuItem, impl ~ (T.Text -> Maybe Shortcut -> Maybe (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) MenuItem orig impl where +instance (Parent a MenuItem, impl ~ (T.Text -> Maybe Shortcut -> Maybe (Ref a -> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Add ()) MenuItem orig impl where runOp _ _ menu_item name shortcut cb flags = addMenuItem (Right menu_item) name shortcut cb flags addWithFlags' addWithShortcutnameFlags' -instance (Parent a MenuItem, impl ~ (Int -> T.Text -> Maybe ShortcutKeySequence -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) MenuItem orig impl where - runOp _ _ menu_item index' name ks cb flags = +instance (Parent a MenuItem, impl ~ (AtIndex -> T.Text -> Maybe ShortcutKeySequence -> (Ref a -> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Insert ()) MenuItem orig impl where + runOp _ _ menu_item (AtIndex index') name ks cb flags = withRef menu_item $ \menu_itemPtr -> let combinedFlags = menuItemFlagsToInt flags shortcutCode = maybe 0 (\(ShortcutKeySequence modifiers char) -> keySequenceToCInt modifiers char ) ks @@ -305,7 +323,7 @@ shortcutCode (castFunPtr ptr) combinedFlags - return (MenuItemIndex idx') + return (AtIndex idx') {# fun Fl_Menu_Item_size as size' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (GetSize ()) MenuItem orig impl where @@ -324,7 +342,7 @@ -- -- activevisible :: 'Ref' 'MenuItem' -> 'IO' ('Bool') -- --- add:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex') +-- add:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex') -- -- checkbox :: 'Ref' 'MenuItem' -> 'IO' ('Bool') -- @@ -338,9 +356,9 @@ -- -- draw:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuItem' -> 'Rectangle' -> 'Ref' a -> 'IO' () -- --- drawWithT:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuItem' -> 'Rectangle' -> 'Ref' a -> 'Int' -> 'IO' () +-- drawWithT:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuItem' -> 'Rectangle' -> 'Ref' a -> 'Bool' -> 'IO' () -- --- findShortcut:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'Maybe' 'Int' -> 'Bool' -> 'IO' ('Maybe' ('Ref' a)) +-- findShortcut:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'Maybe' 'AtIndex' -> 'Bool' -> 'IO' ('Maybe' ('Ref' a)) -- -- getFirst :: 'Ref' 'MenuItem' -> 'IO' ('Maybe' ('Ref' 'MenuItem')) -- @@ -366,7 +384,7 @@ -- -- hide :: 'Ref' 'MenuItem' -> 'IO' () -- --- insert:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'Int' -> 'T.Text' -> 'Maybe' 'ShortcutKeySequence' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex') +-- insert:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'AtIndex' -> 'T.Text' -> 'Maybe' 'ShortcutKeySequence' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex') -- -- measure:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuItem' -> 'Ref' a -> 'IO' ('Size') -- @@ -409,5 +427,4 @@ -- testShortcut:: ('Parent' a 'MenuItem') => 'Ref' 'MenuItem' -> 'IO' ('Maybe' ('Ref' a)) -- -- visible :: 'Ref' 'MenuItem' -> 'IO' ('Bool') --- -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/MenuPrim.chs b/src/Graphics/UI/FLTK/LowLevel/MenuPrim.chs --- a/src/Graphics/UI/FLTK/LowLevel/MenuPrim.chs +++ b/src/Graphics/UI/FLTK/LowLevel/MenuPrim.chs @@ -29,6 +29,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.MenuItem import qualified Data.ByteString.Char8 as C +import Control.Exception {# fun Fl_Menu__New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Menu__New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -46,12 +47,13 @@ menu_New :: Rectangle -> Maybe T.Text -> IO (Ref MenuPrim) menu_New rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= - toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Menu__Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} @@ -167,7 +169,7 @@ MenuItemFlags -> (Ptr () -> Int -> T.Text -> CInt -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) -> (Ptr () -> Int -> T.Text -> T.Text -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) -> - IO (MenuItemIndex) + IO (AtIndex) insertMenuItem menu_ index' name shortcut cb flags insertWithFlags'' insertWithShortcutnameFlags'' = withRef menu_ $ \menu_Ptr -> do let combinedFlags = menuItemFlagsToInt flags @@ -200,73 +202,85 @@ 0 (castFunPtr ptr) combinedFlags - return (MenuItemIndex idx') + return (AtIndex idx') {# fun Fl_Menu__insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',unsafeToCString `T.Text',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Menu__insert_with_shortcutname_flags as insertWithShortcutnameFlags' { id `Ptr ()',`Int',unsafeToCString `T.Text', unsafeToCString `T.Text',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} -instance (Parent a MenuPrim, impl ~ ( Int -> T.Text -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) MenuPrim orig impl where - runOp _ _ menu_ index' name shortcut cb flags = insertMenuItem menu_ index' name shortcut cb flags insertWithFlags' insertWithShortcutnameFlags' +instance (Parent a MenuPrim, impl ~ ( AtIndex -> T.Text -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Insert ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex index') name shortcut cb flags = + insertMenuItem menu_ index' name shortcut cb flags insertWithFlags' insertWithShortcutnameFlags' {# fun Fl_Menu__add_with_name as add' { id `Ptr ()',unsafeToCString `T.Text'} -> `()' #} instance (impl ~ (T.Text -> IO ())) => Op (AddName ()) MenuPrim orig impl where runOp _ _ menu_ name' = withRef menu_ $ \menu_Ptr -> add' menu_Ptr name' {# fun Fl_Menu__add_with_flags as addWithFlags' { id `Ptr ()',unsafeToCString `T.Text',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} {# fun Fl_Menu__add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `T.Text', unsafeToCString `T.Text',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} -instance (Parent a MenuItem, impl ~ ( T.Text -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) MenuPrim orig (impl) where +instance (Parent a MenuItem, impl ~ ( T.Text -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Add ()) MenuPrim orig (impl) where runOp _ _ menu_ name shortcut cb flags = addMenuItem (Left menu_) name shortcut cb flags addWithFlags' addWithShortcutnameFlags' +instance (Parent a MenuItem, impl ~ ( T.Text -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (Ref MenuItem))) => Op (AddAndGetMenuItem ()) MenuPrim orig (impl) where + runOp _ _ menu_ name shortcut cb flags = do + (AtIndex i) <- add menu_ name shortcut cb flags + items <- getMenu menu_ + let mi = items !! i + case mi of + Just mi' -> return mi' + Nothing -> throwIO (userError ("FLTK claims the menu item " ++ (T.unpack name) ++ " was added successfully at index " ++ (show i) ++ " , but no MenuItem at that index could be retrieved.")) + {# fun Fl_Menu__size as size' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (GetSize ()) MenuPrim orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> size' menu_Ptr {# fun Fl_Menu__set_size as setSize' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ (Int -> Int -> IO ())) => Op (SetSize ()) MenuPrim orig impl where - runOp _ _ menu_ w h = withRef menu_ $ \menu_Ptr -> setSize' menu_Ptr w h +instance (impl ~ (Size -> IO ())) => Op (SetSize ()) MenuPrim orig impl where + runOp _ _ menu_ (Size (Width w) (Height h)) = withRef menu_ $ \menu_Ptr -> setSize' menu_Ptr w h {# fun Fl_Menu__clear as clear' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Clear ()) MenuPrim orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> clear' menu_Ptr {# fun Fl_Menu__clear_submenu as clearSubmenu' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (Int -> IO (Either OutOfRange ()))) => Op (ClearSubmenu ()) MenuPrim orig impl where - runOp _ _ menu_ index' = withRef menu_ $ \menu_Ptr -> clearSubmenu' menu_Ptr index' >>= \ret' -> if ret' == -1 then return (Left OutOfRange) else return (Right ()) +instance (impl ~ (AtIndex -> IO (Either OutOfRange ()))) => Op (ClearSubmenu ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex index') = withRef menu_ $ \menu_Ptr -> clearSubmenu' menu_Ptr index' >>= \ret' -> if ret' == -1 then return (Left OutOfRange) else return (Right ()) {# fun Fl_Menu__replace as replace' { id `Ptr ()',`Int', unsafeToCString `T.Text' } -> `()' #} -instance (impl ~ (Int -> T.Text -> IO ())) => Op (Replace ()) MenuPrim orig impl where - runOp _ _ menu_ index' name = withRef menu_ $ \menu_Ptr -> replace' menu_Ptr index' name +instance (impl ~ (AtIndex -> T.Text -> IO ())) => Op (Replace ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex index') name = withRef menu_ $ \menu_Ptr -> replace' menu_Ptr index' name {# fun Fl_Menu__remove as remove' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (Remove ()) MenuPrim orig impl where - runOp _ _ menu_ index' = withRef menu_ $ \menu_Ptr -> remove' menu_Ptr index' +instance (impl ~ (AtIndex -> IO ())) => Op (Remove ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex index') = withRef menu_ $ \menu_Ptr -> remove' menu_Ptr index' {# fun Fl_Menu__shortcut as shortcut' { id `Ptr ()',`Int',id `CInt' } -> `()' #} -instance (impl ~ (Int -> ShortcutKeySequence -> IO ())) => Op (SetShortcut ()) MenuPrim orig impl where - runOp _ _ menu_ index' (ShortcutKeySequence modifiers char) = +instance (impl ~ (AtIndex -> ShortcutKeySequence -> IO ())) => Op (SetShortcut ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex index') (ShortcutKeySequence modifiers char) = withRef menu_ $ \menu_Ptr -> shortcut' menu_Ptr index' (keySequenceToCInt modifiers char) {# fun Fl_Menu__set_mode as setMode' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ (Int -> MenuItemFlags -> IO ())) => Op (SetMode ()) MenuPrim orig impl where - runOp _ _ menu_ i fl = withRef menu_ $ \menu_Ptr -> setMode' menu_Ptr i (menuItemFlagsToInt fl) +instance (impl ~ (AtIndex -> MenuItemFlags -> IO ())) => Op (SetMode ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex i) fl = withRef menu_ $ \menu_Ptr -> setMode' menu_Ptr i (menuItemFlagsToInt fl) {# fun Fl_Menu__mode as mode' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (Int -> IO (Maybe MenuItemFlags))) => Op (GetMode ()) MenuPrim orig impl where - runOp _ _ menu_ i = withRef menu_ $ \menu_Ptr -> mode' menu_Ptr i >>= return . intToMenuItemFlags +instance (impl ~ (AtIndex -> IO (Maybe MenuItemFlags))) => Op (GetMode ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex i) = withRef menu_ $ \menu_Ptr -> mode' menu_Ptr i >>= return . intToMenuItemFlags {# fun Fl_Menu__mvalue as mvalue' { id `Ptr ()' } -> `Ptr ()' id #} instance (impl ~ (IO (Maybe (Ref MenuItem)))) => Op (Mvalue ()) MenuPrim orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> mvalue' menu_Ptr >>= toMaybeRef {# fun Fl_Menu__value as value' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (MenuItemIndex))) => Op (GetValue ()) MenuPrim orig impl where - runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> value' menu_Ptr >>= return . MenuItemIndex +instance (impl ~ ( IO (Maybe AtIndex))) => Op (GetValue ()) MenuPrim orig impl where + runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> do + res <- value' menu_Ptr + return (if (res == -1) then Nothing else Just (AtIndex res)) {# fun Fl_Menu__value_with_item as valueWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun Fl_Menu__value_with_index as valueWithIndex' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (MenuItemReference -> IO (Int))) => Op (SetValue ()) MenuPrim orig impl where +instance (impl ~ (MenuItemReference -> IO (Either NoChange ()))) => Op (SetValue ()) MenuPrim orig impl where runOp _ _ menu_ menu_item_reference = withRef menu_ $ \menu_Ptr -> case menu_item_reference of - (MenuItemByIndex (MenuItemIndex index')) -> valueWithIndex' menu_Ptr index' + (MenuItemByIndex (AtIndex index')) -> valueWithIndex' menu_Ptr index' >>= return . successOrNoChange (MenuItemByPointer (MenuItemPointer menu_item)) -> withRef menu_item $ \menu_itemPtr -> - valueWithItem' menu_Ptr menu_itemPtr + valueWithItem' menu_Ptr menu_itemPtr >>= return . successOrNoChange {# fun Fl_Menu__text as text' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} instance (impl ~ ( IO T.Text)) => Op (GetText ()) MenuPrim orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> text' menu_Ptr {# fun Fl_Menu__text_with_index as textWithIndex' { id `Ptr ()',`Int' } -> `T.Text' unsafeFromCString #} -instance (impl ~ (Int -> IO T.Text)) => Op (GetTextWithIndex ()) MenuPrim orig impl where - runOp _ _ menu_ i = withRef menu_ $ \menu_Ptr -> textWithIndex' menu_Ptr i +instance (impl ~ (AtIndex -> IO T.Text)) => Op (GetTextWithIndex ()) MenuPrim orig impl where + runOp _ _ menu_ (AtIndex i) = withRef menu_ $ \menu_Ptr -> textWithIndex' menu_Ptr i {# fun Fl_Menu__textfont as textfont' { id `Ptr ()' } -> `Font' cToFont #} instance (impl ~ ( IO (Font))) => Op (GetTextfont ()) MenuPrim orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> textfont' menu_Ptr @@ -294,27 +308,25 @@ {# fun Fl_Menu__down_color as downColor' { id `Ptr ()' } -> `Color' cToColor #} instance (impl ~ ( IO (Color))) => Op (GetDownColor ()) MenuPrim orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> downColor' menu_Ptr -{# fun Fl_Menu__set_down_color as setDownColor' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetDownColor ()) MenuPrim orig impl where - runOp _ _ menu_ c = withRef menu_ $ \menu_Ptr -> setDownColor' menu_Ptr c -#if FL_API_VERSION == 10304 --- | Only available on FLTK version 1.3.4 and above. +{# fun Fl_Menu__set_down_color as setDownColor' { id `Ptr ()',`CUInt' } -> `()' #} +instance (impl ~ (Color -> IO ())) => Op (SetDownColor ()) MenuPrim orig impl where + runOp _ _ menu_ (Color c) = withRef menu_ $ \menu_Ptr -> setDownColor' menu_Ptr c {# fun Fl_Menu__set_only as setonly' { id `Ptr ()', id `Ptr ()' } -> `()' #} instance (Parent a MenuItem, impl ~ (Ref a -> IO ())) => Op (Setonly ()) MenuPrim orig impl where runOp _ _ menu_ item = withRef menu_ $ \menu_Ptr -> withRef item $ \item_Ptr -> setonly' menu_Ptr item_Ptr -#endif -- $functions -- @ +-- add:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a-> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex') -- --- add:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a-> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex') +-- addAndGetMenuItem:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a-> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('Ref' 'MenuItem') -- -- addName :: 'Ref' 'MenuPrim' -> 'T.Text' -> 'IO' () -- -- clear :: 'Ref' 'MenuPrim' -> 'IO' () -- --- clearSubmenu :: 'Ref' 'MenuPrim' -> 'Int' -> 'IO' ('Either' 'OutOfRange' ()) +-- clearSubmenu :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' ()) -- -- copy:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'Ref' a-> 'IO' () -- @@ -328,13 +340,13 @@ -- -- getMenu :: 'Ref' 'MenuPrim' -> 'IO' [('Maybe' ('Ref' 'MenuItem'])) -- --- getMode :: 'Ref' 'MenuPrim' -> 'Int' -> 'IO' ('Maybe' 'MenuItemFlags') +-- getMode :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'IO' ('Maybe' 'MenuItemFlags') -- -- getSize :: 'Ref' 'MenuPrim' -> 'IO' ('Int') -- -- getText :: 'Ref' 'MenuPrim' -> 'IO' 'T.Text' -- --- getTextWithIndex :: 'Ref' 'MenuPrim' -> 'Int' -> 'IO' 'T.Text' +-- getTextWithIndex :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'IO' 'T.Text' -- -- getTextcolor :: 'Ref' 'MenuPrim' -> 'IO' ('Color') -- @@ -342,7 +354,7 @@ -- -- getTextsize :: 'Ref' 'MenuPrim' -> 'IO' ('FontSize') -- --- getValue :: 'Ref' 'MenuPrim' -> 'IO' ('MenuItemIndex') +-- getValue :: 'Ref' 'MenuPrim' -> 'IO' ('Maybe' 'AtIndex') -- -- global :: 'Ref' 'MenuPrim' -> 'IO' () -- @@ -354,7 +366,7 @@ -- -- hideSuper :: 'Ref' 'MenuPrim' -> 'IO' () -- --- insert:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuPrim' -> 'Int' -> 'T.Text' -> 'Maybe' 'Shortcut' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex') +-- insert:: ('Parent' a 'MenuPrim') => 'Ref' 'MenuPrim' -> 'AtIndex' -> 'T.Text' -> 'Maybe' 'Shortcut' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex') -- -- itemPathname:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'Ref' a -> 'IO' ('Maybe' 'T.Text') -- @@ -364,9 +376,9 @@ -- -- picked:: ('Parent' a 'MenuItem', 'Parent' b 'MenuItem') => 'Ref' 'MenuPrim' -> 'Ref' a -> 'IO' ('Maybe' ('Ref' b)) -- --- remove :: 'Ref' 'MenuPrim' -> 'Int' -> 'IO' () +-- remove :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'IO' () -- --- replace :: 'Ref' 'MenuPrim' -> 'Int' -> 'T.Text' -> 'IO' () +-- replace :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'T.Text' -> 'IO' () -- -- resize :: 'Ref' 'MenuPrim' -> 'Rectangle' -> 'IO' () -- @@ -374,15 +386,15 @@ -- -- setDownBox :: 'Ref' 'MenuPrim' -> 'Boxtype' -> 'IO' () -- --- setDownColor :: 'Ref' 'MenuPrim' -> 'Int' -> 'IO' () +-- setDownColor :: 'Ref' 'MenuPrim' -> 'Color' -> 'IO' () -- -- setMenu:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> ['Ref' a] -> 'IO' () -- --- setMode :: 'Ref' 'MenuPrim' -> 'Int' -> 'MenuItemFlags' -> 'IO' () +-- setMode :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'MenuItemFlags' -> 'IO' () -- --- setShortcut :: 'Ref' 'MenuPrim' -> 'Int' -> 'ShortcutKeySequence' -> 'IO' () +-- setShortcut :: 'Ref' 'MenuPrim' -> 'AtIndex' -> 'ShortcutKeySequence' -> 'IO' () -- --- setSize :: 'Ref' 'MenuPrim' -> 'Int' -> 'Int' -> 'IO' () +-- setSize :: 'Ref' 'MenuPrim' -> 'Size' -> 'IO' () -- -- setTextcolor :: 'Ref' 'MenuPrim' -> 'Color' -> 'IO' () -- @@ -390,17 +402,15 @@ -- -- setTextsize :: 'Ref' 'MenuPrim' -> 'FontSize' -> 'IO' () -- --- setValue :: 'Ref' 'MenuPrim' -> 'MenuItemReference' -> 'IO' ('Int') +-- setValue :: 'Ref' 'MenuPrim' -> 'MenuItemReference' -> 'IO' ('Either' 'NoChange' ()) -- +-- setonly:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'Ref' a -> 'IO' () +-- -- showWidget :: 'Ref' 'MenuPrim' -> 'IO' () -- -- showWidgetSuper :: 'Ref' 'MenuPrim' -> 'IO' () -- -- testShortcut:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'IO' ('Maybe' ('Ref' a)) --- --- Available in FLTK 1.3.4 only: --- setonly:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'Ref' a -> 'IO' () --- -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs b/src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/FLTK/LowLevel/MultiLabel.chs @@ -0,0 +1,139 @@ +{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, CPP, UndecidableInstances, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Graphics.UI.FLTK.LowLevel.MultiLabel + ( + multiLabelNew, + MultiLabelContent(..), + getMultiLabelContents, + setMultiLabelContents + -- * Functions + -- + -- $functions + + ) +where +#include "Fl_ExportMacros.h" +#include "Fl_Types.h" +#include "Fl_Multi_LabelC.h" +import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Utils +import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Dispatch +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +import qualified Data.Text as T + +{# fun Fl_Multi_Label_New as multiLabelNew' { id `Ptr CChar', id `Ptr CChar', cFromEnum `Labeltype', cFromEnum `Labeltype'} -> `Ptr ()' id #} +{# fun Fl_Multi_Label_labela as labela' { `Ptr ()' } -> `Ptr CChar' id #} +{# fun Fl_Multi_Label_set_labela as setLabela' { `Ptr ()' , id `Ptr CChar' } -> `()' #} +{# fun Fl_Multi_Label_labelb as labelb' { `Ptr ()' } -> `Ptr CChar' id #} +{# fun Fl_Multi_Label_set_labelb as setLabelb' { `Ptr ()' , id `Ptr CChar' } -> `()' #} +{# fun Fl_Multi_Label_typea as typea' { `Ptr ()' } -> `Labeltype' cToEnum #} +{# fun Fl_Multi_Label_set_typea as setTypea' { `Ptr ()' , cFromEnum `Labeltype' } -> `()' #} +{# fun Fl_Multi_Label_typeb as typeb' { `Ptr ()' } -> `Labeltype' cToEnum #} +{# fun Fl_Multi_Label_set_typeb as setTypeb' { `Ptr ()' , cFromEnum `Labeltype' } -> `()' #} +{# fun Fl_Multi_Label_label_widget as setWidgetLabel' { `Ptr ()' , `Ptr ()' } -> `()' #} +{# fun Fl_Multi_Label_label_menu_item as setMenuItemLabel' { `Ptr ()' , `Ptr ()' } -> `()' #} + +data MultiLabelContent + = MultiLabelContentText (Labeltype, T.Text) + | forall a.(Parent a Image) => MultiLabelContentImage (Ref a) + +toLabelTypePtr :: MultiLabelContent -> IO (Labeltype, Ptr CChar) +toLabelTypePtr mlc = + case mlc of + MultiLabelContentText (lt, t) -> do + t' <- copyTextToCString t + return (lt, t') + MultiLabelContentImage i -> do + i' <- unsafeRefToPtr i + return (ImageLabelType, (castPtr i')) + +getMultiLabelContents :: Ref MultiLabel -> IO [MultiLabelContent] +getMultiLabelContents ml = + withRef ml $ \mlPtr -> extractMultiLabels [] mlPtr + where + extractMultiLabels :: [MultiLabelContent] -> Ptr () -> IO [MultiLabelContent] + extractMultiLabels accum mlPtr = do + tA <- typea' mlPtr + tB <- typeb' mlPtr + case (tA, tB) of + (NoLabelType, NoLabelType) -> return [] + (ImageLabelType,_) -> do + (i :: Ref Image) <- labela' mlPtr >>= toRef . castPtr + let soFar = accum ++ [(MultiLabelContentImage i)] + rest <- labelb' mlPtr + extractMultiLabels soFar (castPtr rest) + (lt,_) -> do + t <- labela' mlPtr >>= cStringToText + let soFar = accum ++ [(MultiLabelContentText (lt, t))] + rest <- labelb' mlPtr + extractMultiLabels soFar (castPtr rest) + +multiLabelNew :: [MultiLabelContent] -> IO (Ref MultiLabel) +multiLabelNew mlcs = + chainMultiLabels mlcs >>= toRef + where + chainMultiLabels :: [MultiLabelContent] -> IO (Ptr ()) + chainMultiLabels [] = multiLabelNew' (castPtr nullPtr) (castPtr nullPtr) NoLabelType NoLabelType + chainMultiLabels (mlc:mlcs) = do + (lt,ptr) <- toLabelTypePtr mlc + mls <- chainMultiLabels mlcs + multiLabelNew' ptr (castPtr mls) lt MultiLabelType + +setMultiLabelContents :: Ref MultiLabel -> [MultiLabelContent] -> IO () +setMultiLabelContents ml mlcs = do + currMlcs <- getMultiLabelContents ml + withRef ml $ \mlPtr -> do + freeTextLabels mlPtr currMlcs + insertNewContents mlPtr mlcs + where + freeTextLabels :: Ptr () -> [MultiLabelContent] -> IO () + freeTextLabels mlPtr [] = return () + freeTextLabels mlPtr (mlc:mlcs)= + case mlc of + MultiLabelContentText _ -> do + t <- labela' mlPtr + free t + rest <- labelb' mlPtr + freeTextLabels (castPtr rest) mlcs + _ -> do + rest <- labelb' mlPtr + freeTextLabels (castPtr rest) mlcs + insertNewContents :: Ptr () -> [MultiLabelContent] -> IO () + insertNewContents mlPtr [] = do + setTypeb' mlPtr MultiLabelType + end <- multiLabelNew' (castPtr nullPtr) (castPtr nullPtr) NoLabelType NoLabelType + setLabelb' mlPtr (castPtr end) + insertNewContents mlPtr mlcs = do + rest <- setPtr mlPtr (head mlcs) + if (null (tail mlcs)) + then do + setTypeb' mlPtr MultiLabelType + end <- multiLabelNew' (castPtr nullPtr) (castPtr nullPtr) NoLabelType NoLabelType + setLabelb' mlPtr (castPtr end) + else insertNewContents (castPtr rest) (tail mlcs) + setPtr :: Ptr () -> MultiLabelContent -> IO (Ptr ()) + setPtr mlPtr mlc = do + (lt,ptr) <- toLabelTypePtr mlc + setTypea' mlPtr lt + setLabela' mlPtr ptr + labelb' mlPtr >>= return . castPtr + +instance (Parent a Widget, impl ~ (Ref a -> IO ())) => Op (WidgetLabel ()) MultiLabel orig impl where + runOp _ _ widget widget' = + withRef widget $ \widgetPtr -> + withRef widget' $ \widget'Ptr -> + setWidgetLabel' widgetPtr widget'Ptr +instance (Parent a MenuItem, impl ~ (Ref a -> IO ())) => Op (MenuItemLabel ()) MultiLabel orig impl where + runOp _ _ widget widget' = + withRef widget $ \widgetPtr -> + withRef widget' $ \widget'Ptr -> + setMenuItemLabel' widgetPtr widget'Ptr + +-- $functions +-- @ +-- menuItemLabel:: ('Parent' a 'MenuItem') => 'Ref' 'MultiLabel' -> 'Ref' a -> 'IO' () +-- +-- widgetLabel:: ('Parent' a 'Widget') => 'Ref' 'MultiLabel' -> 'Ref' a -> 'IO' () +-- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs b/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs --- a/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs +++ b/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs @@ -102,8 +102,8 @@ runOp _ _ chooser = withRef chooser $ \chooserPtr -> filename' chooserPtr >>= \s -> if (T.null s) then return Nothing else return (Just s) {# fun Fl_Native_File_Chooser_filename_with_i as filenameWithI' { id `Ptr ()',`Int' } -> `T.Text' unsafeFromCString #} -instance (impl ~ (Int -> IO (Maybe T.Text))) => Op (GetFilenameAt ()) NativeFileChooser orig impl where - runOp _ _ chooser i = withRef chooser $ \chooserPtr -> filenameWithI' chooserPtr i >>= \s -> +instance (impl ~ (AtIndex -> IO (Maybe T.Text))) => Op (GetFilenameAt ()) NativeFileChooser orig impl where + runOp _ _ chooser (AtIndex i) = withRef chooser $ \chooserPtr -> filenameWithI' chooserPtr i >>= \s -> if (T.null s) then return Nothing else return (Just s) {# fun Fl_Native_File_Chooser_set_directory as setDirectory' { id `Ptr ()',unsafeToCString `T.Text' } -> `()' #} instance (impl ~ (T.Text -> IO ())) => Op (SetDirectory ()) NativeFileChooser orig impl where @@ -130,11 +130,11 @@ instance (impl ~ ( IO (Int))) => Op (Filters ()) NativeFileChooser orig impl where runOp _ _ chooser = withRef chooser $ \chooserPtr -> filters' chooserPtr {# fun Fl_Native_File_Chooser_set_filter_value as setFilterValue' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetFilterValue ()) NativeFileChooser orig impl where - runOp _ _ chooser i = withRef chooser $ \chooserPtr -> setFilterValue' chooserPtr i +instance (impl ~ (AtIndex -> IO ())) => Op (SetFilterValue ()) NativeFileChooser orig impl where + runOp _ _ chooser (AtIndex i) = withRef chooser $ \chooserPtr -> setFilterValue' chooserPtr i {# fun Fl_Native_File_Chooser_filter_value as filterValue' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetFilterValue ()) NativeFileChooser orig impl where - runOp _ _ chooser = withRef chooser $ \chooserPtr -> filterValue' chooserPtr +instance (impl ~ ( IO (AtIndex))) => Op (GetFilterValue ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> filterValue' chooserPtr >>= return . AtIndex {# fun Fl_Native_File_Chooser_set_preset_file as setPresetFile' { id `Ptr ()',unsafeToCString `T.Text' } -> `()' #} instance (impl ~ (T.Text -> IO ())) => Op (SetPresetFile ()) NativeFileChooser orig impl where runOp _ _ chooser preset' = withRef chooser $ \chooserPtr -> setPresetFile' chooserPtr preset' @@ -175,11 +175,11 @@ -- -- getFilename :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text') -- --- getFilenameAt :: 'Ref' 'NativeFileChooser' -> 'Int' -> 'IO' ('Maybe' 'T.Text') +-- getFilenameAt :: 'Ref' 'NativeFileChooser' -> 'AtIndex' -> 'IO' ('Maybe' 'T.Text') -- -- getFilter :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text') -- --- getFilterValue :: 'Ref' 'NativeFileChooser' -> 'IO' ('Int') +-- getFilterValue :: 'Ref' 'NativeFileChooser' -> 'IO' ('AtIndex') -- -- getOptions :: 'Ref' 'NativeFileChooser' -> 'IO' (['NativeFileChooserOption')] -- @@ -193,7 +193,7 @@ -- -- setFilter :: 'Ref' 'NativeFileChooser' -> 'T.Text' -> 'IO' () -- --- setFilterValue :: 'Ref' 'NativeFileChooser' -> 'Int' -> 'IO' () +-- setFilterValue :: 'Ref' 'NativeFileChooser' -> 'AtIndex' -> 'IO' () -- -- setOptions :: 'Ref' 'NativeFileChooser' -> ['NativeFileChooserOption'] -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/NiceSlider.chs b/src/Graphics/UI/FLTK/LowLevel/NiceSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/NiceSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/NiceSlider.chs @@ -15,6 +15,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Nice_Slider_New as niceSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Nice_Slider_New_WithLabel as niceSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -24,8 +25,12 @@ in case l' of Nothing -> niceSliderNew' x_pos y_pos width height >>= toRef - Just l -> niceSliderNewWithLabel' x_pos y_pos width height l >>= - toRef + Just l -> do + ref <- niceSliderNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref + -- $hierarchy -- @ -- "Graphics.UI.FLTK.LowLevel.Widget" diff --git a/src/Graphics/UI/FLTK/LowLevel/Output.chs b/src/Graphics/UI/FLTK/LowLevel/Output.chs --- a/src/Graphics/UI/FLTK/LowLevel/Output.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Output.chs @@ -66,8 +66,11 @@ Just FlNormalOutput -> maybe outputNew' (\l -> (\x y w h -> outputNewWithLabel' x y w h l)) l' Just FlMultilineOutput -> maybe multilineOutputNew' (\l -> (\x y w h -> multilineOutputNewWithLabel' x y w h l)) l' Nothing -> outputNew' - in - constructor x_pos y_pos width height >>= toRef + in do + ref <- constructor x_pos y_pos width height >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Widget_set_type as setType' { id `Ptr ()',`Word8' } -> `()' supressWarningAboutRes #} instance (impl ~ (FlOutputType -> IO ())) => Op (SetType ()) Output orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/OverlayWindow.chs b/src/Graphics/UI/FLTK/LowLevel/OverlayWindow.chs --- a/src/Graphics/UI/FLTK/LowLevel/OverlayWindow.chs +++ b/src/Graphics/UI/FLTK/LowLevel/OverlayWindow.chs @@ -19,6 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Overlay_Window_New_WithLabel as windowNewWithLabel' { `Int', `Int', unsafeToCString `T.Text', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} @@ -30,12 +31,14 @@ overlayWindowNew (Size (Width width') (Height height')) title' position' callback' = do fptr <- toCallbackPrim callback' - case (title', position') of - (Just t, Just (Position (X x') (Y y'))) -> windowNewWithXYLabel' width' height' x' y' t fptr >>= toRef - (Nothing, Just (Position (X x') (Y y'))) -> windowNewWithXY' width' height' x' y' fptr >>= toRef - (Just t, Nothing) -> windowNewWithLabel' width' height' t fptr >>= toRef - (Nothing, Nothing) -> windowNew' width' height' fptr >>= toRef - + ref <- case (title', position') of + (Just t, Just (Position (X x') (Y y'))) -> windowNewWithXYLabel' width' height' x' y' t fptr >>= toRef + (Nothing, Just (Position (X x') (Y y'))) -> windowNewWithXY' width' height' x' y' fptr >>= toRef + (Just t, Nothing) -> windowNewWithLabel' width' height' t fptr >>= toRef + (Nothing, Nothing) -> windowNew' width' height' fptr >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Overlay_Window_Destroy as windowDestroy' { id `Ptr ()' } -> `()' #} instance (impl ~ (IO ())) => Op (Destroy ()) OverlayWindow orig impl where runOp _ _ win = withRef win $ \winPtr -> windowDestroy' winPtr diff --git a/src/Graphics/UI/FLTK/LowLevel/Pack.chs b/src/Graphics/UI/FLTK/LowLevel/Pack.chs --- a/src/Graphics/UI/FLTK/LowLevel/Pack.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Pack.chs @@ -46,12 +46,13 @@ {# fun Fl_Pack_New_WithLabel as packNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} packNew :: Rectangle -> Maybe T.Text -> IO (Ref Pack) packNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> packNew' x_pos y_pos width height >>= - toRef - Just l -> packNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Pack_get_spacing as getSpacing' { id `Ptr ()' } -> `Int' #} instance (impl ~ (IO (Int))) => Op (GetSpacing ()) Pack orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/Pixmap.chs b/src/Graphics/UI/FLTK/LowLevel/Pixmap.chs --- a/src/Graphics/UI/FLTK/LowLevel/Pixmap.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Pixmap.chs @@ -97,15 +97,15 @@ -- -- drawResize :: 'Ref' 'Pixmap' -> 'Position' -> 'Size' -> 'Maybe' 'X' -> 'Maybe' 'Y' -> 'IO' () -- --- getCount :: 'Ref' 'Pixmap' -> 'IO' 'Int' +-- getCount :: 'Ref' 'Pixmap' -> 'IO' ('Int') -- --- getD :: 'Ref' 'Pixmap' -> 'IO' 'Int' +-- getD :: 'Ref' 'Pixmap' -> 'IO' ('Int') -- --- getH :: 'Ref' 'Pixmap' -> 'IO' 'Int' +-- getH :: 'Ref' 'Pixmap' -> 'IO' ('Int') -- --- getLd :: 'Ref' 'Pixmap' -> 'IO' 'Int' +-- getLd :: 'Ref' 'Pixmap' -> 'IO' ('Int') -- --- getW :: 'Ref' 'Pixmap' -> 'IO' 'Int' +-- getW :: 'Ref' 'Pixmap' -> 'IO' ('Int') -- -- inactive :: 'Ref' 'Pixmap' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Positioner.chs b/src/Graphics/UI/FLTK/LowLevel/Positioner.chs --- a/src/Graphics/UI/FLTK/LowLevel/Positioner.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Positioner.chs @@ -48,12 +48,13 @@ {# fun Fl_Positioner_New_WithLabel as positionerNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} positionerNew :: Rectangle -> Maybe T.Text -> IO (Ref Positioner) positionerNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> positionerNew' x_pos y_pos width height >>= - toRef - Just l -> positionerNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Positioner_Destroy as positionerDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Positioner orig impl where @@ -62,47 +63,47 @@ return nullPtr {# fun Fl_Positioner_set_xvalue as setXvalue' { id `Ptr ()',`Double' } -> `()' #} -instance (impl ~ (Double -> IO ())) => Op (SetXvalue ()) Positioner orig impl where - runOp _ _ positioner xvalue = withRef positioner $ \positionerPtr -> setXvalue' positionerPtr xvalue +instance (impl ~ (PreciseX -> IO ())) => Op (SetXvalue ()) Positioner orig impl where + runOp _ _ positioner (PreciseX xvalue) = withRef positioner $ \positionerPtr -> setXvalue' positionerPtr xvalue {# fun Fl_Positioner_xvalue as xvalue' { id `Ptr ()' } -> `Double' #} -instance (impl ~ ( IO (Double))) => Op (GetXvalue ()) Positioner orig impl where - runOp _ _ positioner = withRef positioner $ \positionerPtr -> xvalue' positionerPtr +instance (impl ~ ( IO (PreciseX))) => Op (GetXvalue ()) Positioner orig impl where + runOp _ _ positioner = withRef positioner $ \positionerPtr -> xvalue' positionerPtr >>= return . PreciseX {# fun Fl_Positioner_set_yvalue as setYvalue' { id `Ptr ()',`Double' } -> `()' #} -instance (impl ~ (Double -> IO ())) => Op (SetYvalue ()) Positioner orig impl where - runOp _ _ positioner yvalue = withRef positioner $ \positionerPtr -> setYvalue' positionerPtr yvalue +instance (impl ~ (PreciseY -> IO ())) => Op (SetYvalue ()) Positioner orig impl where + runOp _ _ positioner (PreciseY yvalue) = withRef positioner $ \positionerPtr -> setYvalue' positionerPtr yvalue {# fun Fl_Positioner_yvalue as yvalue' { id `Ptr ()' } -> `Double' #} -instance (impl ~ ( IO (Double))) => Op (GetYvalue ()) Positioner orig impl where - runOp _ _ positioner = withRef positioner $ \positionerPtr -> yvalue' positionerPtr +instance (impl ~ ( IO (PreciseY))) => Op (GetYvalue ()) Positioner orig impl where + runOp _ _ positioner = withRef positioner $ \positionerPtr -> yvalue' positionerPtr >>= return . PreciseY {# fun Fl_Positioner_set_xminimum as setXminimum' { id `Ptr ()',`Double' } -> `()' #} -instance (impl ~ (Double -> IO ())) => Op (SetXminimum ()) Positioner orig impl where - runOp _ _ positioner xminimum = withRef positioner $ \positionerPtr -> setXminimum' positionerPtr xminimum +instance (impl ~ (PreciseX -> IO ())) => Op (SetXminimum ()) Positioner orig impl where + runOp _ _ positioner (PreciseX xminimum) = withRef positioner $ \positionerPtr -> setXminimum' positionerPtr xminimum {# fun Fl_Positioner_xminimum as xminimum' { id `Ptr ()' } -> `Double' #} -instance (impl ~ ( IO (Double))) => Op (GetXminimum ()) Positioner orig impl where - runOp _ _ positioner = withRef positioner $ \positionerPtr -> xminimum' positionerPtr +instance (impl ~ ( IO (PreciseX))) => Op (GetXminimum ()) Positioner orig impl where + runOp _ _ positioner = withRef positioner $ \positionerPtr -> xminimum' positionerPtr >>= return . PreciseX {# fun Fl_Positioner_set_yminimum as setYminimum' { id `Ptr ()',`Double' } -> `()' #} -instance (impl ~ (Double -> IO ())) => Op (SetYminimum ()) Positioner orig impl where - runOp _ _ positioner yminimum = withRef positioner $ \positionerPtr -> setYminimum' positionerPtr yminimum +instance (impl ~ (PreciseY -> IO ())) => Op (SetYminimum ()) Positioner orig impl where + runOp _ _ positioner (PreciseY yminimum) = withRef positioner $ \positionerPtr -> setYminimum' positionerPtr yminimum {# fun Fl_Positioner_yminimum as yminimum' { id `Ptr ()' } -> `Double' #} -instance (impl ~ ( IO (Double))) => Op (GetYminimum ()) Positioner orig impl where - runOp _ _ positioner = withRef positioner $ \positionerPtr -> yminimum' positionerPtr +instance (impl ~ ( IO (PreciseY))) => Op (GetYminimum ()) Positioner orig impl where + runOp _ _ positioner = withRef positioner $ \positionerPtr -> yminimum' positionerPtr >>= return . PreciseY {# fun Fl_Positioner_set_xmaximum as setXmaximum' { id `Ptr ()',`Double' } -> `()' #} -instance (impl ~ (Double -> IO ())) => Op (SetXmaximum ()) Positioner orig impl where - runOp _ _ positioner xmaximum = withRef positioner $ \positionerPtr -> setXmaximum' positionerPtr xmaximum +instance (impl ~ (PreciseX -> IO ())) => Op (SetXmaximum ()) Positioner orig impl where + runOp _ _ positioner (PreciseX xmaximum) = withRef positioner $ \positionerPtr -> setXmaximum' positionerPtr xmaximum {# fun Fl_Positioner_xmaximum as xmaximum' { id `Ptr ()' } -> `Double' #} -instance (impl ~ ( IO (Double))) => Op (GetXmaximum ()) Positioner orig impl where - runOp _ _ positioner = withRef positioner $ \positionerPtr -> xmaximum' positionerPtr +instance (impl ~ ( IO (PreciseX))) => Op (GetXmaximum ()) Positioner orig impl where + runOp _ _ positioner = withRef positioner $ \positionerPtr -> xmaximum' positionerPtr >>= return . PreciseX {# fun Fl_Positioner_set_ymaximum as setYmaximum' { id `Ptr ()',`Double' } -> `()' #} -instance (impl ~ (Double -> IO ())) => Op (SetYmaximum ()) Positioner orig impl where - runOp _ _ positioner ymaximum = withRef positioner $ \positionerPtr -> setYmaximum' positionerPtr ymaximum +instance (impl ~ (PreciseY -> IO ())) => Op (SetYmaximum ()) Positioner orig impl where + runOp _ _ positioner (PreciseY ymaximum) = withRef positioner $ \positionerPtr -> setYmaximum' positionerPtr ymaximum {# fun Fl_Positioner_ymaximum as ymaximum' { id `Ptr ()' } -> `Double' #} -instance (impl ~ ( IO (Double))) => Op (GetYmaximum ()) Positioner orig impl where - runOp _ _ positioner = withRef positioner $ \positionerPtr -> ymaximum' positionerPtr +instance (impl ~ ( IO (PreciseY))) => Op (GetYmaximum ()) Positioner orig impl where + runOp _ _ positioner = withRef positioner $ \positionerPtr -> ymaximum' positionerPtr >>= return . PreciseY {# fun Fl_Positioner_xbounds as xbounds' { id `Ptr ()',`Double',`Double' } -> `()' #} -instance (impl ~ (Double -> Double -> IO ())) => Op (SetXbounds ()) Positioner orig impl where - runOp _ _ positioner xstart xend = withRef positioner $ \positionerPtr -> xbounds' positionerPtr xstart xend +instance (impl ~ (PreciseX -> PreciseX -> IO ())) => Op (SetXbounds ()) Positioner orig impl where + runOp _ _ positioner (PreciseX xstart) (PreciseX xend) = withRef positioner $ \positionerPtr -> xbounds' positionerPtr xstart xend {# fun Fl_Positioner_ybounds as ybounds' { id `Ptr ()',`Double',`Double' } -> `()' #} -instance (impl ~ (Double -> Double -> IO ())) => Op (SetYbounds ()) Positioner orig impl where - runOp _ _ positioner ystart yend = withRef positioner $ \positionerPtr -> ybounds' positionerPtr ystart yend +instance (impl ~ (PreciseY -> PreciseY -> IO ())) => Op (SetYbounds ()) Positioner orig impl where + runOp _ _ positioner (PreciseY ystart) (PreciseY yend) = withRef positioner $ \positionerPtr -> ybounds' positionerPtr ystart yend {# fun Fl_Positioner_xstep as xstep' { id `Ptr ()',`Double' } -> `()' #} instance (impl ~ (Double -> IO ())) => Op (SetXstep ()) Positioner orig impl where runOp _ _ positioner xstep = withRef positioner $ \positionerPtr -> xstep' positionerPtr xstep @@ -152,17 +153,17 @@ -- -- drawSuper :: 'Ref' 'Positioner' -> 'IO' () -- --- getXmaximum :: 'Ref' 'Positioner' -> 'IO' ('Double') +-- getXmaximum :: 'Ref' 'Positioner' -> 'IO' ('PreciseX') -- --- getXminimum :: 'Ref' 'Positioner' -> 'IO' ('Double') +-- getXminimum :: 'Ref' 'Positioner' -> 'IO' ('PreciseX') -- --- getXvalue :: 'Ref' 'Positioner' -> 'IO' ('Double') +-- getXvalue :: 'Ref' 'Positioner' -> 'IO' ('PreciseX') -- --- getYmaximum :: 'Ref' 'Positioner' -> 'IO' ('Double') +-- getYmaximum :: 'Ref' 'Positioner' -> 'IO' ('PreciseY') -- --- getYminimum :: 'Ref' 'Positioner' -> 'IO' ('Double') +-- getYminimum :: 'Ref' 'Positioner' -> 'IO' ('PreciseY') -- --- getYvalue :: 'Ref' 'Positioner' -> 'IO' ('Double') +-- getYvalue :: 'Ref' 'Positioner' -> 'IO' ('PreciseY') -- -- handle :: 'Ref' 'Positioner' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- @@ -176,25 +177,25 @@ -- -- resizeSuper :: 'Ref' 'Positioner' -> 'Rectangle' -> 'IO' () -- --- setXbounds :: 'Ref' 'Positioner' -> 'Double' -> 'Double' -> 'IO' () +-- setXbounds :: 'Ref' 'Positioner' -> 'PreciseX' -> 'PreciseX' -> 'IO' () -- --- setXmaximum :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () +-- setXmaximum :: 'Ref' 'Positioner' -> 'PreciseX' -> 'IO' () -- --- setXminimum :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () +-- setXminimum :: 'Ref' 'Positioner' -> 'PreciseX' -> 'IO' () -- -- setXstep :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () -- --- setXvalue :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () +-- setXvalue :: 'Ref' 'Positioner' -> 'PreciseX' -> 'IO' () -- --- setYbounds :: 'Ref' 'Positioner' -> 'Double' -> 'Double' -> 'IO' () +-- setYbounds :: 'Ref' 'Positioner' -> 'PreciseY' -> 'PreciseY' -> 'IO' () -- --- setYmaximum :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () +-- setYmaximum :: 'Ref' 'Positioner' -> 'PreciseY' -> 'IO' () -- --- setYminimum :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () +-- setYminimum :: 'Ref' 'Positioner' -> 'PreciseY' -> 'IO' () -- -- setYstep :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () -- --- setYvalue :: 'Ref' 'Positioner' -> 'Double' -> 'IO' () +-- setYvalue :: 'Ref' 'Positioner' -> 'PreciseY' -> 'IO' () -- -- showWidget :: 'Ref' 'Positioner' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Progress.chs b/src/Graphics/UI/FLTK/LowLevel/Progress.chs --- a/src/Graphics/UI/FLTK/LowLevel/Progress.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Progress.chs @@ -49,12 +49,13 @@ {# fun Fl_Progress_New_WithLabel as progressNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} progressNew :: Rectangle -> Maybe T.Text -> IO (Ref Progress) progressNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> progressNew' x_pos y_pos width height >>= - toRef - Just l -> progressNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Progress_Destroy as progressDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (Destroy ()) Progress orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/RGBImage.chs b/src/Graphics/UI/FLTK/LowLevel/RGBImage.chs --- a/src/Graphics/UI/FLTK/LowLevel/RGBImage.chs +++ b/src/Graphics/UI/FLTK/LowLevel/RGBImage.chs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables, CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.RGBImage ( @@ -23,20 +23,26 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch -import Data.ByteString as B +import qualified Data.Vector.Storable as DVS +import Control.Exception {# fun Fl_RGB_Image_New as rgbImageNew' { id `Ptr CUChar',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_RGB_Image_New_With_D as rgbImageNew_WithD' {id `Ptr CUChar',`Int',`Int', `Int'} -> `Ptr ()' id #}; {# fun Fl_RGB_Image_New_With_LD as rgbImageNew_WithLD' {id `Ptr CUChar',`Int',`Int', `Int'} -> `Ptr ()' id #}; {# fun Fl_RGB_Image_New_With_D_LD as rgbImageNew_WithD_LD' {id `Ptr CUChar',`Int',`Int', `Int', `Int'} -> `Ptr ()' id #}; -rgbImageNew :: B.ByteString -> Size -> Maybe Depth -> Maybe LineSize -> IO (Ref RGBImage) -rgbImageNew bits' (Size (Width width') (Height height')) depth' linesize' = - useAsCString bits' $ \asCString -> - case (depth', linesize') of - (Just (Depth imageDepth) , Nothing) -> rgbImageNew_WithD' (castPtr asCString) width' height' imageDepth >>= toRef - (Nothing, Just (LineSize l')) -> rgbImageNew_WithLD' (castPtr asCString) width' height' l' >>= toRef - (Just (Depth imageDepth), Just (LineSize l')) -> rgbImageNew_WithD_LD' (castPtr asCString) width' height' imageDepth l' >>= toRef - (Nothing, Nothing) -> rgbImageNew' (castPtr asCString) width' height' >>= toRef +rgbImageNew :: DVS.Vector CUChar -> Size -> Maybe Depth -> Maybe LineSize -> IO (Ref RGBImage) +rgbImageNew bits' (Size (Width width') (Height height')) depth' linesize' = do + DVS.unsafeWith bits' $ \ptr -> do + (ref :: Ref RGBImage) <- + case (depth', linesize') of + (Just (Depth imageDepth) , Nothing) -> rgbImageNew_WithD' ptr width' height' imageDepth >>= toRef + (Nothing, Just (LineSize l')) -> rgbImageNew_WithLD' ptr width' height' l' >>= toRef + (Just (Depth imageDepth), Just (LineSize l')) -> rgbImageNew_WithD_LD' ptr width' height' imageDepth l' >>= toRef + (Nothing, Nothing) -> rgbImageNew' ptr width' height' >>= toRef + r <- copy ref Nothing + case r of + Nothing -> throwIO (userError "rgbImageNew: could not create RGB Image.") + Just r -> return r -- | Check that the given RGBImage (or subclass of RGBImage) has a non-zero width. -- @@ -79,7 +85,7 @@ {# fun Fl_RGB_Image_copy_with_w_h as copyWithWH' { id `Ptr ()',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_RGB_Image_copy as copy' { id `Ptr ()' } -> `Ptr ()' id #} -instance (Parent a RGBImage, impl ~ ( Maybe Size -> IO (Maybe (Ref a)))) => Op (Copy ()) RGBImage orig impl where +instance (impl ~ ( Maybe Size -> IO (Maybe (Ref orig)))) => Op (Copy ()) RGBImage orig impl where runOp _ _ image size' = case size' of Just (Size (Width imageWidth) (Height imageHeight)) -> withRef image $ \imagePtr -> copyWithWH' imagePtr imageWidth imageHeight >>= toMaybeRef @@ -132,7 +138,7 @@ -- @ -- colorAverage :: 'Ref' 'RGBImage' -> 'Color' -> 'Float' -> 'IO' () -- --- copy:: ('Parent' a 'RGBImage') => 'Ref' 'RGBImage' -> 'Maybe' 'Size' -> 'IO' ('Maybe' ('Ref' a)) +-- copy :: 'Ref' 'RGBImage' -> 'Maybe' 'Size' -> 'IO' ('Maybe' ('Ref' orig)) -- -- desaturate :: 'Ref' 'RGBImage' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/RadioLightButton.chs b/src/Graphics/UI/FLTK/LowLevel/RadioLightButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/RadioLightButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/RadioLightButton.chs @@ -17,6 +17,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Radio_Light_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Radio_Light_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -25,7 +26,11 @@ let (x_pos, y_pos, width, height) = fromRectangle rectangle in case l' of Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + Just l -> do + ref <- widgetNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/RepeatButton.chs b/src/Graphics/UI/FLTK/LowLevel/RepeatButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/RepeatButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/RepeatButton.chs @@ -49,10 +49,13 @@ {# fun Fl_Repeat_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} repeatButtonNew :: Rectangle -> Maybe T.Text -> IO (Ref RepeatButton) repeatButtonNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Repeat_Button_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (Destroy ()) RepeatButton orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/ReturnButton.chs b/src/Graphics/UI/FLTK/LowLevel/ReturnButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/ReturnButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ReturnButton.chs @@ -48,10 +48,13 @@ {# fun Fl_Return_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} returnButtonNew :: Rectangle -> Maybe T.Text -> IO (Ref ReturnButton) returnButtonNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Return_Button_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ IO ()) => Op (Destroy ()) ReturnButton orig impl where @@ -97,10 +100,27 @@ -- $functions -- @ --- -- destroy :: 'Ref' 'ReturnButton' -> 'IO' () -- --- handle :: 'Ref' 'ReturnButton' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- draw :: 'Ref' 'ReturnButton' -> 'IO' () +-- +-- drawSuper :: 'Ref' 'ReturnButton' -> 'IO' () +-- +-- handle :: 'Ref' 'ReturnButton' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- handleSuper :: 'Ref' 'ReturnButton' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- hide :: 'Ref' 'ReturnButton' -> 'IO' () +-- +-- hideSuper :: 'Ref' 'ReturnButton' -> 'IO' () +-- +-- resize :: 'Ref' 'ReturnButton' -> 'Rectangle' -> 'IO' () +-- +-- resizeSuper :: 'Ref' 'ReturnButton' -> 'Rectangle' -> 'IO' () +-- +-- showWidget :: 'Ref' 'ReturnButton' -> 'IO' () +-- +-- showWidgetSuper :: 'Ref' 'ReturnButton' -> 'IO' () -- -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Roller.chs b/src/Graphics/UI/FLTK/LowLevel/Roller.chs --- a/src/Graphics/UI/FLTK/LowLevel/Roller.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Roller.chs @@ -47,12 +47,13 @@ {# fun Fl_Roller_New_WithLabel as rollerNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} rollerNew :: Rectangle -> Maybe T.Text -> IO (Ref Roller) rollerNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> rollerNew' x_pos y_pos width height >>= - toRef - Just l -> rollerNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Roller_Destroy as rollerDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Roller orig impl where @@ -95,10 +96,27 @@ runOp _ _ roller = withRef roller $ \rollerPtr -> showSuper' rollerPtr -- $functions -- @ --- -- destroy :: 'Ref' 'Roller' -> 'IO' () -- --- handle :: 'Ref' 'Roller' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- draw :: 'Ref' 'Roller' -> 'IO' () +-- +-- drawSuper :: 'Ref' 'Roller' -> 'IO' () +-- +-- handle :: 'Ref' 'Roller' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- handleSuper :: 'Ref' 'Roller' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- hide :: 'Ref' 'Roller' -> 'IO' () +-- +-- hideSuper :: 'Ref' 'Roller' -> 'IO' () +-- +-- resize :: 'Ref' 'Roller' -> 'Rectangle' -> 'IO' () +-- +-- resizeSuper :: 'Ref' 'Roller' -> 'Rectangle' -> 'IO' () +-- +-- showWidget :: 'Ref' 'Roller' -> 'IO' () +-- +-- showWidgetSuper :: 'Ref' 'Roller' -> 'IO' () -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/RoundButton.chs b/src/Graphics/UI/FLTK/LowLevel/RoundButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/RoundButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/RoundButton.chs @@ -45,10 +45,13 @@ {# fun Fl_Round_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} roundButtonNew :: Rectangle -> Maybe T.Text -> IO (Ref RoundButton) roundButtonNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Round_Button_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ IO ()) => Op (Destroy ()) RoundButton orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/SVGImage.chs b/src/Graphics/UI/FLTK/LowLevel/SVGImage.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/FLTK/LowLevel/SVGImage.chs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings, CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Graphics.UI.FLTK.LowLevel.SVGImage + ( + svgImageNew, + svgImageNewFromFile + -- * Hierarchy + -- + -- $hierarchy + + ) +where +#include "Fl_ExportMacros.h" +#include "Fl_Types.h" +#include "Fl_SVG_ImageC.h" +import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Utils +import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +import Graphics.UI.FLTK.LowLevel.Dispatch +import Graphics.UI.FLTK.LowLevel.RGBImage +import qualified Data.Text as T +import qualified Data.ByteString as B + +{# fun Fl_SVG_Image_New_WithData as svgImageNewWithData' { id `Ptr CChar' , id `Ptr CChar' } -> `Ptr ()' id #} +svgImageNewFromFile :: T.Text -> IO (Either UnknownError (Ref SVGImage)) +svgImageNewFromFile path' = do + pathPtr <- copyTextToCString path' + ptr <- svgImageNewWithData' pathPtr (castPtr nullPtr) + ref' <- (toRef ptr :: IO (Ref SVGImage)) + checkImage ref' + +svgImageNew :: B.ByteString -> IO (Either UnknownError (Ref SVGImage)) +svgImageNew svgData' = do + dataPtr <- copyByteStringToCString svgData' + ptr <- svgImageNewWithData' (castPtr nullPtr) dataPtr + ref' <- (toRef ptr :: IO (Ref SVGImage)) + checkImage ref' + +{# fun Fl_SVG_Image_Destroy as flImageDestroy' { id `Ptr ()' } -> `()' id #} +instance (impl ~ (IO ())) => Op (Destroy ()) SVGImage orig impl where + runOp _ _ image = withRef image $ \imagePtr -> flImageDestroy' imagePtr + +{# fun Fl_SVG_Image_resize as resize' { id `Ptr ()',`Int',`Int' } -> `()' supressWarningAboutRes #} +instance (impl ~ ( Size -> IO ())) => Op (Resize ()) SVGImage orig impl where + runOp _ _ widget (Size (Width w') (Height h')) = + withRef widget $ \widgetPtr -> resize' widgetPtr w' h' + +{# fun Fl_SVG_Image_copy_with_w_h as copyWithWH' { id `Ptr ()',`Int',`Int' } -> `Ptr ()' id #} +instance (impl ~ (Size -> IO (Maybe (Ref SVGImage)))) => Op (Copy ()) SVGImage orig impl where + runOp _ _ image size' = case size' of + (Size (Width imageWidth) (Height imageHeight)) -> + withRef image $ \imagePtr -> copyWithWH' imagePtr imageWidth imageHeight >>= toMaybeRef + +{# fun Fl_SVG_Image_color_average as colorAverage' { id `Ptr ()',cFromColor `Color',`Float' } -> `()' #} +instance (impl ~ (Color -> Float -> IO ())) => Op (ColorAverage ()) SVGImage orig impl where + runOp _ _ image c i = withRef image $ \imagePtr -> colorAverage' imagePtr c i + +{# fun Fl_SVG_Image_desaturate as desaturate' { id `Ptr ()' } -> `()' #} +instance (impl ~ ( IO ())) => Op (Desaturate ()) SVGImage orig impl where + runOp _ _ image = withRef image $ \imagePtr -> desaturate' imagePtr + +{# fun Fl_SVG_Image_draw_with_cx_cy as drawWithCxCy' { id `Ptr ()',`Int',`Int',`Int',`Int',`Int',`Int' } -> `()' #} +{# fun Fl_SVG_Image_draw_with_cx as drawWithCx' { id `Ptr ()',`Int',`Int',`Int',`Int',`Int' } -> `()' #} +{# fun Fl_SVG_Image_draw_with_cy as drawWithCy' { id `Ptr ()',`Int',`Int',`Int',`Int',`Int' } -> `()' #} +{# fun Fl_SVG_Image_draw_with as drawWith' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `()' #} + +instance (impl ~ (Position -> Size -> Maybe X -> Maybe Y -> IO ())) => Op (DrawResize ()) SVGImage orig impl where + runOp _ _ image (Position (X imageX) (Y imageY)) (Size (Width imageWidth) (Height imageHeight)) xOffset yOffset = + case (xOffset, yOffset) of + (Just (X xOff), Just (Y yOff)) -> + withRef image $ \imagePtr -> drawWithCxCy' imagePtr imageX imageY imageWidth imageHeight (fromIntegral xOff) (fromIntegral yOff) + (Just (X xOff), Nothing) -> + withRef image $ \imagePtr -> drawWithCx' imagePtr imageX imageY imageWidth imageHeight (fromIntegral xOff) + (Nothing, Just (Y yOff)) -> + withRef image $ \imagePtr -> drawWithCy' imagePtr imageX imageY imageWidth imageHeight (fromIntegral yOff) + (Nothing, Nothing) -> + withRef image $ \imagePtr -> drawWith' imagePtr imageX imageY imageWidth imageHeight + +{# fun Fl_SVG_Image_draw as draw' { id `Ptr ()',`Int',`Int' } -> `()' #} +instance (impl ~ (Position -> IO ())) => Op (Draw ()) SVGImage orig impl where + runOp _ _ image (Position (X x_pos') (Y y_pos')) = withRef image $ \imagePtr -> draw' imagePtr x_pos' y_pos' + +-- $hierarchy +-- @ +-- "Graphics.UI.FLTK.LowLevel.Image" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.RGBImage" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.SVGImage" +-- @ + +-- $functions +-- @ +-- colorAverage :: 'Ref' 'SVGImage' -> 'Color' -> 'Float' -> 'IO' () +-- +-- copy :: 'Ref' 'SVGImage' -> 'Size' -> 'IO' ('Maybe' ('Ref' 'SVGImage')) +-- +-- desaturate :: 'Ref' 'SVGImage' -> 'IO' () +-- +-- destroy :: 'Ref' 'SVGImage' -> 'IO' () +-- +-- draw :: 'Ref' 'SVGImage' -> 'Position' -> 'IO' () +-- +-- drawResize :: 'Ref' 'SVGImage' -> 'Position' -> 'Size' -> 'Maybe' 'X' -> 'Maybe' 'Y' -> 'IO' () +-- +-- resize :: 'Ref' 'SVGImage' -> 'Size' -> 'IO' () +-- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Scrollbar.chs b/src/Graphics/UI/FLTK/LowLevel/Scrollbar.chs --- a/src/Graphics/UI/FLTK/LowLevel/Scrollbar.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Scrollbar.chs @@ -49,12 +49,13 @@ {# fun Fl_Scrollbar_New_WithLabel as scrollbarNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} scrollbarNew :: Rectangle -> Maybe T.Text -> IO (Ref Scrollbar) scrollbarNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> scrollbarNew' x_pos y_pos width height >>= - toRef - Just l -> scrollbarNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Scrollbar_Destroy as scrollbarDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Scrollbar orig impl where @@ -63,8 +64,8 @@ return nullPtr {# fun Fl_Scrollbar_scrollvalue as scrollvalue' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `Int' #} -instance (impl ~ (Int -> Int -> Int -> Int -> IO (Int))) => Op (SetScrollValue ()) Scrollbar orig impl where - runOp _ _ slider pos size first total = withRef slider $ \sliderPtr -> scrollvalue' sliderPtr pos size first total +instance (impl ~ (Y -> Lines -> LineNumber -> Lines -> IO (Int))) => Op (Scrollvalue ()) Scrollbar orig impl where + runOp _ _ slider (Y pos) (Lines size) (LineNumber first) (Lines total) = withRef slider $ \sliderPtr -> scrollvalue' sliderPtr pos size first total {# fun Fl_Scrollbar_set_linesize as setLinesize' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ (LineSize -> IO ())) => Op (SetLinesize ()) Scrollbar orig impl where @@ -130,8 +131,6 @@ -- -- handle :: 'Ref' 'Scrollbar' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- --- handle :: 'Ref' 'Scrollbar' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) --- -- handleSuper :: 'Ref' 'Scrollbar' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'Scrollbar' -> 'IO' () @@ -142,9 +141,9 @@ -- -- resizeSuper :: 'Ref' 'Scrollbar' -> 'Rectangle' -> 'IO' () -- --- setLinesize :: 'Ref' 'Scrollbar' -> 'LineSize' -> 'IO' () +-- scrollvalue :: 'Ref' 'Scrollbar' -> 'Y' -> 'Lines' -> 'LineNumber' -> 'Lines' -> 'IO' ('Int') -- --- setScrollValue :: 'Ref' 'Scrollbar' -> 'Int' -> 'Int' -> 'Int' -> 'Int' -> 'IO' ('Int') +-- setLinesize :: 'Ref' 'Scrollbar' -> 'LineSize' -> 'IO' () -- -- setType :: 'Ref' 'Scrollbar' -> 'ScrollbarType' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Scrolled.chs b/src/Graphics/UI/FLTK/LowLevel/Scrolled.chs --- a/src/Graphics/UI/FLTK/LowLevel/Scrolled.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Scrolled.chs @@ -47,12 +47,13 @@ {# fun Fl_Scroll_New_WithLabel as scrollNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} scrolledNew :: Rectangle -> Maybe T.Text -> IO (Ref Scrolled) scrolledNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> scrollNew' x_pos y_pos width height >>= - toRef - Just l -> scrollNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Scroll_set_scrollbar_size as setScrollbarSize' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ (Int -> IO ())) => Op (SetScrollbarSize ()) Scrolled orig impl where runOp _ _ widget size = withRef widget $ \widgetPtr -> setScrollbarSize' widgetPtr size @@ -143,8 +144,6 @@ -- hide :: 'Ref' 'Scrolled' -> 'IO' () -- -- hideSuper :: 'Ref' 'Scrolled' -> 'IO' () --- --- resize :: 'Ref' 'Scrolled' -> 'Rectangle' -> 'IO' () -- -- resize :: 'Ref' 'Scrolled' -> 'Rectangle' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/SelectBrowser.chs b/src/Graphics/UI/FLTK/LowLevel/SelectBrowser.chs --- a/src/Graphics/UI/FLTK/LowLevel/SelectBrowser.chs +++ b/src/Graphics/UI/FLTK/LowLevel/SelectBrowser.chs @@ -16,6 +16,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import qualified Data.Text as T {# fun Fl_Select_Browser_New as selectBrowserNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Select_Browser_New_WithLabel as selectBrowserNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} @@ -25,9 +26,11 @@ in case l' of Nothing -> selectBrowserNew' x_pos y_pos width height >>= toRef - Just l -> selectBrowserNewWithLabel' x_pos y_pos width height l >>= - toRef - + Just l -> do + ref <- selectBrowserNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref -- $hierarchy -- @ -- "Graphics.UI.FLTK.LowLevel.Widget" diff --git a/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs b/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs deleted file mode 100644 --- a/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs +++ /dev/null @@ -1,43 +0,0 @@ -module Graphics.UI.FLTK.LowLevel.SimpleCounter - ( - -- * Constructor - simpleCounterNew - -- * Hierarchy - -- - -- $hierarchy - ) -where -#include "Fl_ExportMacros.h" -#include "Fl_Types.h" -#include "Fl_CounterC.h" -import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) - -import Graphics.UI.FLTK.LowLevel.Fl_Types -import Graphics.UI.FLTK.LowLevel.Utils -import Graphics.UI.FLTK.LowLevel.Hierarchy -import qualified Data.Text as T -{# fun Fl_Simple_Counter_New as simpleCounterNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Simple_Counter_New_WithLabel as simpleCounterNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} -simpleCounterNew :: Rectangle -> Maybe T.Text -> IO (Ref SimpleCounter) -simpleCounterNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> simpleCounterNew' x_pos y_pos width height >>= - toRef - Just l -> simpleCounterNewWithLabel' x_pos y_pos width height l >>= - toRef - - --- $hierarchy --- @ --- "Graphics.UI.FLTK.LowLevel.Widget" --- | --- v --- "Graphics.UI.FLTK.LowLevel.Valuator" --- | --- v --- "Graphics.UI.FLTK.LowLevel.Counter" --- | --- v --- "Graphics.UI.FLTK.LowLevel.SimpleCounter" --- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/SimpleTerminal.chs b/src/Graphics/UI/FLTK/LowLevel/SimpleTerminal.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/FLTK/LowLevel/SimpleTerminal.chs @@ -0,0 +1,195 @@ +{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-} +module Graphics.UI.FLTK.LowLevel.SimpleTerminal + ( + simpleTerminalNew, + simpleTerminalCustom + -- * Hierarchy + -- + -- $hierarchy + + -- * Functions + -- + -- $functions + ) +where +#include "Fl_ExportMacros.h" +#include "Fl_Types.h" +#include "Fl_Simple_TerminalC.h" +import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +import Graphics.UI.FLTK.LowLevel.Utils +import Graphics.UI.FLTK.LowLevel.Widget +import Graphics.UI.FLTK.LowLevel.TextDisplay +import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Dispatch +import qualified Data.Text as T +import qualified Foreign.ForeignPtr.Unsafe as Unsafe + +{# fun Fl_Simple_Terminal_New as simpleTerminalNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} +{# fun Fl_Simple_Terminal_New_WithLabel as simpleTerminalNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} +simpleTerminalNew :: Rectangle -> Maybe T.Text -> IO (Ref SimpleTerminal) +simpleTerminalNew rectangle l' = + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' + +{# fun Fl_OverriddenSimple_Terminal_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenSimple_Terminal_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} +simpleTerminalCustom :: + Rectangle -- ^ The bounds of this SimpleTerminal + -> Maybe T.Text -- ^ The SimpleTerminal label + -> Maybe (Ref SimpleTerminal -> IO ()) -- ^ Optional custom drawing function + -> IO (Ref SimpleTerminal) +simpleTerminalCustom rectangle l' draw' = + widgetMaker + rectangle + l' + draw' + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' + +{# fun Fl_Simple_Terminal_set_stay_at_bottom as setStayAtBottom' { id `Ptr ()', cFromBool `Bool' } -> `()' #} +instance (impl ~ (Bool -> IO ())) => Op (SetStayAtBottom ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal b = withRef simple_terminal $ \simple_terminalPtr -> setStayAtBottom' simple_terminalPtr b +{# fun Fl_Simple_Terminal_get_stay_at_bottom as getStayAtBottom' { id `Ptr ()'} -> `Bool' cToBool#} +instance (impl ~ (IO Bool)) => Op (GetStayAtBottom ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getStayAtBottom' simple_terminalPtr +{# fun Fl_Simple_Terminal_set_ansi as setAnsi' { id `Ptr ()', cFromBool `Bool' } -> `()' #} +instance (impl ~ (Bool -> IO ())) => Op (SetAnsi ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal b = withRef simple_terminal $ \simple_terminalPtr -> setAnsi' simple_terminalPtr b +{# fun Fl_Simple_Terminal_get_ansi as getAnsi' { id `Ptr ()'} -> `Bool' cToBool#} +instance (impl ~ (IO Bool)) => Op (GetAnsi ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getAnsi' simple_terminalPtr +{# fun Fl_Simple_Terminal_set_history_lines as setHistoryLines' { id `Ptr ()', `Int' } -> `()' #} +instance (impl ~ (Lines -> IO ())) => Op (SetHistoryLines ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal (Lines b) = withRef simple_terminal $ \simple_terminalPtr -> setHistoryLines' simple_terminalPtr b +{# fun Fl_Simple_Terminal_get_history_lines as getHistoryLines' { id `Ptr ()'} -> `Int' #} +instance (impl ~ (IO Lines)) => Op (GetHistoryLines ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getHistoryLines' simple_terminalPtr >>= return . Lines +{# fun Fl_Simple_Terminal_set_normal_style_index as setNormalStyleIndex' { id `Ptr ()', `Int' } -> `()' #} +instance (impl ~ (AtIndex -> IO ())) => Op (SetNormalStyleIndex ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal (AtIndex b) = withRef simple_terminal $ \simple_terminalPtr -> setNormalStyleIndex' simple_terminalPtr b +{# fun Fl_Simple_Terminal_get_normal_style_index as getNormalStyleIndex' { id `Ptr ()'} -> `Int' #} +instance (impl ~ (IO AtIndex)) => Op (GetNormalStyleIndex ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getNormalStyleIndex' simple_terminalPtr >>= return . AtIndex +{# fun Fl_Simple_Terminal_set_current_style_index as setCurrentStyleIndex' { id `Ptr ()', `Int' } -> `()' #} +instance (impl ~ (AtIndex -> IO ())) => Op (SetCurrentStyleIndex ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal (AtIndex b) = withRef simple_terminal $ \simple_terminalPtr -> setCurrentStyleIndex' simple_terminalPtr b +{# fun Fl_Simple_Terminal_get_current_style_index as getCurrentStyleIndex' { id `Ptr ()'} -> `Int' #} +instance (impl ~ (IO AtIndex)) => Op (GetCurrentStyleIndex ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getCurrentStyleIndex' simple_terminalPtr >>= return . AtIndex +{# fun Fl_Simple_Terminal_set_text as setText' { id `Ptr ()',unsafeToCString `T.Text' } -> `()' #} +instance (impl ~ (T.Text -> IO ())) => Op (SetText ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal val = withRef simple_terminal $ \simple_terminalPtr -> setText' simple_terminalPtr val +{# fun Fl_Simple_Terminal_get_text as getText' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} +instance (impl ~ ( IO T.Text)) => Op (GetText ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getText' simple_terminalPtr +{# fun Fl_Simple_Terminal_clear as clear'' { id `Ptr ()' } -> `()' #} +instance (impl ~ ( IO ())) => Op (Clear ()) SimpleTerminal orig impl where + runOp _ _ simpleTerminal = withRef simpleTerminal $ \simpleTerminalPtr -> clear'' simpleTerminalPtr +{# fun Fl_Simple_Terminal_remove_lines as removeLines' { id `Ptr ()', `Int', `Int' } -> `()' #} +instance (impl ~ (LineNumber -> LineNumber -> IO ())) => Op (RemoveLines ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal (LineNumber start) (LineNumber count) = withRef simple_terminal $ \simple_terminalPtr -> removeLines' simple_terminalPtr start count +{# fun Fl_Simple_Terminal_set_style_table as setStyleTable' { id `Ptr ()',id `Ptr ()',`Int', `Int'} -> `()' #} +instance (impl ~ ([StyleTableEntry] -> Maybe Int -> IO ())) => Op (SetStyleTable()) SimpleTerminal orig impl where + runOp _ _ simple_terminal styleTable normal_style_index = + withRef simple_terminal $ \simple_terminalPtr -> do + stesPtr <- mkStyleTableEntriesPtr simple_terminal styleTable + setStyleTable' + simple_terminalPtr + (castPtr (Unsafe.unsafeForeignPtrToPtr stesPtr)) + (length styleTable) + (maybe 0 id normal_style_index) +{# fun Fl_Simple_Terminal_get_style_table_size as getStyleTableSize' { id `Ptr ()'} -> `Int' fromIntegral #} +instance (impl ~ (IO Int)) => Op (GetStyleTableSize ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = withRef simple_terminal $ \simple_terminalPtr -> getStyleTableSize' simple_terminalPtr +{# fun Fl_Simple_Terminal_get_style_table as getStyleTable' { id `Ptr ()'} -> `Ptr ()' #} +instance (impl ~ (IO (Maybe [StyleTableEntry]))) => Op (GetStyleTable ()) SimpleTerminal orig impl where + runOp _ _ simple_terminal = + withRef simple_terminal $ \simple_terminalPtr -> do + size <- getStyleTableSize simple_terminal + ptr <- getStyleTable' simple_terminalPtr + toStyleTableEntries size ptr + +{# fun Fl_Simple_Terminal_draw_super as drawSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} +instance (impl ~ ( IO ())) => Op (DrawSuper ()) SimpleTerminal orig impl where + runOp _ _ textDisplay = withRef textDisplay $ \textDisplayPtr -> drawSuper' textDisplayPtr +{# fun Fl_Simple_Terminal_handle_super as handleSuper' { id `Ptr ()',`Int' } -> `Int' #} +instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (HandleSuper ()) SimpleTerminal orig impl where + runOp _ _ textDisplay event = withRef textDisplay $ \textDisplayPtr -> handleSuper' textDisplayPtr (fromIntegral (fromEnum event)) >>= return . successOrUnknownEvent +{# fun Fl_Simple_Terminal_resize_super as resizeSuper' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `()' supressWarningAboutRes #} +instance (impl ~ (Rectangle -> IO ())) => Op (ResizeSuper ()) SimpleTerminal orig impl where + runOp _ _ textDisplay rectangle = + let (x_pos, y_pos, width, height) = fromRectangle rectangle + in withRef textDisplay $ \textDisplayPtr -> resizeSuper' textDisplayPtr x_pos y_pos width height +{# fun Fl_Simple_Terminal_hide_super as hideSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} +instance (impl ~ ( IO ())) => Op (HideSuper ()) SimpleTerminal orig impl where + runOp _ _ textDisplay = withRef textDisplay $ \textDisplayPtr -> hideSuper' textDisplayPtr +{# fun Fl_Simple_Terminal_show_super as showSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} +instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) SimpleTerminal orig impl where + runOp _ _ textDisplay = withRef textDisplay $ \textDisplayPtr -> showSuper' textDisplayPtr + +-- $hierarchy +-- @ +-- "Graphics.UI.FLTK.LowLevel.Widget" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.Group" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.TextDisplay" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.SimpleTerminal" +-- @ + +-- $functions +-- @ +-- clear :: 'Ref' 'SimpleTerminal' -> 'IO' () +-- +-- drawSuper :: 'Ref' 'SimpleTerminal' -> 'IO' () +-- +-- getAnsi :: 'Ref' 'SimpleTerminal' -> 'IO' 'Bool' +-- +-- getCurrentStyleIndex :: 'Ref' 'SimpleTerminal' -> 'IO' 'AtIndex' +-- +-- getHistoryLines :: 'Ref' 'SimpleTerminal' -> 'IO' 'Lines' +-- +-- getNormalStyleIndex :: 'Ref' 'SimpleTerminal' -> 'IO' 'AtIndex' +-- +-- getStayAtBottom :: 'Ref' 'SimpleTerminal' -> 'IO' 'Bool' +-- +-- getStyleTable :: 'Ref' 'SimpleTerminal' -> 'IO' ('Maybe' ['StyleTableEntry')] +-- +-- getStyleTableSize :: 'Ref' 'SimpleTerminal' -> 'IO' 'Int' +-- +-- getText :: 'Ref' 'SimpleTerminal' -> 'IO' 'T.Text' +-- +-- handleSuper :: 'Ref' 'SimpleTerminal' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- hideSuper :: 'Ref' 'SimpleTerminal' -> 'IO' () +-- +-- removeLines :: 'Ref' 'SimpleTerminal' -> 'LineNumber' -> 'LineNumber' -> 'IO' () +-- +-- resizeSuper :: 'Ref' 'SimpleTerminal' -> 'Rectangle' -> 'IO' () +-- +-- setAnsi :: 'Ref' 'SimpleTerminal' -> 'Bool' -> 'IO' () +-- +-- setCurrentStyleIndex :: 'Ref' 'SimpleTerminal' -> 'AtIndex' -> 'IO' () +-- +-- setHistoryLines :: 'Ref' 'SimpleTerminal' -> 'Lines' -> 'IO' () +-- +-- setNormalStyleIndex :: 'Ref' 'SimpleTerminal' -> 'AtIndex' -> 'IO' () +-- +-- setStayAtBottom :: 'Ref' 'SimpleTerminal' -> 'Bool' -> 'IO' () +-- +-- setText :: 'Ref' 'SimpleTerminal' -> 'T.Text' -> 'IO' () +-- +-- showWidgetSuper :: 'Ref' 'SimpleTerminal' -> 'IO' () +-- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/SingleWindow.chs b/src/Graphics/UI/FLTK/LowLevel/SingleWindow.chs --- a/src/Graphics/UI/FLTK/LowLevel/SingleWindow.chs +++ b/src/Graphics/UI/FLTK/LowLevel/SingleWindow.chs @@ -114,16 +114,15 @@ resize' windowPtr x_pos y_pos w_pos h_pos -- $functions -- @ --- -- destroy :: 'Ref' 'SingleWindow' -> 'IO' () -- -- drawSuper :: 'Ref' 'SingleWindow' -> 'IO' () -- -- flushSuper :: 'Ref' 'SingleWindow' -> 'IO' () -- --- handle :: 'Ref' 'SingleWindow' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handle :: 'Ref' 'SingleWindow' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- --- handleSuper :: 'Ref' 'SingleWindow' -> 'Int' -> 'IO' 'Int' +-- handleSuper :: 'Ref' 'SingleWindow' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'SingleWindow' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Slider.chs b/src/Graphics/UI/FLTK/LowLevel/Slider.chs --- a/src/Graphics/UI/FLTK/LowLevel/Slider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Slider.chs @@ -45,12 +45,13 @@ {# fun Fl_Slider_New_WithLabel as sliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} sliderNew :: Rectangle -> Maybe T.Text -> IO (Ref Slider) sliderNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> sliderNew' x_pos y_pos width height >>= - toRef - Just l -> sliderNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Slider_Destroy as sliderDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Slider orig impl where @@ -61,13 +62,13 @@ instance (impl ~ (Double -> Double -> IO ())) => Op (Bounds ()) Slider orig impl where runOp _ _ slider a b = withRef slider $ \sliderPtr -> bounds' sliderPtr a b {# fun Fl_Slider_scrollvalue as scrollvalue' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `Int' #} -instance (impl ~ (Int -> Int -> Int -> Int -> IO (Int))) => Op (Scrollvalue ()) Slider orig impl where - runOp _ _ slider pos slider_size first total = withRef slider $ \sliderPtr -> scrollvalue' sliderPtr pos slider_size first total +instance (impl ~ (Y -> Lines -> LineNumber -> Lines -> IO (Int))) => Op (Scrollvalue ()) Slider orig impl where + runOp _ _ slider (Y pos) (Lines slider_size) (LineNumber first) (Lines total) = withRef slider $ \sliderPtr -> scrollvalue' sliderPtr pos slider_size first total {# fun Fl_Slider_set_slider_size as setSliderSize' { id `Ptr ()' } -> `Float' #} -instance (impl ~ ( IO (Float))) => Op (SetSliderSize ()) Slider orig impl where - runOp _ _ slider = withRef slider $ \sliderPtr -> setSliderSize' sliderPtr +instance (impl ~ ( IO (Double))) => Op (GetSliderSize ()) Slider orig impl where + runOp _ _ slider = withRef slider $ \sliderPtr -> setSliderSize' sliderPtr >>= return . realToFrac {# fun Fl_Slider_slider_size as sliderSize' { id `Ptr ()',`Double' } -> `()' supressWarningAboutRes #} -instance (impl ~ (Double -> IO ())) => Op (GetSliderSize ()) Slider orig impl where +instance (impl ~ (Double -> IO ())) => Op (SetSliderSize ()) Slider orig impl where runOp _ _ slider v = withRef slider $ \sliderPtr -> sliderSize' sliderPtr v {# fun Fl_Slider_slider as slider' { id `Ptr ()' } -> `Boxtype' cToEnum #} instance (impl ~ ( IO (Boxtype))) => Op (GetSlider ()) Slider orig impl where @@ -129,7 +130,7 @@ -- -- getSlider :: 'Ref' 'Slider' -> 'IO' ('Boxtype') -- --- getSliderSize :: 'Ref' 'Slider' -> 'Double' -> 'IO' () +-- getSliderSize :: 'Ref' 'Slider' -> 'IO' ('Double') -- -- getType_ :: 'Ref' 'Slider' -> 'IO' ('SliderType') -- @@ -145,11 +146,11 @@ -- -- resizeSuper :: 'Ref' 'Slider' -> 'Rectangle' -> 'IO' () -- --- scrollvalue :: 'Ref' 'Slider' -> 'Int' -> 'Int' -> 'Int' -> 'Int' -> 'IO' ('Int') +-- scrollvalue :: 'Ref' 'Slider' -> 'Y' -> 'Lines' -> 'LineNumber' -> 'Lines' -> 'IO' ('Int') -- -- setSlider :: 'Ref' 'Slider' -> 'Boxtype' -> 'IO' () -- --- setSliderSize :: 'Ref' 'Slider' -> 'IO' ('Float') +-- setSliderSize :: 'Ref' 'Slider' -> 'Double' -> 'IO' () -- -- setType :: 'Ref' 'Slider' -> 'SliderType' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Spinner.chs b/src/Graphics/UI/FLTK/LowLevel/Spinner.chs --- a/src/Graphics/UI/FLTK/LowLevel/Spinner.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Spinner.chs @@ -56,12 +56,13 @@ {# fun Fl_Spinner_New_WithLabel as spinnerNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} spinnerNew :: Rectangle -> Maybe T.Text -> IO (Ref Spinner) spinnerNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> spinnerNew' x_pos y_pos width height >>= - toRef - Just l -> spinnerNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Spinner_set_textfont as setTextfont' { id `Ptr ()',cFromFont `Font' } -> `()' #} instance (impl ~ (Font -> IO ())) => Op (SetTextfont ()) Spinner orig impl where @@ -156,6 +157,13 @@ instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Spinner orig impl where runOp _ _ spinner = withRef spinner $ \spinnerPtr -> showSuper' spinnerPtr +{# fun Fl_Spinner_set_wrap as setWrap' { id `Ptr ()', cFromBool `Bool'} -> `()' supressWarningAboutRes #} +instance (impl ~ (Bool -> IO ())) => Op (SetWrap ()) Spinner orig impl where + runOp _ _ spinner r = withRef spinner $ \spinnerPtr -> setWrap' spinnerPtr r +{# fun Fl_Spinner_wrap as wrap' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (GetWrap ()) Spinner orig impl where + runOp _ _ spinner = withRef spinner $ \spinnerPtr -> wrap' spinnerPtr + -- $hierarchy -- @ -- @@ -193,6 +201,8 @@ -- -- getValue :: 'Ref' 'Spinner' -> 'IO' ('Double') -- +-- getWrap :: 'Ref' 'Spinner' -> 'IO' ('Bool') +-- -- handle :: 'Ref' 'Spinner' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- handleSuper :: 'Ref' 'Spinner' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) @@ -224,6 +234,8 @@ -- setType :: 'Ref' 'Spinner' -> 'SpinnerType' -> 'IO' () -- -- setValue :: 'Ref' 'Spinner' -> 'Double' -> 'IO' () +-- +-- setWrap :: 'Ref' 'Spinner' -> 'Bool' -> 'IO' () -- -- showWidget :: 'Ref' 'Spinner' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/SysMenuBar.chs b/src/Graphics/UI/FLTK/LowLevel/SysMenuBar.chs --- a/src/Graphics/UI/FLTK/LowLevel/SysMenuBar.chs +++ b/src/Graphics/UI/FLTK/LowLevel/SysMenuBar.chs @@ -48,12 +48,13 @@ {# fun Fl_Sys_Menu_Bar_New_WithLabel as sysMenuBarNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} sysMenuBarNew :: Rectangle -> Maybe T.Text -> IO (Ref SysMenuBar) sysMenuBarNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> sysMenuBarNew' x_pos y_pos width height >>= - toRef - Just l -> sysMenuBarNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Sys_Menu_Bar_Destroy as sysMenuBarDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (Destroy ()) SysMenuBar orig impl where runOp _ _ win = swapRef win $ \winPtr -> do @@ -63,25 +64,25 @@ instance (impl ~ (Int -> IO ())) => Op (Remove ()) SysMenuBar orig impl where runOp _ _ menu_ index' = withRef menu_ $ \menu_Ptr -> remove' menu_Ptr index' {# fun Fl_Sys_Menu_Bar_replace as replace' { id `Ptr ()',`Int', unsafeToCString `T.Text' } -> `()' #} -instance (impl ~ (Int -> T.Text -> IO ())) => Op (Replace ()) SysMenuBar orig impl where - runOp _ _ menu_ index' name = withRef menu_ $ \menu_Ptr -> replace' menu_Ptr index' name +instance (impl ~ (AtIndex -> T.Text -> IO ())) => Op (Replace ()) SysMenuBar orig impl where + runOp _ _ menu_ (AtIndex index') name = withRef menu_ $ \menu_Ptr -> replace' menu_Ptr index' name {# fun Fl_Sys_Menu_Bar_clear as clear' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Clear ()) SysMenuBar orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> clear' menu_Ptr {# fun Fl_Sys_Menu_Bar_clear_submenu as clearSubmenu' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (Int -> IO (Either OutOfRangeOrNotSubmenu ()))) => Op (ClearSubmenu ()) SysMenuBar orig impl where - runOp _ _ menu_ index' = withRef menu_ $ \menu_Ptr -> clearSubmenu' menu_Ptr index' >>= return . successOrOutOfRangeOrNotSubmenu +instance (impl ~ (AtIndex -> IO (Either OutOfRangeOrNotSubmenu ()))) => Op (ClearSubmenu ()) SysMenuBar orig impl where + runOp _ _ menu_ (AtIndex index') = withRef menu_ $ \menu_Ptr -> clearSubmenu' menu_Ptr index' >>= return . successOrOutOfRangeOrNotSubmenu {# fun Fl_Sys_Menu_Bar_shortcut as shortcut' { id `Ptr ()',`Int',id `CInt' } -> `()' #} -instance (impl ~ (Int -> ShortcutKeySequence -> IO ())) => Op (SetShortcut ()) SysMenuBar orig impl where - runOp _ _ menu_ index' (ShortcutKeySequence modifiers char) = +instance (impl ~ (AtIndex -> ShortcutKeySequence -> IO ())) => Op (SetShortcut ()) SysMenuBar orig impl where + runOp _ _ menu_ (AtIndex index') (ShortcutKeySequence modifiers char) = withRef menu_ $ \menu_Ptr -> shortcut' menu_Ptr index' (keySequenceToCInt modifiers char) {# fun Fl_Sys_Menu_Bar_set_mode as setMode' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ (Int -> MenuItemFlags -> IO ())) => Op (SetMode ()) SysMenuBar orig impl where - runOp _ _ menu_ i fl = withRef menu_ $ \menu_Ptr -> setMode' menu_Ptr i (menuItemFlagsToInt fl) +instance (impl ~ (AtIndex -> MenuItemFlags -> IO ())) => Op (SetMode ()) SysMenuBar orig impl where + runOp _ _ menu_ (AtIndex i) fl = withRef menu_ $ \menu_Ptr -> setMode' menu_Ptr i (menuItemFlagsToInt fl) {# fun Fl_Sys_Menu_Bar_mode as mode' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (Int -> IO (Maybe MenuItemFlags))) => Op (GetMode ()) SysMenuBar orig impl where - runOp _ _ menu_ i = withRef menu_ $ \menu_Ptr -> mode' menu_Ptr i >>= return . intToMenuItemFlags +instance (impl ~ (AtIndex -> IO (Maybe MenuItemFlags))) => Op (GetMode ()) SysMenuBar orig impl where + runOp _ _ menu_ (AtIndex i) = withRef menu_ $ \menu_Ptr -> mode' menu_Ptr i >>= return . intToMenuItemFlags {# fun Fl_Sys_Menu_Bar_global as global' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Global ()) SysMenuBar orig impl where runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> global' menu_Ptr @@ -98,14 +99,14 @@ {# fun Fl_Sys_Menu_Bar_add_with_flags as addWithFlags' { id `Ptr ()',unsafeToCString `T.Text',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} {# fun Fl_Sys_Menu_Bar_add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `T.Text', unsafeToCString `T.Text',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} -instance (Parent a MenuItem, impl ~ ( T.Text -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) SysMenuBar orig (impl) where +instance (Parent a MenuItem, impl ~ ( T.Text -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Add ()) SysMenuBar orig (impl) where runOp _ _ menu_ name shortcut cb flags = addMenuItem (Left (safeCast menu_)) name shortcut cb flags addWithFlags' addWithShortcutnameFlags' {# fun Fl_Sys_Menu_Bar_insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',unsafeToCString `T.Text',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Sys_Menu_Bar_insert_with_shortcutname_flags as insertWithShortcutnameFlags' { id `Ptr ()',`Int',unsafeToCString `T.Text', unsafeToCString `T.Text',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} -instance (Parent a MenuPrim, impl ~ ( Int -> T.Text -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) SysMenuBar orig impl where - runOp _ _ menu_ index' name shortcut cb flags = insertMenuItem (safeCast menu_) index' name shortcut cb flags insertWithFlags' insertWithShortcutnameFlags' +instance (Parent a MenuPrim, impl ~ ( AtIndex -> T.Text -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (AtIndex))) => Op (Insert ()) SysMenuBar orig impl where + runOp _ _ menu_ (AtIndex index') name shortcut cb flags = insertMenuItem (safeCast menu_) index' name shortcut cb flags insertWithFlags' insertWithShortcutnameFlags' {# fun Fl_Sys_Menu_Bar_draw as draw'' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Draw ()) SysMenuBar orig impl where runOp _ _ sysMenuBar = withRef sysMenuBar $ \sysMenuBarPtr -> draw'' sysMenuBarPtr @@ -143,13 +144,13 @@ -- $functions -- @ --- add:: ('Parent' a 'MenuItem') => 'Ref' 'SysMenuBar' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a-> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex') +-- add:: ('Parent' a 'MenuItem') => 'Ref' 'SysMenuBar' -> 'T.Text' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a-> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex') -- -- addName :: 'Ref' 'SysMenuBar' -> 'T.Text' -> 'IO' () -- -- clear :: 'Ref' 'SysMenuBar' -> 'IO' () -- --- clearSubmenu :: 'Ref' 'SysMenuBar' -> 'Int' -> 'IO' ('Either' 'OutOfRangeOrNotSubmenu' ()) +-- clearSubmenu :: 'Ref' 'SysMenuBar' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRangeOrNotSubmenu' ()) -- -- destroy :: 'Ref' 'SysMenuBar' -> 'IO' () -- @@ -157,7 +158,7 @@ -- -- drawSuper :: 'Ref' 'SysMenuBar' -> 'IO' () -- --- getMode :: 'Ref' 'SysMenuBar' -> 'Int' -> 'IO' ('Maybe' 'MenuItemFlags') +-- getMode :: 'Ref' 'SysMenuBar' -> 'AtIndex' -> 'IO' ('Maybe' 'MenuItemFlags') -- -- global :: 'Ref' 'SysMenuBar' -> 'IO' () -- @@ -169,11 +170,11 @@ -- -- hideSuper :: 'Ref' 'SysMenuBar' -> 'IO' () -- --- insert:: ('Parent' a 'MenuPrim') => 'Ref' 'SysMenuBar' -> 'Int' -> 'T.Text' -> 'Maybe' 'Shortcut' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex') +-- insert:: ('Parent' a 'MenuPrim') => 'Ref' 'SysMenuBar' -> 'AtIndex' -> 'T.Text' -> 'Maybe' 'Shortcut' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('AtIndex') -- -- remove :: 'Ref' 'SysMenuBar' -> 'Int' -> 'IO' () -- --- replace :: 'Ref' 'SysMenuBar' -> 'Int' -> 'T.Text' -> 'IO' () +-- replace :: 'Ref' 'SysMenuBar' -> 'AtIndex' -> 'T.Text' -> 'IO' () -- -- resize :: 'Ref' 'SysMenuBar' -> 'Rectangle' -> 'IO' () -- @@ -181,9 +182,9 @@ -- -- setMenu :: 'Ref' 'SysMenuBar' -> ['Ref' 'MenuItem'] -> 'IO' () -- --- setMode :: 'Ref' 'SysMenuBar' -> 'Int' -> 'MenuItemFlags' -> 'IO' () +-- setMode :: 'Ref' 'SysMenuBar' -> 'AtIndex' -> 'MenuItemFlags' -> 'IO' () -- --- setShortcut :: 'Ref' 'SysMenuBar' -> 'Int' -> 'ShortcutKeySequence' -> 'IO' () +-- setShortcut :: 'Ref' 'SysMenuBar' -> 'AtIndex' -> 'ShortcutKeySequence' -> 'IO' () -- -- showWidget :: 'Ref' 'SysMenuBar' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Table.chs b/src/Graphics/UI/FLTK/LowLevel/Table.chs --- a/src/Graphics/UI/FLTK/LowLevel/Table.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Table.chs @@ -8,7 +8,8 @@ CustomTableFuncs(..), mkSetInt, mkDrawCell, - toSetIntPrim, + toSetRowsPrim, + toSetColumnsPrim, toDrawCellPrim, fillCustomTableFunctionStruct, defaultCustomTableFuncs, @@ -39,8 +40,6 @@ data Column = Column Int data TableCoordinate = TableCoordinate Row Column foreign import ccall "wrapper" - mkSetInt :: (Ptr () -> CInt -> IO ())-> IO (FunPtr (Ptr () -> CInt -> IO ())) -foreign import ccall "wrapper" mkDrawCell :: (Ptr () -> CInt -> CInt -> CInt -> @@ -53,15 +52,24 @@ CInt -> CInt -> CInt -> CInt -> IO ())) -toSetIntPrim :: (Ref a -> Int -> IO ()) -> IO (FunPtr (Ptr () -> CInt -> IO ())) -toSetIntPrim f = +toSetRowsPrim :: (Ref a -> Rows -> IO ()) -> IO (FunPtr (Ptr () -> CInt -> IO ())) +toSetRowsPrim f = mkSetInt ( \ptr num' -> do - pp <- wrapNonNull ptr "Null pointer. toSetIntPrim" - f (wrapInRef pp) (fromIntegral num') + pp <- wrapNonNull ptr "Null pointer. toSetRowsPrim" + f (wrapInRef pp) (Rows (fromIntegral num')) ) +toSetColumnsPrim :: (Ref a -> Columns -> IO ()) -> IO (FunPtr (Ptr () -> CInt -> IO ())) +toSetColumnsPrim f = + mkSetInt + ( + \ptr num' -> do + pp <- wrapNonNull ptr "Null pointer. toSetColumnsPrim" + f (wrapInRef pp) (Columns (fromIntegral num')) + ) + toDrawCellPrim :: (Ref a -> TableContext -> TableCoordinate -> Rectangle -> IO ()) -> IO (FunPtr (Ptr () -> CInt -> @@ -86,8 +94,8 @@ CustomTableFuncs { clearCustom :: Maybe (Ref a -> IO ()) - ,setRowsCustom :: Maybe (Ref a -> Int -> IO ()) - ,setColsCustom :: Maybe (Ref a -> Int -> IO ()) + ,setRowsCustom :: Maybe (Ref a -> Rows -> IO ()) + ,setColsCustom :: Maybe (Ref a -> Columns -> IO ()) } fillCustomTableFunctionStruct :: forall a. (Parent a Table) => @@ -98,8 +106,8 @@ fillCustomTableFunctionStruct structPtr _drawCell' (CustomTableFuncs _clear' _setRows' _setCols') = do toDrawCellPrim `orNullFunPtr` _drawCell' >>= {#set fl_Table_Virtual_Funcs->draw_cell#} structPtr toCallbackPrim `orNullFunPtr` _clear' >>= {#set fl_Table_Virtual_Funcs->clear#} structPtr - toSetIntPrim `orNullFunPtr` _setRows' >>= {#set fl_Table_Virtual_Funcs->set_rows#} structPtr - toSetIntPrim `orNullFunPtr` _setCols' >>= {#set fl_Table_Virtual_Funcs->set_cols#} structPtr + toSetRowsPrim `orNullFunPtr` _setRows' >>= {#set fl_Table_Virtual_Funcs->set_rows#} structPtr + toSetColumnsPrim `orNullFunPtr` _setCols' >>= {#set fl_Table_Virtual_Funcs->set_cols#} structPtr defaultCustomTableFuncs :: forall a. (Parent a Table) => CustomTableFuncs a defaultCustomTableFuncs = CustomTableFuncs Nothing Nothing Nothing @@ -146,17 +154,17 @@ instance (impl ~ ( IO (Boxtype))) => Op (GetTableBox ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> tableBox' tablePtr {# fun Fl_Table_set_rows as setRows' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SetRows ()) Table orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setRows' tablePtr val +instance (impl ~ ( Rows -> IO ())) => Op (SetRows ()) Table orig impl where + runOp _ _ table (Rows val) = withRef table $ \tablePtr -> setRows' tablePtr val {# fun Fl_Table_rows as rows' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetRows ()) Table orig impl where - runOp _ _ table = withRef table $ \tablePtr -> rows' tablePtr +instance (impl ~ ( IO (Rows))) => Op (GetRows ()) Table orig impl where + runOp _ _ table = withRef table $ \tablePtr -> rows' tablePtr >>= return . Rows {# fun Fl_Table_set_cols as setCols' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SetCols ()) Table orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setCols' tablePtr val +instance (impl ~ ( Columns -> IO ())) => Op (SetCols ()) Table orig impl where + runOp _ _ table (Columns val) = withRef table $ \tablePtr -> setCols' tablePtr val {# fun Fl_Table_cols as cols' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetCols ()) Table orig impl where - runOp _ _ table = withRef table $ \tablePtr -> cols' tablePtr +instance (impl ~ ( IO (Columns))) => Op (GetCols ()) Table orig impl where + runOp _ _ table = withRef table $ \tablePtr -> cols' tablePtr >>= return . Columns {# fun Fl_Table_visible_cells as visibleCells' { id `Ptr ()',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*} -> `()' #} instance (impl ~ (IO (TableCoordinate,TableCoordinate))) => Op (GetVisibleCells ()) Table orig impl where runOp _ _ table = @@ -272,8 +280,10 @@ getSelection' tablePtr >>= \(top', left',bottom',right') -> return ((TableCoordinate (Row top') (Column left')), (TableCoordinate (Row bottom') (Column right'))) {# fun Fl_Table_set_selection as setSelection' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `()' #} -instance (impl ~ ( Int -> Int -> Int -> Int -> IO ())) => Op (SetSelection ()) Table orig impl where - runOp _ _ table row_top col_left row_bot col_right = withRef table $ \tablePtr -> setSelection' tablePtr row_top col_left row_bot col_right +instance (impl ~ ( TableCoordinate -> TableCoordinate ->IO ())) => Op (SetSelection ()) Table orig impl where + runOp _ _ table (TableCoordinate (Row row_top) (Column col_left)) + (TableCoordinate (Row row_bot) (Column col_right)) = + withRef table $ \tablePtr -> setSelection' tablePtr row_top col_left row_bot col_right {# fun Fl_Table_move_cursor as moveCursor' { id `Ptr ()',`Int',`Int' } -> `Int' #} instance (impl ~ ( TableCoordinate -> IO (Either NoChange ()))) => Op (MoveCursor ()) Table orig impl where runOp _ _ table (TableCoordinate (Row r) (Column c)) = withRef table $ \tablePtr -> moveCursor' tablePtr r c >>= return . successOrNoChange @@ -284,10 +294,10 @@ instance (Parent a Widget, impl ~ (Ref a -> IO ())) => Op (Add ()) Table orig impl where runOp _ _ table wgt = withRef table $ \tablePtr -> withRef wgt $ \wgtPtr -> add' tablePtr wgtPtr {# fun Fl_Table_insert as insert' { id `Ptr ()',id `Ptr ()',`Int' } -> `()' #} -instance (Parent a Widget, impl ~ (Ref a -> Int -> IO ())) => Op (Insert ()) Table orig impl where - runOp _ _ table wgt n = withRef table $ \tablePtr -> withRef wgt $ \wgtPtr -> insert' tablePtr wgtPtr n +instance (Parent a Widget, impl ~ (Ref a -> AtIndex -> IO ())) => Op (Insert ()) Table orig impl where + runOp _ _ table wgt (AtIndex n) = withRef table $ \tablePtr -> withRef wgt $ \wgtPtr -> insert' tablePtr wgtPtr n {# fun Fl_Table_insert_with_widget as insertWithWidget' { id `Ptr ()',id `Ptr ()',id `Ptr ()' } -> `()' #} -instance (Parent a Widget, Parent b Widget, impl ~ (Ref a -> Ref b -> IO ())) => Op (InsertWithBefore ()) Table orig impl where +instance (Parent a Widget, Parent b Widget, impl ~ (Ref a -> Ref b -> IO ())) => Op (InsertBefore ()) Table orig impl where runOp _ _ self w before = withRef self $ \selfPtr -> withRef w $ \wPtr -> withRef before $ \beforePtr -> insertWithWidget' selfPtr wPtr beforePtr {# fun Fl_Table_begin as begin' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Begin ()) Table orig impl where @@ -302,8 +312,8 @@ numChildren <- children table arrayToRefs childArrayPtr numChildren {# fun Fl_Table_child as child' { id `Ptr ()',`Int' } -> `Ptr ()' id #} -instance (impl ~ ( Int -> IO (Maybe (Ref Widget)))) => Op (GetChild ()) Table orig impl where - runOp _ _ table n = withRef table $ \tablePtr -> child' tablePtr n >>= toMaybeRef +instance (impl ~ ( AtIndex -> IO (Maybe (Ref Widget)))) => Op (GetChild ()) Table orig impl where + runOp _ _ table (AtIndex n) = withRef table $ \tablePtr -> child' tablePtr n >>= toMaybeRef {# fun Fl_Table_children as children' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (Children ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> children' tablePtr @@ -352,11 +362,11 @@ instance (impl ~ ( IO ())) => Op (Clear ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> clear' tablePtr {# fun Fl_Table_set_rows_super as setRowsSuper' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SetRowsSuper ()) Table orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setRowsSuper' tablePtr val +instance (impl ~ ( Rows -> IO ())) => Op (SetRowsSuper ()) Table orig impl where + runOp _ _ table (Rows val) = withRef table $ \tablePtr -> setRowsSuper' tablePtr val {# fun Fl_Table_set_cols_super as setColsSuper' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SetColsSuper ()) Table orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setColsSuper' tablePtr val +instance (impl ~ ( Columns -> IO ())) => Op (SetColsSuper ()) Table orig impl where + runOp _ _ table (Columns val) = withRef table $ \tablePtr -> setColsSuper' tablePtr val {# fun Fl_Table_show_super as showSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Table orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> showSuper' widgetPtr @@ -370,9 +380,15 @@ instance (impl ~ ( IO ())) => Op (Hide ()) Table orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> hide' widgetPtr +{# fun Fl_Table_tab_cell_nav as tabCellNav' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (GetTabCellNav ()) Table orig impl where + runOp _ _ table = withRef table $ \tablePtr -> tabCellNav' tablePtr +{# fun Fl_Table_set_tab_cell_nav as setTabCellNav' { id `Ptr ()',cFromBool `Bool' } -> `()' #} +instance (impl ~ ( Bool -> IO ())) => Op (SetTabCellNav ()) Table orig impl where + runOp _ _ table val = withRef table $ \tablePtr -> setTabCellNav' tablePtr val + -- $Tablefunctions -- @ --- -- add:: ('Parent' a 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'IO' () -- -- begin :: 'Ref' 'Table' -> 'IO' () @@ -405,7 +421,7 @@ -- -- getArray :: 'Ref' 'Table' -> 'IO' ['Ref' 'Widget'] -- --- getChild :: 'Ref' 'Table' -> 'Int' -> 'IO' ('Maybe' ('Ref' 'Widget')) +-- getChild :: 'Ref' 'Table' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- -- getColHeader :: 'Ref' 'Table' -> 'IO' ('Bool') -- @@ -421,7 +437,7 @@ -- -- getColWidth :: 'Ref' 'Table' -> 'Column' -> 'IO' ('Int') -- --- getCols :: 'Ref' 'Table' -> 'IO' ('Int') +-- getCols :: 'Ref' 'Table' -> 'IO' ('Columns') -- -- getRowHeader :: 'Ref' 'Table' -> 'IO' 'Bool' -- @@ -437,17 +453,19 @@ -- -- getRowResizeMin :: 'Ref' 'Table' -> 'IO' ('Int') -- --- getRows :: 'Ref' 'Table' -> 'IO' ('Int') +-- getRows :: 'Ref' 'Table' -> 'IO' ('Rows') -- -- getSelection :: 'Ref' 'Table' -> 'IO' ('TableCoordinate', 'TableCoordinate') -- +-- getTabCellNav :: 'Ref' 'Table' -> 'IO' ('Bool') +-- -- getTableBox :: 'Ref' 'Table' -> 'IO' ('Boxtype') -- -- getTopRow :: 'Ref' 'Table' -> 'IO' ('Row') -- -- getVisibleCells :: 'Ref' 'Table' -> 'IO' ('TableCoordinate,TableCoordinate') -- --- handle :: 'Ref' 'Table' -> 'Event' -> 'IO' ( 'Either' 'UnknownEvent' () ) +-- handle :: 'Ref' 'Table' -> 'Event' -> 'IO'( 'Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'Table' -> 'IO' () -- @@ -455,9 +473,9 @@ -- -- initSizes :: 'Ref' 'Table' -> 'IO' () -- --- insert:: ('Parent' a 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'Int' -> 'IO' () +-- insert:: ('Parent' a 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'AtIndex' -> 'IO' () -- --- insertWithBefore:: ('Parent' a 'Widget', 'Parent' b 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'Ref' b -> 'IO' () +-- insertBefore:: ('Parent' a 'Widget', 'Parent' b 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'Ref' b -> 'IO' () -- -- isInteractiveResize :: 'Ref' 'Table' -> 'IO' ('Bool') -- @@ -485,9 +503,9 @@ -- -- setColWidthAll :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- --- setCols :: 'Ref' 'Table' -> 'Int' -> 'IO' () +-- setCols :: 'Ref' 'Table' -> 'Columns' -> 'IO' () -- --- setColsSuper :: 'Ref' 'Table' -> 'Int' -> 'IO' () +-- setColsSuper :: 'Ref' 'Table' -> 'Columns' -> 'IO' () -- -- setRowHeader :: 'Ref' 'Table' -> 'Bool' -> 'IO' () -- @@ -505,12 +523,14 @@ -- -- setRowResizeMin :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- --- setRows :: 'Ref' 'Table' -> 'Int' -> 'IO' () +-- setRows :: 'Ref' 'Table' -> 'Rows' -> 'IO' () -- --- setRowsSuper :: 'Ref' 'Table' -> 'Int' -> 'IO' () +-- setRowsSuper :: 'Ref' 'Table' -> 'Rows' -> 'IO' () -- --- setSelection :: 'Ref' 'Table' -> 'Int' -> 'Int' -> 'Int' -> 'Int' -> 'IO' () +-- setSelection :: 'Ref' 'Table' -> 'TableCoordinate' -> 'TableCoordinate' ->'IO' () -- +-- setTabCellNav :: 'Ref' 'Table' -> 'Bool' -> 'IO' () +-- -- setTableBox :: 'Ref' 'Table' -> 'Boxtype' -> 'IO' () -- -- setTopRow :: 'Ref' 'Table' -> 'Row' -> 'IO' () @@ -518,7 +538,6 @@ -- showWidget :: 'Ref' 'Table' -> 'IO' () -- -- showWidgetSuper :: 'Ref' 'Table' -> 'IO' () --- -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/TableRow.chs b/src/Graphics/UI/FLTK/LowLevel/TableRow.chs --- a/src/Graphics/UI/FLTK/LowLevel/TableRow.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TableRow.chs @@ -38,14 +38,18 @@ ptr <- tableCustomFunctionStruct draw' (Just drawCell') customWidgetFuncs' customTableFuncs' case label' of (Just l') -> tableRowNewWithLabel' x_pos y_pos width height l' ptr >>= toRef - Nothing -> tableRowNew' x_pos y_pos width height ptr >>= toRef + Nothing -> do + ref <- tableRowNew' x_pos y_pos width height ptr >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Table_Row_Destroy as tableRowDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) TableRow orig impl where runOp _ _ tableRow = withRef tableRow $ \tableRowPtr -> tableRowDestroy' tableRowPtr {# fun Fl_Table_Row_rows as rows' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetRows ()) TableRow orig impl where - runOp _ _ tableRow = withRef tableRow $ \tableRowPtr -> rows' tableRowPtr +instance (impl ~ ( IO (Rows))) => Op (GetRows ()) TableRow orig impl where + runOp _ _ tableRow = withRef tableRow $ \tableRowPtr -> rows' tableRowPtr >>= return . Rows {# fun Fl_Table_Row_set_type as tableRowSetType' { id `Ptr ()', cFromEnum `TableRowSelectMode'} -> `()' #} instance (impl ~ (TableRowSelectMode -> IO ())) => Op (SetType ()) TableRow orig impl where runOp _ _ tableRow selectionMode = withRef tableRow $ \tableRowPtr' -> tableRowSetType' tableRowPtr' selectionMode @@ -53,11 +57,11 @@ instance (impl ~ (IO TableRowSelectMode)) => Op (GetType_ ()) TableRow orig impl where runOp _ _ tableRow = withRef tableRow $ \tableRowPtr' -> tableRowType tableRowPtr' {# fun Fl_Table_Row_set_rows as setRows' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetRows ()) TableRow orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setRows' tablePtr val +instance (impl ~ (Rows -> IO ())) => Op (SetRows ()) TableRow orig impl where + runOp _ _ table (Rows val) = withRef table $ \tablePtr -> setRows' tablePtr val {# fun Fl_Table_Row_set_cols as setCols' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetCols ()) TableRow orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setCols' tablePtr val +instance (impl ~ (Columns -> IO ())) => Op (SetCols ()) TableRow orig impl where + runOp _ _ table (Columns val) = withRef table $ \tablePtr -> setCols' tablePtr val {# fun Fl_Table_Row_clear_super as clearSuper' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (ClearSuper ()) TableRow orig impl where runOp _ _ table = withRef table $ \tablePtr -> clearSuper' tablePtr @@ -65,11 +69,11 @@ instance (impl ~ ( IO ())) => Op (Clear ()) TableRow orig impl where runOp _ _ table = withRef table $ \tablePtr -> clear' tablePtr {# fun Fl_Table_Row_set_rows_super as setRowsSuper' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetRowsSuper ()) TableRow orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setRowsSuper' tablePtr val +instance (impl ~ (Rows -> IO ())) => Op (SetRowsSuper ()) TableRow orig impl where + runOp _ _ table (Rows val) = withRef table $ \tablePtr -> setRowsSuper' tablePtr val {# fun Fl_Table_Row_set_cols_super as setColsSuper' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (Int -> IO ())) => Op (SetColsSuper ()) TableRow orig impl where - runOp _ _ table val = withRef table $ \tablePtr -> setColsSuper' tablePtr val +instance (impl ~ (Columns -> IO ())) => Op (SetColsSuper ()) TableRow orig impl where + runOp _ _ table (Columns val) = withRef table $ \tablePtr -> setColsSuper' tablePtr val {# fun Fl_Table_Row_handle_super as handleSuper' { id `Ptr ()', cFromEnum `Event' } -> `Int' #} instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (HandleSuper ()) TableRow orig impl where runOp _ _ table event = withRef table $ \tablePtr -> handleSuper' tablePtr event >>= return . successOrUnknownEvent @@ -83,8 +87,8 @@ instance (impl ~ (Rectangle -> IO ())) => Op (Resize ()) TableRow orig impl where runOp _ _ table rectangle = let (x_pos', y_pos', width', height') = fromRectangle rectangle in withRef table $ \tablePtr -> resize' tablePtr x_pos' y_pos' width' height' {# fun Fl_Table_Row_row_selected as rowSelected' { id `Ptr ()', `Int'} -> `CInt' id #} -instance (impl ~ ( Int -> IO (Either OutOfRange Bool))) => Op (GetRowSelected ()) TableRow orig impl where - runOp _ _ table idx' = withRef table $ \tablePtr -> do +instance (impl ~ ( Row -> IO (Either OutOfRange Bool))) => Op (GetRowSelected ()) TableRow orig impl where + runOp _ _ table (Row idx') = withRef table $ \tablePtr -> do ret' <- rowSelected' tablePtr idx' if ret' == -1 then (return $ Left OutOfRange) else (return $ Right $ cToBool ret') {# fun Fl_Table_Row_select_all_rows_with_flag as selectAllRows' {id `Ptr ()', `Int'} -> `()' #} @@ -126,9 +130,9 @@ -- -- drawSuper :: 'Ref' 'TableRow' -> 'IO' () -- --- getRowSelected :: 'Ref' 'TableRow' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'Bool') +-- getRowSelected :: 'Ref' 'TableRow' -> 'Row' -> 'IO' ('Either' 'OutOfRange' 'Bool') -- --- getRows :: 'Ref' 'TableRow' -> 'IO' ('Int') +-- getRows :: 'Ref' 'TableRow' -> 'IO' ('Rows') -- -- getType_ :: 'Ref' 'TableRow' -> 'IO' 'TableRowSelectMode' -- @@ -146,20 +150,19 @@ -- -- selectAllRows :: 'Ref' 'TableRow' -> 'TableRowSelectFlag' -> 'IO' () -- --- setCols :: 'Ref' 'TableRow' -> 'Int' -> 'IO' () +-- setCols :: 'Ref' 'TableRow' -> 'Columns' -> 'IO' () -- --- setColsSuper :: 'Ref' 'TableRow' -> 'Int' -> 'IO' () +-- setColsSuper :: 'Ref' 'TableRow' -> 'Columns' -> 'IO' () -- --- setRows :: 'Ref' 'TableRow' -> 'Int' -> 'IO' () +-- setRows :: 'Ref' 'TableRow' -> 'Rows' -> 'IO' () -- --- setRowsSuper :: 'Ref' 'TableRow' -> 'Int' -> 'IO' () +-- setRowsSuper :: 'Ref' 'TableRow' -> 'Rows' -> 'IO' () -- -- setType :: 'Ref' 'TableRow' -> 'TableRowSelectMode' -> 'IO' () -- -- showWidget :: 'Ref' 'TableRow' -> 'IO' () -- -- showWidgetSuper :: 'Ref' 'TableRow' -> 'IO' () --- -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/Tabs.chs b/src/Graphics/UI/FLTK/LowLevel/Tabs.chs --- a/src/Graphics/UI/FLTK/LowLevel/Tabs.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Tabs.chs @@ -1,10 +1,11 @@ -{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-} +{-# LANGUAGE OverloadedStrings, CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.Tabs ( tabsNew, tabsCustom, - TabsHeightOffset(..) + TabsHeightOffset(..), + CustomTabFuncs(..) -- * Hierarchy -- -- $hierarchy @@ -28,25 +29,98 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy data TabsHeightOffset = TabsAtTop (Maybe Int) | TabsAtBottom (Maybe Int) +tabsHeightOffsetToInt :: TabsHeightOffset -> Int +tabsHeightOffsetToInt h = + case h of + TabsAtTop Nothing -> 0 + TabsAtTop (Just o) -> o + TabsAtBottom Nothing -> (-1) + TabsAtBottom (Just o) -> (-o) -{# fun Fl_OverriddenTabs_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenTabs_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} -tabsCustom :: - Rectangle -- ^ The bounds of this Tabs - -> Maybe T.Text -- ^ The Tabs label - -> Maybe (Ref Tabs -> IO ()) -- ^ Optional custom drawing function - -> Maybe (CustomWidgetFuncs Tabs) -- ^ Optional custom widget functions - -> IO (Ref Tabs) -tabsCustom rectangle l' draw' funcs' = - widgetMaker - rectangle - l' - draw' - funcs' - overriddenWidgetNew' - overriddenWidgetNewWithLabel' +intToTabsHeightOffset :: Int -> TabsHeightOffset +intToTabsHeightOffset tabh = + case tabh of + _ | tabh == 0 -> TabsAtTop Nothing + | tabh == (-1) -> TabsAtBottom Nothing + | tabh > 0 -> TabsAtTop (Just (fromIntegral tabh)) + | otherwise -> TabsAtBottom (Just (fromIntegral tabh)) +data CustomTabFuncs a = + CustomTabFuncs + { + tabDrawCustom :: Ref a -> IO () + , tabPositionsCustom :: Ref a -> IO (Maybe AtIndex, Int, [(X,Width)]) + , tabHeightCustom :: Ref a -> IO Height + , tabWhichCustom :: Ref a -> Position -> IO (Maybe (AtIndex, Ref Widget)) + , tabRedrawTabs :: Ref a -> IO () + , tabClientArea :: Ref a -> TabsHeightOffset -> IO Rectangle + } +toTabClientAreaPrim :: (Ref a -> TabsHeightOffset -> IO Rectangle) -> IO (FunPtr TabClientAreaPrim) +toTabClientAreaPrim f = + mkTabClientAreaPrim (\tabPtr xPtr yPtr wPtr hPtr tabh -> do + pp <- wrapNonNull tabPtr "Null pointer. toTabClientAreaPrim" + rect <- f (castTo (wrapInRef pp)) (intToTabsHeightOffset (fromIntegral tabh)) + let (clientX, clientY, clientW, clientH) = fromRectangle rect + poke xPtr (fromIntegral clientX) + poke yPtr (fromIntegral clientY) + poke wPtr (fromIntegral clientW) + poke hPtr (fromIntegral clientH)) + +{# fun Fl_Tab_default_virtual_funcs as virtualFuncs' {} -> `Ptr ()' id #} + +toTabWhichPrim :: + (Ref a -> Position -> IO (Maybe (AtIndex, Ref Widget))) -> + IO (FunPtr TabWhichPrim) +toTabWhichPrim f = + mkTabWhichPrim (\ptr event_x event_y -> do + pp <- wrapNonNull ptr "Null pointer. toTabWhichPrim" + res <- f (castTo (wrapInRef pp)) (Position (X (fromIntegral event_x)) (Y (fromIntegral event_y))) + maybe (return nullPtr) (\(_,ref) -> unsafeRefToPtr ref) res + ) + +customTabFunctionStruct :: + (Parent a Tabs) => + (Ref a -> IO ()) -> + (Ref a -> IO (Maybe AtIndex, Int, [(X,Width)])) -> + (Ref a -> IO Height) -> + (Ref a -> Position -> IO (Maybe (AtIndex, Ref Widget))) -> + (Ref a -> IO ()) -> + (Ref a -> TabsHeightOffset -> IO Rectangle) -> + IO (Ptr()) +customTabFunctionStruct tabDrawCustom' tabPositionsCustom' tabHeightCustom' tabWhichCustom' tabRedrawTabs' tabClientArea' = + do + structPtr <- virtualFuncs' + toCallbackPrim tabDrawCustom' >>= {#set fl_Tab_Virtual_Funcs->tab_draw #} structPtr + toTabPositionsPrim tabPositionsCustom' >>= {#set fl_Tab_Virtual_Funcs->tab_positions #} structPtr + toTabHeightPrim tabHeightCustom' >>= {#set fl_Tab_Virtual_Funcs->tab_height #} structPtr + toTabWhichPrim tabWhichCustom' >>= {#set fl_Tab_Virtual_Funcs->tab_which #} structPtr + toCallbackPrim tabRedrawTabs' >>= {#set fl_Tab_Virtual_Funcs->redraw_tabs #} structPtr + toTabClientAreaPrim tabClientArea' >>= {#set fl_Tab_Virtual_Funcs->tab_client_area #} structPtr + return structPtr + +{# fun Fl_OverriddenTabs_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()', id `Ptr ()'} -> `Ptr ()' id #} +tabsCustom :: + Rectangle -- ^ The bounds of this Tabs + -> Maybe T.Text -- ^ The Tabs label + -> Maybe (CustomTabFuncs Tabs) -- ^ Optional custom tab drawing functions + -> Maybe (CustomWidgetFuncs Tabs) -- ^ Optional custom widget functions + -> IO (Ref Tabs) +tabsCustom rectangle l' tabFuncs' widgetFuncs' = + let (x_pos, y_pos, width, height) = fromRectangle rectangle + in do + tabFuncsPtr <- maybe virtualFuncs' + (\tfs -> customTabFunctionStruct + (tabDrawCustom tfs) + (tabPositionsCustom tfs) + (tabHeightCustom tfs) + (tabWhichCustom tfs) + (tabRedrawTabs tfs) + (tabClientArea tfs)) + tabFuncs' + widgetFuncsPtr <- customWidgetFunctionStruct (fmap tabDrawCustom tabFuncs') (maybe defaultCustomWidgetFuncs id widgetFuncs') + overriddenWidgetNewWithLabel' x_pos y_pos width height (maybe "" id l') tabFuncsPtr widgetFuncsPtr >>= toRef + {# fun Fl_Tabs_New as tabsNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Tabs_New_WithLabel as tabsNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} tabsNew :: Rectangle -> Maybe T.Text -> IO (Ref Tabs) @@ -54,8 +128,13 @@ let (x_pos, y_pos, width, height) = fromRectangle rectangle in case l' of Nothing -> tabsNew' x_pos y_pos width height >>= toRef - Just l -> tabsNewWithLabel' x_pos y_pos width height l >>= toRef + Just l -> do + ref <- tabsNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref + {# fun Fl_Tabs_value as value' { id `Ptr ()' } -> `Ptr ()' id #} instance (impl ~ (IO (Maybe (Ref Widget)))) => Op (GetValue ()) Tabs orig impl where runOp _ _ tabs = withRef tabs $ \tabsPtr -> value' tabsPtr >>= toMaybeRef @@ -80,11 +159,7 @@ instance (impl ~ (TabsHeightOffset -> IO Rectangle)) => Op (ClientArea ()) Tabs orig impl where runOp _ _ tabs tabh = withRef tabs $ \tabsPtr -> - case tabh of - TabsAtTop Nothing -> clientAreaWithTabh' tabsPtr 0 >>= return . toRectangle - TabsAtTop (Just o) -> clientAreaWithTabh' tabsPtr o >>= return . toRectangle - TabsAtBottom Nothing -> clientAreaWithTabh' tabsPtr (-1) >>= return . toRectangle - TabsAtBottom (Just o) -> clientAreaWithTabh' tabsPtr (0 - o) >>= return . toRectangle + clientAreaWithTabh' tabsPtr (tabsHeightOffsetToInt tabh) >>= return . toRectangle {# fun Fl_Tabs_draw as draw'' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Draw ()) Tabs orig impl where @@ -120,6 +195,18 @@ {# fun Fl_Tabs_show_super as showSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Tabs orig impl where runOp _ _ tabs = withRef tabs $ \tabsPtr -> showSuper' tabsPtr +{# fun Fl_Tabs_tab_positions as tabPositions' {id `Ptr ()'} -> `Int' #} +instance (impl ~ (IO AtIndex)) => Op (TabPositions ()) Tabs orig impl where + runOp _ _ tabs = withRef tabs $ \tabsPtr -> tabPositions' tabsPtr >>= return . AtIndex +{# fun Fl_Tabs_tab_height as tabHeight' {id `Ptr ()'} -> `Int' #} +instance (impl ~ (IO Height)) => Op (TabHeight ()) Tabs orig impl where + runOp _ _ tabs = withRef tabs $ \tabsPtr -> tabHeight' tabsPtr >>= return . Height +{# fun Fl_Tabs_get_tab_align as getTabAlign' { id `Ptr ()' } -> `AlignType' cToEnum #} +instance (impl ~ (IO (AlignType))) => Op (GetTabAlign ()) Tabs orig impl where + runOp _ _ tabs = withRef tabs $ \tabsPtr -> getTabAlign' tabsPtr +{# fun Fl_Tabs_set_tab_align as setTabAlign' { id `Ptr ()', cFromEnum `AlignType' } -> `()'#} +instance (impl ~ (AlignType -> IO ())) => Op (SetTabAlign ()) Tabs orig impl where + runOp _ _ tabs a = withRef tabs $ \tabsPtr -> setTabAlign' tabsPtr a -- $hierarchy -- @ @@ -136,15 +223,41 @@ -- @ -- clientArea :: 'Ref' 'Tabs' -> 'TabsHeightOffset' -> 'IO' 'Rectangle' -- +-- draw :: 'Ref' 'Tabs' -> 'IO' () +-- +-- drawSuper :: 'Ref' 'Tabs' -> 'IO' () +-- -- getPush :: 'Ref' 'Tabs' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- +-- getTabAlign :: 'Ref' 'Tabs' -> 'IO' ('AlignType') +-- -- getValue :: 'Ref' 'Tabs' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- --- handle :: 'Ref' 'Tabs' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handle :: 'Ref' 'Tabs' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- +-- handleSuper :: 'Ref' 'Tabs' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) +-- +-- hide :: 'Ref' 'Tabs' -> 'IO' () +-- +-- hideSuper :: 'Ref' 'Tabs' -> 'IO' () +-- +-- resize :: 'Ref' 'Tabs' -> 'Rectangle' -> 'IO' () +-- +-- resizeSuper :: 'Ref' 'Tabs' -> 'Rectangle' -> 'IO' () +-- -- setPush:: ('Parent' a 'Widget') => 'Ref' 'Tabs' -> 'Maybe' ( 'Ref' a ) -> 'IO' ('Either' 'NoChange' ()) -- +-- setTabAlign :: 'Ref' 'Tabs' -> 'AlignType' -> 'IO' () +-- -- setValue:: ('Parent' a 'Widget') => 'Ref' 'Tabs' -> 'Maybe' ( 'Ref' a ) -> 'IO' ('Either' 'NoChange' ()) +-- +-- showWidget :: 'Ref' 'Tabs' -> 'IO' () +-- +-- showWidgetSuper :: 'Ref' 'Tabs' -> 'IO' () +-- +-- tabHeight :: 'Ref' 'Tabs' -> 'IO' 'Height' +-- +-- tabPositions :: 'Ref' 'Tabs' -> 'IO' 'AtIndex' -- -- which :: 'Ref' 'Tabs' -> 'Position' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs b/src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs --- a/src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TextBuffer.chs @@ -27,12 +27,12 @@ {# fun Fl_Text_Buffer_New_With_PreferredGapSize as newPreferredGapSize' {`Int'} -> `Ptr ()' id #} {# fun Fl_Text_Buffer_New_With_RequestedSize_PreferredGapSize as newRequestedSizePreferredGapSize' {`Int', `Int'}-> `Ptr ()' id #} -textBufferNew :: Maybe Int -> Maybe Int -> IO (Ref TextBuffer) +textBufferNew :: Maybe PreferredSize -> Maybe GapSize -> IO (Ref TextBuffer) textBufferNew req' pref' = case (req',pref') of - (Just r', Just p') -> newRequestedSizePreferredGapSize' r' p' >>= toRef - (Just r', Nothing) -> newRequestedSize' r' >>= toRef - (Nothing, Just p') -> newPreferredGapSize' p' >>= toRef + (Just (PreferredSize r'), Just (GapSize p')) -> newRequestedSizePreferredGapSize' r' p' >>= toRef + (Just (PreferredSize r'), Nothing) -> newRequestedSize' r' >>= toRef + (Nothing, Just (GapSize p')) -> newPreferredGapSize' p' >>= toRef (Nothing, Nothing) -> new' >>= toRef {# fun Fl_Text_Buffer_Destroy as textbufferDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} @@ -56,51 +56,51 @@ instance ( impl ~ ( T.Text -> IO ())) => Op (SetText ()) TextBuffer orig impl where runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> setText' text_bufferPtr text {# fun Fl_Text_Buffer_text_range as textRange' { id `Ptr ()',`Int',`Int' } -> `T.Text' unsafeFromCString #} -instance ( impl ~ ( BufferRange -> IO T.Text)) => Op (TextRange ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> textRange' text_bufferPtr start' end' +instance ( impl ~ ( IndexRange -> IO T.Text)) => Op (TextRange ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex start') (AtIndex end')) = withRef text_buffer $ \text_bufferPtr -> textRange' text_bufferPtr start' end' {# fun Fl_Text_Buffer_char_at as charAt' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ ( BufferOffset -> IO (Char))) => Op (CharAt ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> charAt' text_bufferPtr pos >>= return . toEnum +instance ( impl ~ ( AtIndex -> IO (Char))) => Op (CharAt ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex pos) = withRef text_buffer $ \text_bufferPtr -> charAt' text_bufferPtr pos >>= return . toEnum {# fun Fl_Text_Buffer_byte_at as byteAt' { id `Ptr ()',`Int' } -> `Char' castCCharToChar #} -instance ( impl ~ ( BufferOffset -> IO Char)) => Op (ByteAt ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> byteAt' text_bufferPtr pos +instance ( impl ~ ( AtIndex -> IO Char)) => Op (ByteAt ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex pos) = withRef text_buffer $ \text_bufferPtr -> byteAt' text_bufferPtr pos {# fun Fl_Text_Buffer_insert as insert' { id `Ptr ()',`Int', unsafeToCString `T.Text' } -> `()' #} -instance ( impl ~ ( BufferOffset -> T.Text -> IO ())) => Op (Insert ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset pos) text = withRef text_buffer $ \text_bufferPtr -> insert' text_bufferPtr pos text +instance ( impl ~ ( AtIndex -> T.Text -> IO ())) => Op (Insert ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex pos) text = withRef text_buffer $ \text_bufferPtr -> insert' text_bufferPtr pos text {# fun Fl_Text_Buffer_append as append' { id `Ptr ()', unsafeToCString `T.Text' } -> `()' #} instance ( impl ~ ( T.Text -> IO ())) => Op (AppendToBuffer ()) TextBuffer orig impl where runOp _ _ text_buffer t = withRef text_buffer $ \text_bufferPtr -> append' text_bufferPtr t {# fun Fl_Text_Buffer_remove as remove' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance ( impl ~ ( BufferRange -> IO ())) => Op (Remove ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> remove' text_bufferPtr start' end' +instance ( impl ~ ( IndexRange -> IO ())) => Op (Remove ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex start') (AtIndex end')) = withRef text_buffer $ \text_bufferPtr -> remove' text_bufferPtr start' end' {# fun Fl_Text_Buffer_replace as replace' { id `Ptr ()',`Int',`Int', unsafeToCString `T.Text' } -> `()' #} -instance ( impl ~ ( BufferRange -> T.Text -> IO ())) => Op (Replace ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) text = withRef text_buffer $ \text_bufferPtr -> replace' text_bufferPtr start' end' text +instance ( impl ~ ( IndexRange -> T.Text -> IO ())) => Op (Replace ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex start') (AtIndex end')) text = withRef text_buffer $ \text_bufferPtr -> replace' text_bufferPtr start' end' text {# fun Fl_Text_Buffer_copy as copy' { id `Ptr ()',id `Ptr ()',`Int',`Int',`Int' } -> `()' #} -instance ( Parent a TextBuffer, impl ~ ( Ref a -> BufferRange -> BufferOffset -> IO ())) => Op (Copy ()) TextBuffer orig impl where - runOp _ _ text_buffer frombuf (BufferRange (BufferOffset fromstart) (BufferOffset fromend)) (BufferOffset topos) = withRef text_buffer $ \text_bufferPtr -> withRef frombuf $ \frombufPtr -> copy' text_bufferPtr frombufPtr fromstart fromend topos +instance ( Parent a TextBuffer, impl ~ ( Ref a -> IndexRange -> AtIndex -> IO ())) => Op (Copy ()) TextBuffer orig impl where + runOp _ _ text_buffer frombuf (IndexRange (AtIndex fromstart) (AtIndex fromend)) (AtIndex topos) = withRef text_buffer $ \text_bufferPtr -> withRef frombuf $ \frombufPtr -> copy' text_bufferPtr frombufPtr fromstart fromend topos {# fun Fl_Text_Buffer_undo_with_cp as undo' { id `Ptr ()', id `Ptr CInt' } -> `Int' #} -instance ( impl ~ ( IO (Either NoChange BufferOffset))) => Op (Undo ()) TextBuffer orig impl where +instance ( impl ~ ( IO (Either NoChange AtIndex))) => Op (Undo ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> - alloca $ \prevBufferOffsetPtr -> - undo' text_bufferPtr prevBufferOffsetPtr >>= \status' -> + alloca $ \prevAtIndexPtr -> + undo' text_bufferPtr prevAtIndexPtr >>= \status' -> if (status' == 0) then return (Left NoChange) - else peekIntConv prevBufferOffsetPtr >>= return . Right . BufferOffset + else peekIntConv prevAtIndexPtr >>= return . Right . AtIndex {# fun Fl_Text_Buffer_canUndo_with_flag as canUndoWithFlag' { id `Ptr ()', cFromBool `Bool' } -> `()' #} instance ( impl ~ (Bool -> IO ())) => Op (CanUndo ()) TextBuffer orig impl where runOp _ _ text_buffer flag = withRef text_buffer $ \text_bufferPtr -> canUndoWithFlag' text_bufferPtr flag {# fun Fl_Text_Buffer_insertfile as insertfile' { id `Ptr ()', unsafeToCString `T.Text',`Int' } -> `Int' #} -instance ( impl ~ ( T.Text -> BufferOffset -> IO (Either DataProcessingError ()))) => Op (Insertfile ()) TextBuffer orig impl where - runOp _ _ text_buffer file (BufferOffset pos) = +instance ( impl ~ ( T.Text -> AtIndex -> IO (Either DataProcessingError ()))) => Op (Insertfile ()) TextBuffer orig impl where + runOp _ _ text_buffer file (AtIndex pos) = withRef text_buffer $ \text_bufferPtr -> insertfile' text_bufferPtr file pos >>= return . successOrDataProcessingError {# fun Fl_Text_Buffer_insertfile_with_buflen as insertfileWithBuflen' { id `Ptr ()', unsafeToCString `T.Text',`Int',`Int' } -> `Int' #} -instance ( impl ~ ( T.Text -> BufferOffset -> Int -> IO (Either DataProcessingError ()))) => Op (InsertfileWithBuflen ()) TextBuffer orig impl where - runOp _ _ text_buffer file (BufferOffset pos) buflen = +instance ( impl ~ ( T.Text -> AtIndex -> Int -> IO (Either DataProcessingError ()))) => Op (InsertfileWithBuflen ()) TextBuffer orig impl where + runOp _ _ text_buffer file (AtIndex pos) buflen = withRef text_buffer $ \text_bufferPtr -> insertfileWithBuflen' text_bufferPtr file pos buflen >>= return . successOrDataProcessingError {# fun Fl_Text_Buffer_appendfile as appendfile' { id `Ptr ()', unsafeToCString `T.Text' } -> `Int' #} @@ -124,13 +124,13 @@ withRef text_buffer $ \text_bufferPtr -> loadfileWithBuflen' text_bufferPtr file buflen >>= return . successOrDataProcessingError {# fun Fl_Text_Buffer_outputfile as outputfile' { id `Ptr ()', unsafeToCString `T.Text',`Int',`Int' } -> `Int' #} -instance ( impl ~ ( T.Text -> BufferRange -> IO (Either DataProcessingError ()))) => Op (Outputfile ()) TextBuffer orig impl where - runOp _ _ text_buffer file (BufferRange (BufferOffset start') (BufferOffset end')) = +instance ( impl ~ ( T.Text -> IndexRange -> IO (Either DataProcessingError ()))) => Op (Outputfile ()) TextBuffer orig impl where + runOp _ _ text_buffer file (IndexRange (AtIndex start') (AtIndex end')) = withRef text_buffer $ \text_bufferPtr -> outputfile' text_bufferPtr file start' end' >>= return . successOrDataProcessingError {# fun Fl_Text_Buffer_outputfile_with_buflen as outputfileWithBuflen' { id `Ptr ()', unsafeToCString `T.Text',`Int',`Int',`Int' } -> `Int' #} -instance ( impl ~ ( T.Text -> BufferRange -> Int -> IO (Either DataProcessingError ()))) => Op (OutputfileWithBuflen ()) TextBuffer orig impl where - runOp _ _ text_buffer file (BufferRange (BufferOffset start') (BufferOffset end')) buflen = +instance ( impl ~ ( T.Text -> IndexRange -> Int -> IO (Either DataProcessingError ()))) => Op (OutputfileWithBuflen ()) TextBuffer orig impl where + runOp _ _ text_buffer file (IndexRange (AtIndex start') (AtIndex end')) buflen = withRef text_buffer $ \text_bufferPtr -> outputfileWithBuflen' text_bufferPtr file start' end' buflen >>= return . successOrDataProcessingError {# fun Fl_Text_Buffer_savefile as savefile' { id `Ptr ()', unsafeToCString `T.Text' } -> `Int' #} @@ -150,8 +150,8 @@ instance ( impl ~ ( Int -> IO ())) => Op (SetTabDistance ()) TextBuffer orig impl where runOp _ _ text_buffer tabdist = withRef text_buffer $ \text_bufferPtr -> setTabDistance' text_bufferPtr tabdist {# fun Fl_Text_Buffer_select as select' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance ( impl ~ ( BufferRange -> IO ())) => Op (Select ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> select' text_bufferPtr start' end' +instance ( impl ~ ( IndexRange -> IO ())) => Op (Select ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex start') (AtIndex end')) = withRef text_buffer $ \text_bufferPtr -> select' text_bufferPtr start' end' {# fun Fl_Text_Buffer_selected as selected' { id `Ptr ()' } -> `Bool' cToBool #} instance ( impl ~ ( IO (Bool))) => Op (Selected ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> selected' text_bufferPtr @@ -159,11 +159,11 @@ instance ( impl ~ ( IO ())) => Op (Unselect ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> unselect' text_bufferPtr {# fun Fl_Text_Buffer_selection_position as selectionPosition' { id `Ptr ()', alloca- `Int' peekIntConv* , alloca- `Int' peekIntConv* } -> `()' #} -instance ( impl ~ IO (BufferRange)) => Op (SelectionPosition ()) TextBuffer orig impl where +instance ( impl ~ IO (IndexRange)) => Op (SelectionPosition ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> selectionPosition' text_bufferPtr >>= \(start',end') -> - return (BufferRange (BufferOffset start') (BufferOffset end')) + return (IndexRange (AtIndex start') (AtIndex end')) {# fun Fl_Text_Buffer_selection_text as selectionText' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} instance ( impl ~ ( IO T.Text)) => Op (SelectionText ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> selectionText' text_bufferPtr @@ -174,8 +174,8 @@ instance ( impl ~ ( T.Text -> IO ())) => Op (ReplaceSelection ()) TextBuffer orig impl where runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> replaceSelection' text_bufferPtr text {# fun Fl_Text_Buffer_secondary_select as secondarySelect' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance ( impl ~ ( BufferRange -> IO ())) => Op (SecondarySelect ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> secondarySelect' text_bufferPtr start' end' +instance ( impl ~ ( IndexRange -> IO ())) => Op (SecondarySelect ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex start') (AtIndex end')) = withRef text_buffer $ \text_bufferPtr -> secondarySelect' text_bufferPtr start' end' {# fun Fl_Text_Buffer_secondary_selected as secondarySelected' { id `Ptr ()' } -> `Bool' cToBool #} instance ( impl ~ ( IO (Bool))) => Op (SecondarySelected ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> secondarySelected' text_bufferPtr @@ -183,11 +183,11 @@ instance ( impl ~ ( IO ())) => Op (SecondaryUnselect ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> setSecondaryUnselect' text_bufferPtr {# fun Fl_Text_Buffer_secondary_selection_position as secondarySelectionPosition' { id `Ptr ()',alloca- `Int' peekIntConv*, alloca- `Int' peekIntConv* } -> `()' #} -instance ( impl ~ IO BufferRange) => Op (SecondarySelectionPosition ()) TextBuffer orig impl where +instance ( impl ~ IO IndexRange) => Op (SecondarySelectionPosition ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> secondarySelectionPosition' text_bufferPtr >>= \(start',end') -> - return (BufferRange (BufferOffset start') (BufferOffset end')) + return (IndexRange (AtIndex start') (AtIndex end')) {# fun Fl_Text_Buffer_secondary_selection_text as secondarySelectionText' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} instance ( impl ~ ( IO T.Text)) => Op (SecondarySelectionText ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> secondarySelectionText' text_bufferPtr @@ -198,8 +198,8 @@ instance ( impl ~ ( T.Text -> IO ())) => Op (ReplaceSecondarySelection ()) TextBuffer orig impl where runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> replaceSecondarySelection' text_bufferPtr text {# fun Fl_Text_Buffer_set_highlight as setHighlight' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance ( impl ~ ( BufferRange -> IO ())) => Op (SetHighlight ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> setHighlight' text_bufferPtr start' end' +instance ( impl ~ ( IndexRange -> IO ())) => Op (SetHighlight ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex start') (AtIndex end')) = withRef text_buffer $ \text_bufferPtr -> setHighlight' text_bufferPtr start' end' {# fun Fl_Text_Buffer_highlight as highlight' { id `Ptr ()' } -> `Bool' #} instance ( impl ~ ( IO (Bool))) => Op (GetHighlight ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> highlight' text_bufferPtr @@ -207,10 +207,10 @@ instance ( impl ~ ( IO ())) => Op (Unhighlight ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> unhighlight' text_bufferPtr {# fun Fl_Text_Buffer_highlight_position as highlightPosition' { id `Ptr ()',id `Ptr CInt',id `Ptr CInt' } -> `Int' #} -instance ( impl ~ IO (Maybe BufferRange)) => Op (HighlightPosition ()) TextBuffer orig impl where +instance ( impl ~ IO (Maybe IndexRange)) => Op (HighlightPosition ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> - statusToBufferRange (highlightPosition' text_bufferPtr) + statusToIndexRange (highlightPosition' text_bufferPtr) {# fun Fl_Text_Buffer_highlight_text as highlightText' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} instance ( impl ~ ( IO T.Text)) => Op (HighlightText ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> highlightText' text_bufferPtr @@ -245,85 +245,85 @@ instance ( impl ~ ( IO ())) => Op (CallPredeleteCallbacks ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> callPredeleteCallbacks' text_bufferPtr {# fun Fl_Text_Buffer_line_text as lineText' { id `Ptr ()',`Int' } -> `Ptr CChar' id #} -instance ( impl ~ ( Int -> IO (Either OutOfRange String))) => Op (LineText ()) TextBuffer orig impl where - runOp _ _ text_buffer pos = +instance ( impl ~ ( LineNumber -> IO (Either OutOfRange String))) => Op (LineText ()) TextBuffer orig impl where + runOp _ _ text_buffer (LineNumber pos) = withRef text_buffer $ \text_bufferPtr -> do r <- lineText' text_bufferPtr pos successOrOutOfRange r (r == nullPtr) peekCString {# fun Fl_Text_Buffer_line_start as lineStart' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ ( Int -> IO (Either OutOfRange BufferOffset))) => Op (LineStart ()) TextBuffer orig impl where - runOp _ _ text_buffer pos = +instance ( impl ~ ( LineNumber -> IO (Either OutOfRange AtIndex))) => Op (LineStart ()) TextBuffer orig impl where + runOp _ _ text_buffer (LineNumber pos) = withRef text_buffer $ \text_bufferPtr -> do bp <- lineStart' text_bufferPtr pos - successOrOutOfRange bp (bp == 0) (return . BufferOffset) + successOrOutOfRange bp (bp == 0) (return . AtIndex) {# fun Fl_Text_Buffer_line_end as lineEnd' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ ( Int -> IO (Either OutOfRange BufferOffset))) => Op (LineEnd ()) TextBuffer orig impl where - runOp _ _ text_buffer pos = +instance ( impl ~ ( LineNumber -> IO (Either OutOfRange AtIndex))) => Op (LineEnd ()) TextBuffer orig impl where + runOp _ _ text_buffer (LineNumber pos) = withRef text_buffer $ \text_bufferPtr -> do bp <- lineEnd' text_bufferPtr pos - successOrOutOfRange bp (bp == 0) (return . BufferOffset) + successOrOutOfRange bp (bp == 0) (return . AtIndex) {# fun Fl_Text_Buffer_word_start as wordStart' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> IO (Either OutOfRange BufferOffset))) => Op (WordStart ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> do +instance ( impl ~ (AtIndex -> IO (Either OutOfRange AtIndex))) => Op (WordStart ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex pos) = withRef text_buffer $ \text_bufferPtr -> do bp <- wordStart' text_bufferPtr pos - successOrOutOfRange bp (bp == 0) (return . BufferOffset) + successOrOutOfRange bp (bp == 0) (return . AtIndex) {# fun Fl_Text_Buffer_word_end as wordEnd' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> IO (Either OutOfRange BufferOffset))) => Op (WordEnd ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> do +instance ( impl ~ (AtIndex -> IO (Either OutOfRange AtIndex))) => Op (WordEnd ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex pos) = withRef text_buffer $ \text_bufferPtr -> do bp <- wordEnd' text_bufferPtr pos - successOrOutOfRange bp (bp == 0) (return . BufferOffset) + successOrOutOfRange bp (bp == 0) (return . AtIndex) {# fun Fl_Text_Buffer_count_displayed_characters as countDisplayedCharacters' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance ( impl ~ (BufferRange -> IO (Int))) => Op (CountDisplayedCharacters ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset linestartpos) (BufferOffset targetpos)) = withRef text_buffer $ \text_bufferPtr -> countDisplayedCharacters' text_bufferPtr linestartpos targetpos +instance ( impl ~ (IndexRange -> IO (Int))) => Op (CountDisplayedCharacters ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex linestartpos) (AtIndex targetpos)) = withRef text_buffer $ \text_bufferPtr -> countDisplayedCharacters' text_bufferPtr linestartpos targetpos {# fun Fl_Text_Buffer_skip_displayed_characters as skipDisplayedCharacters' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset-> Int -> IO (BufferOffset))) => Op (SkipDisplayedCharacters ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset linestartpos) nchars = - withRef text_buffer $ \text_bufferPtr -> skipDisplayedCharacters' text_bufferPtr linestartpos nchars >>= return . BufferOffset +instance ( impl ~ (AtIndex-> Int -> IO (AtIndex))) => Op (SkipDisplayedCharacters ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex linestartpos) nchars = + withRef text_buffer $ \text_bufferPtr -> skipDisplayedCharacters' text_bufferPtr linestartpos nchars >>= return . AtIndex {# fun Fl_Text_Buffer_count_lines as countLines' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance ( impl ~ (BufferRange -> IO (Int))) => Op (CountLines ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferRange (BufferOffset startpos)(BufferOffset endpos)) = withRef text_buffer $ \text_bufferPtr -> countLines' text_bufferPtr startpos endpos +instance ( impl ~ (IndexRange -> IO (Lines))) => Op (CountLines ()) TextBuffer orig impl where + runOp _ _ text_buffer (IndexRange (AtIndex startpos)(AtIndex endpos)) = withRef text_buffer $ \text_bufferPtr -> countLines' text_bufferPtr startpos endpos >>= return . Lines {# fun Fl_Text_Buffer_skip_lines as skipLines' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> Int -> IO (BufferOffset))) => Op (SkipLines ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset startpos) nlines = withRef text_buffer $ \text_bufferPtr -> skipLines' text_bufferPtr startpos nlines >>= return . BufferOffset +instance ( impl ~ (AtIndex -> Lines -> IO (AtIndex))) => Op (SkipLines ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex startpos) (Lines nlines) = withRef text_buffer $ \text_bufferPtr -> skipLines' text_bufferPtr startpos nlines >>= return . AtIndex {# fun Fl_Text_Buffer_rewind_lines as rewindLines' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> Int -> IO (Int))) => Op (RewindLines ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset startpos) nlines = withRef text_buffer $ \text_bufferPtr -> rewindLines' text_bufferPtr startpos nlines +instance ( impl ~ (AtIndex -> Lines -> IO (AtIndex))) => Op (RewindLines ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex startpos) (Lines nlines) = withRef text_buffer $ \text_bufferPtr -> rewindLines' text_bufferPtr startpos nlines >>= return . AtIndex {# fun Fl_Text_Buffer_findchar_forward as findcharForward' { id `Ptr ()',`Int',`Int', id `Ptr CInt' } -> `Int' #} -instance ( impl ~ (BufferOffset -> Char -> IO (Either NotFound BufferOffset))) => Op (FindcharForward ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset startpos) searchchar = +instance ( impl ~ (AtIndex -> Char -> IO (Either NotFound AtIndex))) => Op (FindcharForward ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex startpos) searchchar = withRef text_buffer $ \text_bufferPtr -> alloca $ \intPtr -> do status' <- findcharForward' text_bufferPtr startpos (fromIntegral $ castCharToCChar searchchar) intPtr if (status' == 0) then return (Left NotFound) - else peekIntConv intPtr >>= return . Right . BufferOffset + else peekIntConv intPtr >>= return . Right . AtIndex {# fun Fl_Text_Buffer_findchar_backward as findcharBackward' { id `Ptr ()',`Int',`Int',id `Ptr CInt' } -> `Int' #} -instance ( impl ~ (BufferOffset -> Char -> IO (Either NotFound BufferOffset))) => Op (FindcharBackward ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset startpos) searchchar = +instance ( impl ~ (AtIndex -> Char -> IO (Either NotFound AtIndex))) => Op (FindcharBackward ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex startpos) searchchar = withRef text_buffer $ \text_bufferPtr -> alloca $ \intPtr -> do status' <- findcharBackward' text_bufferPtr startpos (fromIntegral $ castCharToCChar searchchar) intPtr if (status' == 0) then return (Left NotFound) - else peekIntConv intPtr >>= return . Right . BufferOffset + else peekIntConv intPtr >>= return . Right . AtIndex {# fun Fl_Text_Buffer_search_forward_with_matchcase as searchForwardWithMatchcase' { id `Ptr ()',`Int', unsafeToCString `T.Text',id `Ptr CInt', cFromBool `Bool' } -> `Int' #} -instance ( impl ~ (BufferOffset -> T.Text -> Bool -> IO (Either NotFound BufferOffset))) => Op (SearchForwardWithMatchcase ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset startpos) searchstring matchcase = +instance ( impl ~ (AtIndex -> T.Text -> Bool -> IO (Either NotFound AtIndex))) => Op (SearchForwardWithMatchcase ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex startpos) searchstring matchcase = withRef text_buffer $ \text_bufferPtr -> alloca $ \intPtr -> do status' <- searchForwardWithMatchcase' text_bufferPtr startpos searchstring intPtr matchcase if (status' == 0) then return (Left NotFound) - else peekIntConv intPtr >>= return . Right . BufferOffset + else peekIntConv intPtr >>= return . Right . AtIndex {# fun Fl_Text_Buffer_search_backward_with_matchcase as searchBackwardWithMatchcase' { id `Ptr ()',`Int', unsafeToCString `T.Text',id `Ptr CInt', cFromBool `Bool' } -> `Int' #} -instance ( impl ~ (BufferOffset -> T.Text -> Bool -> IO (Either NotFound BufferOffset))) => Op (SearchBackwardWithMatchcase ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset startpos) searchstring matchcase = +instance ( impl ~ (AtIndex -> T.Text -> Bool -> IO (Either NotFound AtIndex))) => Op (SearchBackwardWithMatchcase ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex startpos) searchstring matchcase = withRef text_buffer $ \text_bufferPtr -> alloca $ \intPtr -> do status' <- searchBackwardWithMatchcase' text_bufferPtr startpos searchstring intPtr matchcase if (status' == 0) then return (Left NotFound) - else peekIntConv intPtr >>= return . Right . BufferOffset + else peekIntConv intPtr >>= return . Right . AtIndex {# fun Fl_Text_Buffer_primary_selection as primarySelection' { id `Ptr ()' } -> `Ptr ()' id #} instance ( impl ~ ( IO (Maybe (Ref TextSelection)))) => Op (PrimarySelection ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> primarySelection' text_bufferPtr >>= toMaybeRef @@ -334,29 +334,29 @@ instance ( impl ~ ( IO (Maybe (Ref TextSelection)))) => Op (HighlightSelection ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> highlightSelection' text_bufferPtr >>= toMaybeRef {# fun Fl_Text_Buffer_prev_char as prevChar' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ ( BufferOffset -> IO (Either OutOfRange BufferOffset))) => Op (PrevChar ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset ix) = +instance ( impl ~ ( AtIndex -> IO (Either OutOfRange AtIndex))) => Op (PrevChar ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex ix) = withRef text_buffer $ \text_bufferPtr -> do p' <- prevChar' text_bufferPtr ix - successOrOutOfRange p' (p' == 0) (return . BufferOffset) + successOrOutOfRange p' (p' == 0) (return . AtIndex) {# fun Fl_Text_Buffer_prev_char_clipped as prevCharClipped' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> IO (Either OutOfRange BufferOffset))) => Op (PrevCharClipped ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset ix) = +instance ( impl ~ (AtIndex -> IO (Either OutOfRange AtIndex))) => Op (PrevCharClipped ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex ix) = withRef text_buffer $ \text_bufferPtr -> do p' <- prevCharClipped' text_bufferPtr ix - successOrOutOfRange p' (p' == 0) (return . BufferOffset) + successOrOutOfRange p' (p' == 0) (return . AtIndex) {# fun Fl_Text_Buffer_next_char as nextChar' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> IO BufferOffset)) => Op (NextChar ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset ix) = withRef text_buffer $ \text_bufferPtr -> nextChar' text_bufferPtr ix >>= return . BufferOffset +instance ( impl ~ (AtIndex -> IO AtIndex)) => Op (NextChar ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex ix) = withRef text_buffer $ \text_bufferPtr -> nextChar' text_bufferPtr ix >>= return . AtIndex {# fun Fl_Text_Buffer_next_char_clipped as nextCharClipped' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> IO (BufferOffset))) => Op (NextCharClipped ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset ix) = withRef text_buffer $ \text_bufferPtr -> nextCharClipped' text_bufferPtr ix >>= return . BufferOffset +instance ( impl ~ (AtIndex -> IO (AtIndex))) => Op (NextCharClipped ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex ix) = withRef text_buffer $ \text_bufferPtr -> nextCharClipped' text_bufferPtr ix >>= return . AtIndex {# fun Fl_Text_Buffer_utf8_align as utf8Align' { id `Ptr ()',`Int' } -> `Int' #} -instance ( impl ~ (BufferOffset -> IO (Either OutOfRange BufferOffset))) => Op (Utf8Align ()) TextBuffer orig impl where - runOp _ _ text_buffer (BufferOffset align) = +instance ( impl ~ (AtIndex -> IO (Either OutOfRange AtIndex))) => Op (Utf8Align ()) TextBuffer orig impl where + runOp _ _ text_buffer (AtIndex align) = withRef text_buffer $ \text_bufferPtr -> do p' <- utf8Align' text_bufferPtr align - successOrOutOfRange p' (p' == 0) (return . BufferOffset) + successOrOutOfRange p' (p' == 0) (return . AtIndex) -- $hierarchy -- @ @@ -375,7 +375,7 @@ -- -- appendfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- byteAt :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' 'Char' +-- byteAt :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' 'Char' -- -- callModifyCallbacks :: 'Ref' 'TextBuffer' -> 'IO' () -- @@ -383,21 +383,21 @@ -- -- canUndo :: 'Ref' 'TextBuffer' -> 'Bool' -> 'IO' () -- --- charAt :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Char') +-- charAt :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('Char') -- --- copy:: ('Parent' a 'TextBuffer') => 'Ref' 'TextBuffer' -> 'Ref' a -> 'BufferRange' -> 'BufferOffset' -> 'IO' () +-- copy:: ('Parent' a 'TextBuffer') => 'Ref' 'TextBuffer' -> 'Ref' a -> 'IndexRange' -> 'AtIndex' -> 'IO' () -- --- countDisplayedCharacters :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ('Int') +-- countDisplayedCharacters :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' ('Int') -- --- countLines :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' ('Int') +-- countLines :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' ('Lines') -- -- destroy :: 'Ref' 'TextBuffer' -> 'IO' () -- -- fileEncodingWarningMessage :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text' -- --- findcharBackward :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Char' -> 'IO' ('Either' 'NotFound' 'BufferOffset') +-- findcharBackward :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'Char' -> 'IO' ('Either' 'NotFound' 'AtIndex') -- --- findcharForward :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Char' -> 'IO' ('Either' 'NotFound' 'BufferOffset') +-- findcharForward :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'Char' -> 'IO' ('Either' 'NotFound' 'AtIndex') -- -- getHighlight :: 'Ref' 'TextBuffer' -> 'IO' ('Bool') -- @@ -407,7 +407,7 @@ -- -- getText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text' -- --- highlightPosition :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' 'BufferRange') +-- highlightPosition :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' 'IndexRange') -- -- highlightSelection :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' ('Ref' 'TextSelection')) -- @@ -415,37 +415,37 @@ -- -- inputFileWasTranscoded :: 'Ref' 'TextBuffer' -> 'IO' ('Bool') -- --- insert :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'T.Text' -> 'IO' () +-- insert :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'T.Text' -> 'IO' () -- --- insertfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferOffset' -> 'IO' ('Either' 'DataProcessingError' ()) +-- insertfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'AtIndex' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- insertfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferOffset' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) +-- insertfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'AtIndex' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- lineEnd :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- lineEnd :: 'Ref' 'TextBuffer' -> 'LineNumber' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- --- lineStart :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- lineStart :: 'Ref' 'TextBuffer' -> 'LineNumber' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- --- lineText :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' ('Either' 'OutOfRange' 'String') +-- lineText :: 'Ref' 'TextBuffer' -> 'LineNumber' -> 'IO' ('Either' 'OutOfRange' 'String') -- -- loadfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ('Either' 'DataProcessingError' ()) -- -- loadfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- nextChar :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' 'BufferOffset' +-- nextChar :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' 'AtIndex' -- --- nextCharClipped :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('BufferOffset') +-- nextCharClipped :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('AtIndex') -- --- outputfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferRange' -> 'IO' ('Either' 'DataProcessingError' ()) +-- outputfile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IndexRange' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- outputfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'BufferRange' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) +-- outputfileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IndexRange' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- prevChar :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- prevChar :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- --- prevCharClipped :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- prevCharClipped :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- -- primarySelection :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' ('Ref' 'TextSelection')) -- --- remove :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' () +-- remove :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' () -- -- removeModifyCallback :: 'Ref' 'TextBuffer' -> 'FunPtr' () -> 'IO' () -- @@ -455,63 +455,63 @@ -- -- removeSelection :: 'Ref' 'TextBuffer' -> 'IO' () -- --- replace :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'T.Text' -> 'IO' () +-- replace :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'T.Text' -> 'IO' () -- -- replaceSecondarySelection :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' () -- -- replaceSelection :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' () -- --- rewindLines :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Int' -> 'IO' ('Int') +-- rewindLines :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'Lines' -> 'IO' ('AtIndex') -- -- savefile :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' ('Either' 'DataProcessingError' ()) -- -- savefileWithBuflen :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'Int' -> 'IO' ('Either' 'DataProcessingError' ()) -- --- searchBackwardWithMatchcase :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'T.Text' -> 'Bool' -> 'IO' ('Either' 'NotFound' 'BufferOffset') +-- searchBackwardWithMatchcase :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'T.Text' -> 'Bool' -> 'IO' ('Either' 'NotFound' 'AtIndex') -- --- searchForwardWithMatchcase :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'T.Text' -> 'Bool' -> 'IO' ('Either' 'NotFound' 'BufferOffset') +-- searchForwardWithMatchcase :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'T.Text' -> 'Bool' -> 'IO' ('Either' 'NotFound' 'AtIndex') -- --- secondarySelect :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' () +-- secondarySelect :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' () -- -- secondarySelected :: 'Ref' 'TextBuffer' -> 'IO' ('Bool') -- -- secondarySelection :: 'Ref' 'TextBuffer' -> 'IO' ('Maybe' ('Ref' 'TextSelection')) -- --- secondarySelectionPosition :: 'Ref' 'TextBuffer' -> 'IO' 'BufferRange' +-- secondarySelectionPosition :: 'Ref' 'TextBuffer' -> 'IO' 'IndexRange' -- -- secondarySelectionText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text' -- -- secondaryUnselect :: 'Ref' 'TextBuffer' -> 'IO' () -- --- select :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' () +-- select :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' () -- -- selected :: 'Ref' 'TextBuffer' -> 'IO' ('Bool') -- --- selectionPosition :: 'Ref' 'TextBuffer' -> 'IO' ('BufferRange') +-- selectionPosition :: 'Ref' 'TextBuffer' -> 'IO' ('IndexRange') -- -- selectionText :: 'Ref' 'TextBuffer' -> 'IO' 'T.Text' -- --- setHighlight :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' () +-- setHighlight :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' () -- -- setTabDistance :: 'Ref' 'TextBuffer' -> 'Int' -> 'IO' () -- -- setText :: 'Ref' 'TextBuffer' -> 'T.Text' -> 'IO' () -- --- skipDisplayedCharacters :: 'Ref' 'TextBuffer' -> 'BufferOffset'>- 'Int' -> 'IO' ('BufferOffset') +-- skipDisplayedCharacters :: 'Ref' 'TextBuffer' -> 'AtIndex'>- 'Int' -> 'IO' ('AtIndex') -- --- skipLines :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'Int' -> 'IO' ('BufferOffset') +-- skipLines :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'Lines' -> 'IO' ('AtIndex') -- --- textRange :: 'Ref' 'TextBuffer' -> 'BufferRange' -> 'IO' 'T.Text' +-- textRange :: 'Ref' 'TextBuffer' -> 'IndexRange' -> 'IO' 'T.Text' -- --- undo :: 'Ref' 'TextBuffer' -> 'IO' ('Either' 'NoChange' 'BufferOffset') +-- undo :: 'Ref' 'TextBuffer' -> 'IO' ('Either' 'NoChange' 'AtIndex') -- -- unhighlight :: 'Ref' 'TextBuffer' -> 'IO' () -- -- unselect :: 'Ref' 'TextBuffer' -> 'IO' () -- --- utf8Align :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- utf8Align :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- --- wordEnd :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- wordEnd :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- --- wordStart :: 'Ref' 'TextBuffer' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'BufferOffset') +-- wordStart :: 'Ref' 'TextBuffer' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' 'AtIndex') -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs b/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs --- a/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TextDisplay.chs @@ -3,6 +3,7 @@ module Graphics.UI.FLTK.LowLevel.TextDisplay ( mkStyleTableEntriesPtr, + toStyleTableEntries, indexStyleTableEntries, textDisplayNew, textDisplayCustom @@ -50,6 +51,30 @@ styleTableEntriesPtr finalizerF +toStyleTableEntries :: Int -> Ptr () -> IO (Maybe [StyleTableEntry]) +toStyleTableEntries len ptr = do + entries <- mapM toStyleTableEntry [0 .. (len - 1)] + return (sequence entries) + where + toStyleTableEntry :: Int -> IO (Maybe StyleTableEntry) + toStyleTableEntry idx = + let entryPtr = ptr `plusPtr` (idx * {#sizeof Style_Table_Entry#}) in + if (entryPtr == nullPtr) + then return Nothing + else do + color <- {#get Style_Table_Entry->color #} entryPtr + font <- {#get Style_Table_Entry->font #} entryPtr + fontSize <- {#get Style_Table_Entry->size #} entryPtr + return + (Just + ( + StyleTableEntry + (if (color == 0) then Nothing else Just (Color (fromIntegral color))) + (if (font == 0) then Nothing else Just (Font (fromIntegral font))) + (if (fontSize == 0) then Nothing else Just (FontSize (fromIntegral fontSize))) + ) + ) + indexStyleTableEntries :: [StyleTableEntry] -> [(Char, StyleTableEntry)] indexStyleTableEntries = zip ['A'..] @@ -91,23 +116,23 @@ instance (impl ~ ( IO (Maybe (Ref TextBuffer)))) => Op (GetBuffer ()) TextDisplay orig impl where runOp _ _ text_display = withRef text_display $ \text_displayPtr -> buffer' text_displayPtr >>= toMaybeRef {# fun Fl_Text_Display_redisplay_range as redisplayRange' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ (BufferRange -> IO ())) => Op (RedisplayRange ()) TextDisplay orig impl where - runOp _ _ text_display (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_display $ \text_displayPtr -> redisplayRange' text_displayPtr start' end' +instance (impl ~ (IndexRange -> IO ())) => Op (RedisplayRange ()) TextDisplay orig impl where + runOp _ _ text_display (IndexRange (AtIndex start') (AtIndex end')) = withRef text_display $ \text_displayPtr -> redisplayRange' text_displayPtr start' end' {# fun Fl_Text_Display_scroll as scroll' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ (Int -> BufferOffset -> IO ())) => Op (Scroll ()) TextDisplay orig impl where - runOp _ _ text_display toplinenum (BufferOffset horizoffset) = withRef text_display $ \text_displayPtr -> scroll' text_displayPtr toplinenum horizoffset +instance (impl ~ (LineNumber -> AtIndex -> IO ())) => Op (Scroll ()) TextDisplay orig impl where + runOp _ _ text_display (LineNumber toplinenum) (AtIndex horizoffset) = withRef text_display $ \text_displayPtr -> scroll' text_displayPtr toplinenum horizoffset {# fun Fl_Text_Display_overstrike as overstrike' { id `Ptr ()',unsafeToCString `T.Text' } -> `()' #} instance (impl ~ (T.Text -> IO ())) => Op (Overstrike ()) TextDisplay orig impl where runOp _ _ text_display text = withRef text_display $ \text_displayPtr -> overstrike' text_displayPtr text {# fun Fl_Text_Display_set_insert_position as setInsertPosition' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ (BufferOffset -> IO ())) => Op (SetInsertPosition ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset newpos) = withRef text_display $ \text_displayPtr -> setInsertPosition' text_displayPtr newpos +instance (impl ~ (AtIndex -> IO ())) => Op (SetInsertPosition ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex newpos) = withRef text_display $ \text_displayPtr -> setInsertPosition' text_displayPtr newpos {# fun Fl_Text_Display_insert_position as insertPosition' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO BufferOffset)) => Op (GetInsertPosition ()) TextDisplay orig impl where - runOp _ _ text_display = withRef text_display $ \text_displayPtr -> insertPosition' text_displayPtr >>= return . BufferOffset +instance (impl ~ ( IO AtIndex)) => Op (GetInsertPosition ()) TextDisplay orig impl where + runOp _ _ text_display = withRef text_display $ \text_displayPtr -> insertPosition' text_displayPtr >>= return . AtIndex {# fun Fl_Text_Display_position_to_xy as positionToXy' { id `Ptr ()',`Int', id `Ptr CInt', id `Ptr CInt'} -> `Int' #} -instance (impl ~ (BufferOffset -> IO (Either OutOfRange Position))) => Op (PositionToXy ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset pos) = +instance (impl ~ (AtIndex -> IO (Either OutOfRange Position))) => Op (PositionToXy ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex pos) = withRef text_display $ \text_displayPtr -> alloca $ \xPtr -> alloca $ \yPtr -> do @@ -144,21 +169,21 @@ runOp _ _ text_display = withRef text_display $ \text_displayPtr -> moveDown' text_displayPtr >>= \s -> successOrOutOfRange () (s == 0) return {# fun Fl_Text_Display_count_lines as countLines' { id `Ptr ()',`Int',`Int', cFromBool `Bool' } -> `Int' #} -instance (impl ~ (BufferRange -> Bool -> IO (Int))) => Op (CountLines ()) TextDisplay orig impl where - runOp _ _ text_display (BufferRange (BufferOffset start') (BufferOffset end')) start_pos_is_line_start = +instance (impl ~ (IndexRange -> Bool -> IO (Int))) => Op (CountLines ()) TextDisplay orig impl where + runOp _ _ text_display (IndexRange (AtIndex start') (AtIndex end')) start_pos_is_line_start = withRef text_display $ \text_displayPtr -> countLines' text_displayPtr start' end' start_pos_is_line_start {# fun Fl_Text_Display_line_start as lineStart' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (BufferOffset -> IO (BufferOffset))) => Op (LineStart ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset pos) = withRef text_display $ \text_displayPtr -> lineStart' text_displayPtr pos >>= return . BufferOffset +instance (impl ~ (AtIndex -> IO (AtIndex))) => Op (LineStart ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex pos) = withRef text_display $ \text_displayPtr -> lineStart' text_displayPtr pos >>= return . AtIndex {# fun Fl_Text_Display_line_end as lineEnd' { id `Ptr ()',`Int', cFromBool `Bool' } -> `Int' #} -instance (impl ~ (BufferOffset -> Bool -> IO (BufferOffset))) => Op (LineEnd ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset startpos) startposislinestart = withRef text_display $ \text_displayPtr -> lineEnd' text_displayPtr startpos startposislinestart >>= return . BufferOffset +instance (impl ~ (AtIndex -> Bool -> IO (AtIndex))) => Op (LineEnd ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex startpos) startposislinestart = withRef text_display $ \text_displayPtr -> lineEnd' text_displayPtr startpos startposislinestart >>= return . AtIndex {# fun Fl_Text_Display_skip_lines as skipLines' { id `Ptr ()',`Int',`Int', cFromBool `Bool' } -> `Int' #} -instance (impl ~ (BufferOffset -> Int -> Bool -> IO (BufferOffset))) => Op (SkipLines ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset startpos) nlines startposislinestart = withRef text_display $ \text_displayPtr -> skipLines' text_displayPtr startpos nlines startposislinestart >>= return . BufferOffset +instance (impl ~ (AtIndex -> Int -> Bool -> IO (AtIndex))) => Op (SkipLines ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex startpos) nlines startposislinestart = withRef text_display $ \text_displayPtr -> skipLines' text_displayPtr startpos nlines startposislinestart >>= return . AtIndex {# fun Fl_Text_Display_rewind_lines as rewindLines' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance (impl ~ (BufferOffset -> Int -> IO (BufferOffset))) => Op (RewindLines ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset startpos) nlines = withRef text_display $ \text_displayPtr -> rewindLines' text_displayPtr startpos nlines >>= return . BufferOffset +instance (impl ~ (AtIndex -> Int -> IO (AtIndex))) => Op (RewindLines ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex startpos) nlines = withRef text_display $ \text_displayPtr -> rewindLines' text_displayPtr startpos nlines >>= return . AtIndex {# fun Fl_Text_Display_next_word as nextWord' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (NextWord ()) TextDisplay orig impl where runOp _ _ text_display = withRef text_display $ \text_displayPtr -> nextWord' text_displayPtr @@ -190,11 +215,11 @@ instance (impl ~ (AlignType -> IO ())) => Op (SetScrollbarAlign ()) TextDisplay orig impl where runOp _ _ text_display a = withRef text_display $ \text_displayPtr -> setScrollbarAlign' text_displayPtr a {# fun Fl_Text_Display_word_start as wordStart' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (BufferOffset -> IO (BufferOffset))) => Op (WordStart ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset pos) = withRef text_display $ \text_displayPtr -> wordStart' text_displayPtr pos >>= return . BufferOffset +instance (impl ~ (AtIndex -> IO (AtIndex))) => Op (WordStart ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex pos) = withRef text_display $ \text_displayPtr -> wordStart' text_displayPtr pos >>= return . AtIndex {# fun Fl_Text_Display_word_end as wordEnd' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ (BufferOffset -> IO (BufferOffset))) => Op (WordEnd ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset pos) = withRef text_display $ \text_displayPtr -> wordEnd' text_displayPtr pos >>= return . BufferOffset +instance (impl ~ (AtIndex -> IO (AtIndex))) => Op (WordEnd ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex pos) = withRef text_display $ \text_displayPtr -> wordEnd' text_displayPtr pos >>= return . AtIndex {# fun Fl_Text_Display_highlight_data as highlightData' { id `Ptr ()',id `Ptr ()',id `Ptr ()',`Int', id `CChar',id `FunPtr UnfinishedStyleCbPrim',id `Ptr ()' } -> `()' #} instance (Parent a TextBuffer, impl ~ (Ref a -> [(Char, StyleTableEntry)] -> Maybe(Char,UnfinishedStyleCb) -> IO ())) => Op (HighlightData ()) TextDisplay orig impl where runOp _ _ text_display style_buffer indexedStyleTable cb = @@ -208,8 +233,8 @@ Nothing -> return (0, nullFunPtr) highlightData' text_displayPtr style_bufferPtr (castPtr $ Unsafe.unsafeForeignPtrToPtr $ stesPtr) (length indexedStyleTable) (fromIntegral indexChar) fPtr nullPtr {# fun Fl_Text_Display_position_style as positionStyle' { id `Ptr ()',`Int',`Int',`Int' } -> `Int' #} -instance (impl ~ (BufferOffset -> Int -> Int -> IO TextDisplayStyle)) => Op (PositionStyle ()) TextDisplay orig impl where - runOp _ _ text_display (BufferOffset linestartpos) linelen lineindex = +instance (impl ~ (AtIndex -> Int -> LineNumber -> IO TextDisplayStyle)) => Op (PositionStyle ()) TextDisplay orig impl where + runOp _ _ text_display (AtIndex linestartpos) linelen (LineNumber lineindex) = withRef text_display $ \text_displayPtr -> positionStyle' text_displayPtr linestartpos linelen lineindex >>= return . TextDisplayStyle . fromIntegral {# fun Fl_Text_Display_shortcut as shortcut' { id `Ptr ()' } -> `CInt' #} @@ -345,7 +370,7 @@ -- @ -- colToX :: 'Ref' 'TextDisplay' -> 'Double' -> 'IO' ('Double') -- --- countLines :: 'Ref' 'TextDisplay' -> 'BufferRange' -> 'Bool' -> 'IO' ('Int') +-- countLines :: 'Ref' 'TextDisplay' -> 'IndexRange' -> 'Bool' -> 'IO' ('Int') -- -- destroy :: 'Ref' 'TextDisplay' -> 'IO' () -- @@ -357,7 +382,7 @@ -- -- getCursorColor :: 'Ref' 'TextDisplay' -> 'IO' ('Color') -- --- getInsertPosition :: 'Ref' 'TextDisplay' -> 'IO' 'BufferOffset' +-- getInsertPosition :: 'Ref' 'TextDisplay' -> 'IO' 'AtIndex' -- -- getLinenumberAlign :: 'Ref' 'TextDisplay' -> 'IO' ('AlignType') -- @@ -397,9 +422,9 @@ -- -- inSelection :: 'Ref' 'TextDisplay' -> 'Position' -> 'IO' ('Bool') -- --- lineEnd :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'Bool' -> 'IO' ('BufferOffset') +-- lineEnd :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'Bool' -> 'IO' ('AtIndex') -- --- lineStart :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'IO' ('BufferOffset') +-- lineStart :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'IO' ('AtIndex') -- -- moveDown :: 'Ref' 'TextDisplay' -> 'IO' ('Either' 'OutOfRange' ()) -- @@ -413,21 +438,21 @@ -- -- overstrike :: 'Ref' 'TextDisplay' -> 'T.Text' -> 'IO' () -- --- positionStyle :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'Int' -> 'Int' -> 'IO' 'TextDisplayStyle' +-- positionStyle :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'Int' -> 'LineNumber' -> 'IO' 'TextDisplayStyle' -- --- positionToXy :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'IO' ('Either' 'OutOfRange' 'Position') +-- positionToXy :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' 'Position') -- -- previousWord :: 'Ref' 'TextDisplay' -> 'IO' () -- --- redisplayRange :: 'Ref' 'TextDisplay' -> 'BufferRange' -> 'IO' () +-- redisplayRange :: 'Ref' 'TextDisplay' -> 'IndexRange' -> 'IO' () -- -- resize :: 'Ref' 'TextDisplay' -> 'Rectangle' -> 'IO' () -- -- resizeSuper :: 'Ref' 'TextDisplay' -> 'Rectangle' -> 'IO' () -- --- rewindLines :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'Int' -> 'IO' ('BufferOffset') +-- rewindLines :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'Int' -> 'IO' ('AtIndex') -- --- scroll :: 'Ref' 'TextDisplay' -> 'Int' -> 'BufferOffset' -> 'IO' () +-- scroll :: 'Ref' 'TextDisplay' -> 'LineNumber' -> 'AtIndex' -> 'IO' () -- -- setBuffer:: ('Parent' a 'TextBuffer') => 'Ref' 'TextDisplay' -> 'Maybe' ( 'Ref' a ) -> 'IO' () -- @@ -435,7 +460,7 @@ -- -- setCursorStyle :: 'Ref' 'TextDisplay' -> 'CursorType' -> 'IO' () -- --- setInsertPosition :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'IO' () +-- setInsertPosition :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'IO' () -- -- setLinenumberAlign :: 'Ref' 'TextDisplay' -> 'AlignType' -> 'IO' () -- @@ -471,11 +496,11 @@ -- -- showWidgetSuper :: 'Ref' 'TextDisplay' -> 'IO' () -- --- skipLines :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'Int' -> 'Bool' -> 'IO' ('BufferOffset') +-- skipLines :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'Int' -> 'Bool' -> 'IO' ('AtIndex') -- --- wordEnd :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'IO' ('BufferOffset') +-- wordEnd :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'IO' ('AtIndex') -- --- wordStart :: 'Ref' 'TextDisplay' -> 'BufferOffset' -> 'IO' ('BufferOffset') +-- wordStart :: 'Ref' 'TextDisplay' -> 'AtIndex' -> 'IO' ('AtIndex') -- -- wrapMode :: 'Ref' 'TextDisplay' -> 'WrapType' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/TextEditor.chs b/src/Graphics/UI/FLTK/LowLevel/TextEditor.chs --- a/src/Graphics/UI/FLTK/LowLevel/TextEditor.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TextEditor.chs @@ -126,10 +126,13 @@ {# fun Fl_Text_Editor_New_WithLabel as textEditorNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} textEditorNew :: Rectangle -> Maybe T.Text -> IO (Ref TextEditor) textEditorNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> textEditorNew' x_pos y_pos width height >>= toRef - Just l -> textEditorNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Text_Editor_Destroy as textEditorDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) TextEditor orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/TextSelection.chs b/src/Graphics/UI/FLTK/LowLevel/TextSelection.chs --- a/src/Graphics/UI/FLTK/LowLevel/TextSelection.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TextSelection.chs @@ -22,17 +22,17 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Text_Selection_set as set' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance ( impl ~ (BufferRange -> IO ())) => Op (Set ()) TextSelection orig impl where - runOp _ _ text_selection (BufferRange (BufferOffset start'') (BufferOffset end'')) = withRef text_selection $ \text_selectionPtr -> set' text_selectionPtr start'' end'' +instance ( impl ~ (IndexRange -> IO ())) => Op (Set ()) TextSelection orig impl where + runOp _ _ text_selection (IndexRange (AtIndex start'') (AtIndex end'')) = withRef text_selection $ \text_selectionPtr -> set' text_selectionPtr start'' end'' {# fun Fl_Text_Selection_update as update' { id `Ptr ()',`Int',`Int',`Int' } -> `()' #} -instance ( impl ~ (BufferOffset -> Int -> Int -> IO ())) => Op (Update ()) TextSelection orig impl where - runOp _ _ text_selection (BufferOffset pos) ndeleted ninserted = withRef text_selection $ \text_selectionPtr -> update' text_selectionPtr pos ndeleted ninserted +instance ( impl ~ (AtIndex -> Int -> Int -> IO ())) => Op (Update ()) TextSelection orig impl where + runOp _ _ text_selection (AtIndex pos) ndeleted ninserted = withRef text_selection $ \text_selectionPtr -> update' text_selectionPtr pos ndeleted ninserted {# fun Fl_Text_Selection_start as start' { id `Ptr ()' } -> `Int' #} -instance ( impl ~ IO BufferOffset) => Op (Start ()) TextSelection orig impl where - runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> start' text_selectionPtr >>= return . BufferOffset +instance ( impl ~ IO AtIndex) => Op (Start ()) TextSelection orig impl where + runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> start' text_selectionPtr >>= return . AtIndex {# fun Fl_Text_Selection_end as end' { id `Ptr ()' } -> `Int' #} -instance ( impl ~ (IO (BufferOffset))) => Op (End ()) TextSelection orig impl where - runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> end' text_selectionPtr >>= return . BufferOffset +instance ( impl ~ (IO (AtIndex))) => Op (End ()) TextSelection orig impl where + runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> end' text_selectionPtr >>= return . AtIndex {# fun Fl_Text_Selection_selected as selected' { id `Ptr ()' } -> `Bool' cToBool #} instance ( impl ~ IO (Bool)) => Op (Selected ()) TextSelection orig impl where runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> selected' text_selectionPtr @@ -40,13 +40,13 @@ instance ( impl ~ (Bool -> IO ())) => Op (SetSelected ()) TextSelection orig impl where runOp _ _ text_selection b = withRef text_selection $ \text_selectionPtr -> setSelected' text_selectionPtr b {# fun Fl_Text_Selection_includes as includes' { id `Ptr ()',`Int' } -> `Bool' cToBool #} -instance ( impl ~ (BufferOffset -> IO (Bool))) => Op (Includes ()) TextSelection orig impl where - runOp _ _ text_selection (BufferOffset pos) = withRef text_selection $ \text_selectionPtr -> includes' text_selectionPtr pos +instance ( impl ~ (AtIndex -> IO (Bool))) => Op (Includes ()) TextSelection orig impl where + runOp _ _ text_selection (AtIndex pos) = withRef text_selection $ \text_selectionPtr -> includes' text_selectionPtr pos {# fun Fl_Text_Selection_position as position' { id `Ptr ()', id `Ptr CInt', id `Ptr CInt' } -> `Int' #} -instance ( impl ~ (IO (Maybe BufferRange))) => Op (GetPosition ()) TextSelection orig impl where +instance ( impl ~ (IO (Maybe IndexRange))) => Op (GetPosition ()) TextSelection orig impl where runOp _ _ text_selection = withRef text_selection $ \text_selectionPtr -> - statusToBufferRange $ position' text_selectionPtr + statusToIndexRange $ position' text_selectionPtr -- $hierarchy -- @ @@ -55,19 +55,19 @@ -- $functions -- @ --- end :: 'Ref' 'TextSelection' -> 'IO' 'BufferOffset' +-- end :: 'Ref' 'TextSelection' -> 'IO' ('AtIndex') -- --- getPosition :: 'Ref' 'TextSelection' -> 'IO' ('Maybe' 'BufferRange') +-- getPosition :: 'Ref' 'TextSelection' -> 'IO' ('Maybe' 'IndexRange') -- --- includes :: 'Ref' 'TextSelection' -> 'BufferOffset' -> 'IO' 'Bool' +-- includes :: 'Ref' 'TextSelection' -> 'AtIndex' -> 'IO' ('Bool') -- --- selected :: 'Ref' 'TextSelection' -> 'IO' 'Bool' +-- selected :: 'Ref' 'TextSelection' -> 'IO' ('Bool') -- --- set :: 'Ref' 'TextSelection' -> 'BufferRange' -> 'IO' () +-- set :: 'Ref' 'TextSelection' -> 'IndexRange' -> 'IO' () -- -- setSelected :: 'Ref' 'TextSelection' -> 'Bool' -> 'IO' () -- --- start :: 'Ref' 'TextSelection' -> 'IO' 'BufferOffset' +-- start :: 'Ref' 'TextSelection' -> 'IO' 'AtIndex' -- --- update :: 'Ref' 'TextSelection' -> 'BufferOffset' -> 'Int' -> 'Int' -> 'IO' () +-- update :: 'Ref' 'TextSelection' -> 'AtIndex' -> 'Int' -> 'Int' -> 'IO' () -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Tile.chs b/src/Graphics/UI/FLTK/LowLevel/Tile.chs --- a/src/Graphics/UI/FLTK/LowLevel/Tile.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Tile.chs @@ -49,12 +49,13 @@ {# fun Fl_Tile_New_WithLabel as tileNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} tileNew :: Rectangle -> Maybe T.Text -> IO (Ref Tile) tileNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> tileNew' x_pos y_pos width height >>= - toRef - Just l -> tileNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Tile_position as setPosition' { id `Ptr ()',`Int',`Int',`Int',`Int' } -> `()' #} instance (impl ~ (Rectangle -> IO ())) => Op (SetPosition ()) Tile orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/ToggleButton.chs b/src/Graphics/UI/FLTK/LowLevel/ToggleButton.chs --- a/src/Graphics/UI/FLTK/LowLevel/ToggleButton.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ToggleButton.chs @@ -21,6 +21,7 @@ import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Widget import Graphics.UI.FLTK.LowLevel.Dispatch import qualified Data.Text as T @@ -31,8 +32,13 @@ let (x_pos, y_pos, width, height) = fromRectangle rectangle in case l' of Nothing -> widgetNew' x_pos y_pos width height >>= toRef - Just l -> widgetNewWithLabel' x_pos y_pos width height l >>= toRef + Just l -> do + ref <- widgetNewWithLabel' x_pos y_pos width height l >>= toRef + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref + {# fun Fl_Toggle_Button_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) ToggleButton orig impl where runOp _ _ button = swapRef button $ @@ -42,7 +48,6 @@ -- $functions -- @ --- -- destroy :: 'Ref' 'ToggleButton' -> 'IO' () -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Tooltip.chs b/src/Graphics/UI/FLTK/LowLevel/Tooltip.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/FLTK/LowLevel/Tooltip.chs @@ -0,0 +1,96 @@ +{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Graphics.UI.FLTK.LowLevel.Tooltip + ( + tooltipHoverdelay, + tooltipSetHoverdelay, + tooltipEnabled, + tooltipEnable, + tooltipColor, + tooltipCurrent, + tooltipDelay, + tooltipFont, + tooltipMarginHeight, + tooltipMarginWidth, + tooltipSetColor, + tooltipSetCurrent, + tooltipSetDelay, + tooltipSetFont, + tooltipSetMarginHeight, + tooltipSetMarginWidth, + tooltipSetSize, + tooltipSetTextcolor, + tooltipSetWrapWidth, + tooltipSize, + tooltipTextcolor, + tooltipWrapWidth + ) +where +#include "Fl_ExportMacros.h" +#include "Fl_Types.h" +#include "Fl_TooltipC.h" +import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) + +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Utils +import Graphics.UI.FLTK.LowLevel.Hierarchy +import Graphics.UI.FLTK.LowLevel.Dispatch +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +{# fun Fl_Tooltip_delay as tooltipDelay {} -> `Double' cFloatConv #} +{# fun Fl_Tooltip_set_delay as tooltipSetDelay { cFloatConv `Double' } -> `()' #} +{# fun Fl_Tooltip_hoverdelay as tooltipHoverdelay {} -> `Double' cFloatConv #} +{# fun Fl_Tooltip_set_hoverdelay as tooltipSetHoverdelay { cFloatConv `Double' } -> `()' #} +{# fun Fl_Tooltip_enabled as tooltipEnabled {} -> `Bool' cToBool #} +{# fun Fl_Tooltip_enable_with_b as tooltipEnable { cFromBool `Bool' } -> `()' #} +{# fun Fl_Tooltip_current as tooltipCurrent' {} -> `Ptr ()' #} +tooltipCurrent :: IO (Maybe (Ref Widget)) +tooltipCurrent = tooltipCurrent' >>= toMaybeRef +{# fun Fl_Tooltip_set_current as tooltipSetCurrent' {id `Ptr ()'} -> `()' #} +tooltipSetCurrent:: (Parent a Widget) => Maybe (Ref a) -> IO () +tooltipSetCurrent w = + case w of + Nothing -> tooltipSetCurrent' nullPtr + Just ref -> withRef ref (\refPtr -> tooltipSetCurrent' refPtr) + +{# fun Fl_Tooltip_font as tooltipFont {} -> `Font' cToFont #} +{# fun Fl_Tooltip_set_font as tooltipSetFont { cFromFont `Font' } -> `()' #} + +{# fun Fl_Tooltip_size as tooltipSize' {} -> `CInt' #} +tooltipSize :: IO FontSize +tooltipSize = tooltipSize' >>= return . FontSize +{# fun Fl_Tooltip_set_size as tooltipSetSize' { `CInt' } -> `()' #} +tooltipSetSize :: FontSize -> IO () +tooltipSetSize (FontSize fs) = tooltipSetSize' fs +{# fun Fl_Tooltip_color as tooltipColor' {} -> `CUInt' #} +tooltipColor :: IO Color +tooltipColor = tooltipColor' >>= return . Color +{# fun Fl_Tooltip_set_color as tooltipSetColor' { `CUInt' } -> `()' #} +tooltipSetColor :: Color -> IO () +tooltipSetColor (Color fs) = tooltipSetColor' fs +{# fun Fl_Tooltip_textcolor as tooltipTextcolor' {} -> `CUInt' #} +tooltipTextcolor :: IO Color +tooltipTextcolor = tooltipTextcolor' >>= return . Color +{# fun Fl_Tooltip_set_textcolor as tooltipSetTextcolor' { `CUInt' } -> `()' #} +tooltipSetTextcolor :: Color -> IO () +tooltipSetTextcolor (Color fs) = tooltipSetTextcolor' fs + +{# fun Fl_Tooltip_margin_width as tooltipMarginwidth' {} -> `CInt' #} +tooltipMarginWidth :: IO Width +tooltipMarginWidth = tooltipMarginwidth' >>= return . Width . fromIntegral +{# fun Fl_Tooltip_set_margin_width as tooltipSetMarginwidth' { `CInt' } -> `()' #} +tooltipSetMarginWidth :: Width -> IO () +tooltipSetMarginWidth (Width fs) = tooltipSetMarginwidth' (fromIntegral fs) + +{# fun Fl_Tooltip_margin_height as tooltipMarginheight' {} -> `CInt' #} +tooltipMarginHeight :: IO Height +tooltipMarginHeight = tooltipMarginheight' >>= return . Height . fromIntegral +{# fun Fl_Tooltip_set_margin_height as tooltipSetMarginheight' { `CInt' } -> `()' #} +tooltipSetMarginHeight :: Height -> IO () +tooltipSetMarginHeight (Height fs) = tooltipSetMarginheight' (fromIntegral fs) + +{# fun Fl_Tooltip_wrap_width as tooltipWrapWidth' {} -> `CInt' #} +tooltipWrapWidth :: IO Width +tooltipWrapWidth = tooltipWrapWidth' >>= return . Width . fromIntegral +{# fun Fl_Tooltip_set_wrap_width as tooltipSetWrapWidth' { `CInt' } -> `()' #} +tooltipSetWrapWidth :: Width -> IO () +tooltipSetWrapWidth (Width fs) = tooltipSetWrapWidth' (fromIntegral fs) diff --git a/src/Graphics/UI/FLTK/LowLevel/Tree.chs b/src/Graphics/UI/FLTK/LowLevel/Tree.chs --- a/src/Graphics/UI/FLTK/LowLevel/Tree.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Tree.chs @@ -48,12 +48,14 @@ {# fun Fl_Tree_New_WithLabel as treeNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} treeNew :: Rectangle -> Maybe T.Text -> IO (Ref Tree) treeNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> treeNew' x_pos y_pos width height >>= - toRef - Just l -> treeNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' + {# fun Fl_Tree_Destroy as treeDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Tree orig impl where runOp _ _ tree = swapRef tree $ \treePtr -> do @@ -83,8 +85,8 @@ instance (Parent a TreeItem, impl ~ (Ref a -> T.Text -> IO (Maybe (Ref a)))) => Op (InsertAbove ()) Tree orig impl where runOp _ _ tree above name = withRef tree $ \treePtr -> withRef above $ \abovePtr -> insertAbove' treePtr abovePtr name >>= toMaybeRef {# fun Fl_Tree_insert as insert' { id `Ptr ()',id `Ptr ()',unsafeToCString `T.Text',`Int' } -> `Ptr ()' id #} -instance (Parent a TreeItem, impl ~ (Ref a -> T.Text -> Int -> IO (Maybe (Ref a)))) => Op (Insert ()) Tree orig impl where - runOp _ _ tree item name pos = withRef tree $ \treePtr -> withRef item $ \itemPtr -> insert' treePtr itemPtr name pos >>= toMaybeRef +instance (Parent a TreeItem, impl ~ (Ref a -> T.Text -> AtIndex -> IO (Maybe (Ref a)))) => Op (Insert ()) Tree orig impl where + runOp _ _ tree item name (AtIndex pos) = withRef tree $ \treePtr -> withRef item $ \itemPtr -> insert' treePtr itemPtr name pos >>= toMaybeRef {# fun Fl_Tree_remove as remove' { id `Ptr ()',id `Ptr ()' } -> `Int' #} instance (impl ~ (Ref TreeItem -> IO (Either TreeItemNotFound ())) ) => Op (Remove ()) Tree orig impl where runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> do @@ -408,12 +410,12 @@ runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> displayed' treePtr itemPtr {# fun Fl_Tree_show_item_with_yoff as showItemWithYoff' { id `Ptr ()',id `Ptr ()',`Int' } -> `()' #} {# fun Fl_Tree_show_item as showItem' { id `Ptr ()',id `Ptr ()' } -> `()' #} -instance (impl ~ (Ref TreeItem -> Maybe Int -> IO ()) ) => Op (ShowItemWithYoff ()) Tree orig impl where +instance (impl ~ (Ref TreeItem -> Maybe Y -> IO ()) ) => Op (ShowItemWithYoff ()) Tree orig impl where runOp _ _ tree item yoff = withRef tree $ \treePtr -> withRef item $ \itemPtr -> case yoff of - Just y' -> showItemWithYoff' treePtr itemPtr y' + Just (Y y') -> showItemWithYoff' treePtr itemPtr y' Nothing -> showItem' treePtr itemPtr {# fun Fl_Tree_show_item_top as showItemTop' { id `Ptr ()',id `Ptr ()' } -> `()' #} instance (impl ~ (Ref TreeItem -> IO ()) ) => Op (ShowItemTop ()) Tree orig impl where @@ -491,6 +493,33 @@ {# fun Fl_Tree_show_super as showSuper' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ ( IO ())) => Op (ShowWidgetSuper ()) Tree orig impl where runOp _ _ tree = withRef tree $ \treePtr -> showSuper' treePtr +{# fun Fl_Tree_recalc_tree as recalcTree' { id `Ptr ()' } -> `()' supressWarningAboutRes #} +instance (impl ~ ( IO ())) => Op (RecalcTree ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> recalcTree' treePtr +{# fun Fl_Tree_marginbottom as marginbottom' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Int)) ) => Op (GetMarginbottom ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> marginbottom' treePtr +{# fun Fl_Tree_set_marginbottom as setMarginbottom' { id `Ptr ()',`Int' } -> `()' #} +instance (impl ~ (Int -> IO ()) ) => Op (SetMarginbottom ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setMarginbottom' treePtr val +{# fun Fl_Tree_widgetmarginleft as widgetmarginleft' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Int)) ) => Op (GetWidgetmarginleft ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> widgetmarginleft' treePtr +{# fun Fl_Tree_set_widgetmarginleft as setWidgetmarginleft' { id `Ptr ()',`Int' } -> `()' #} +instance (impl ~ (Int -> IO ()) ) => Op (SetWidgetmarginleft ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setWidgetmarginleft' treePtr val +{# fun Fl_Tree_item_reselect_mode as item_reselect_mode' { id `Ptr ()' } -> `TreeItemReselectMode' cToEnum #} +instance (impl ~ ( IO (TreeItemReselectMode)) ) => Op (GetItemReselectMode ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> item_reselect_mode' treePtr +{# fun Fl_Tree_set_item_reselect_mode as setItem_Reselect_Mode' { id `Ptr ()', cFromEnum `TreeItemReselectMode' } -> `()' #} +instance (impl ~ (TreeItemReselectMode -> IO ()) ) => Op (SetItemReselectMode ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Reselect_Mode' treePtr val +{# fun Fl_Tree_item_draw_mode as item_draw_mode' { id `Ptr ()' } -> `CInt'#} +instance (impl ~ ( IO ([TreeItemDrawMode])) ) => Op (GetItemDrawMode ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> item_draw_mode' treePtr >>= return . extract allTreeItemDrawModes +{# fun Fl_Tree_set_item_draw_mode as setItem_Draw_Mode' { id `Ptr ()', `CInt' } -> `()' #} +instance (impl ~ ([TreeItemDrawMode] -> IO ()) ) => Op (SetItemDrawMode ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Draw_Mode' treePtr (fromIntegral (combine val)) -- $functions -- @ @@ -506,7 +535,7 @@ -- -- closeAndCallback :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'Bool' -> 'IO' () -- --- deselect :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Int') +-- deselect :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Either' 'NoChange' ()) -- -- deselectAll :: 'Ref' 'Tree' -> 'IO' () -- @@ -544,6 +573,8 @@ -- -- getFirst :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- +-- getItemDrawMode :: 'Ref' 'Tree' -> 'IO' (['TreeItemDrawMode')] +-- -- getItemFocus :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- -- getItemLabelbgcolor :: 'Ref' 'Tree' -> 'IO' ('Color') @@ -554,12 +585,16 @@ -- -- getItemLabelsize :: 'Ref' 'Tree' -> 'IO' ('FontSize') -- +-- getItemReselectMode :: 'Ref' 'Tree' -> 'IO' ('TreeItemReselectMode') +-- -- getLabelmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int') -- -- getLast :: 'Ref' 'Tree' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- -- getLinespacing :: 'Ref' 'Tree' -> 'IO' ('Int') -- +-- getMarginbottom :: 'Ref' 'Tree' -> 'IO' ('Int') +-- -- getMarginleft :: 'Ref' 'Tree' -> 'IO' ('Int') -- -- getMargintop :: 'Ref' 'Tree' -> 'IO' ('Int') @@ -584,6 +619,8 @@ -- -- getVposition :: 'Ref' 'Tree' -> 'IO' ('Int') -- +-- getWidgetmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int') +-- -- handle :: 'Ref' 'Tree' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- handleSuper :: 'Ref' 'Tree' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) @@ -592,7 +629,7 @@ -- -- hideSuper :: 'Ref' 'Tree' -> 'IO' () -- --- insert:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'T.Text' -> 'Int' -> 'IO' ('Maybe' ('Ref' a)) +-- insert:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'T.Text' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' a)) -- -- insertAbove:: ('Parent' a 'TreeItem') => 'Ref' 'Tree' -> 'Ref' a -> 'T.Text' -> 'IO' ('Maybe' ('Ref' a)) -- @@ -636,6 +673,8 @@ -- -- prevBeforeItem :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- +-- recalcTree :: 'Ref' 'Tree' -> 'IO' () +-- -- remove :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' ('Either' 'TreeItemNotFound' ()) -- -- resize :: 'Ref' 'Tree' -> 'Rectangle' -> 'IO' () @@ -646,7 +685,7 @@ -- -- rootLabel :: 'Ref' 'Tree' -> 'T.Text' -> 'IO' () -- --- select :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Int') +-- select :: 'Ref' 'Tree' -> 'TreeItemLocator' -> 'IO' ('Either' 'NoChange' ()) -- -- selectAll :: 'Ref' 'Tree' -> 'IO' () -- @@ -676,6 +715,8 @@ -- -- setConnectorwidth :: 'Ref' 'Tree' -> 'Int' -> 'IO' () -- +-- setItemDrawMode :: 'Ref' 'Tree' -> ['TreeItemDrawMode'] -> 'IO' () +-- -- setItemFocus :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' () -- -- setItemLabelbgcolor :: 'Ref' 'Tree' -> 'Color' -> 'IO' () @@ -686,10 +727,14 @@ -- -- setItemLabelsize :: 'Ref' 'Tree' -> 'FontSize' -> 'IO' () -- +-- setItemReselectMode :: 'Ref' 'Tree' -> 'TreeItemReselectMode' -> 'IO' () +-- -- setLabelmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' () -- -- setLinespacing :: 'Ref' 'Tree' -> 'Int' -> 'IO' () -- +-- setMarginbottom :: 'Ref' 'Tree' -> 'Int' -> 'IO' () +-- -- setMarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' () -- -- setMargintop :: 'Ref' 'Tree' -> 'Int' -> 'IO' () @@ -716,13 +761,15 @@ -- -- setVposition :: 'Ref' 'Tree' -> 'Int' -> 'IO' () -- +-- setWidgetmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' () +-- -- showItemBottom :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' () -- -- showItemMiddle :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' () -- -- showItemTop :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'IO' () -- --- showItemWithYoff :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Maybe' 'Int' -> 'IO' () +-- showItemWithYoff :: 'Ref' 'Tree' -> 'Ref' 'TreeItem' -> 'Maybe' 'Y' -> 'IO' () -- -- showSelf :: 'Ref' 'Tree' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/TreeItem.chs b/src/Graphics/UI/FLTK/LowLevel/TreeItem.chs --- a/src/Graphics/UI/FLTK/LowLevel/TreeItem.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TreeItem.chs @@ -2,7 +2,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.TreeItem ( - TreeItemIndex(..), TreeItemPointer(..), TreeItemName(..), TreeItemReference(..), @@ -36,10 +35,9 @@ import Graphics.UI.FLTK.LowLevel.Dispatch import qualified Data.Text as T -newtype TreeItemIndex = TreeItemIndex Int data TreeItemPointer = forall a. (Parent a TreeItem) => TreeItemPointer (Ref a) newtype TreeItemName = TreeItemName T.Text -data TreeItemReference = TreeItemByIndex TreeItemIndex | TreeItemByPointer TreeItemPointer +data TreeItemReference = TreeItemByIndex AtIndex | TreeItemByPointer TreeItemPointer data TreeItemLocator = TreeItemPointerLocator TreeItemPointer | TreeItemNameLocator TreeItemName data MoveError = NoParent | NoIndexFound | IndexRangeError | CouldNotDeparent | CouldNotReparent data MoveType = MoveAbove | MoveBelow | MoveInto SiblingPosition @@ -127,20 +125,20 @@ instance (impl ~ (IO (Int))) => Op (Children ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> children' tree_itemPtr {# fun Fl_Tree_Item_child_by_index as childByIndex' { id `Ptr ()',`Int' } -> `Ptr ()' id #} -instance (impl ~ ( Int -> IO (Maybe (Ref Widget)))) => Op (Child ()) TreeItem orig impl where - runOp _ _ tree_item index' = withRef tree_item $ \tree_itemPtr -> childByIndex' tree_itemPtr index' >>= toMaybeRef +instance (impl ~ ( AtIndex -> IO (Maybe (Ref Widget)))) => Op (Child ()) TreeItem orig impl where + runOp _ _ tree_item (AtIndex index') = withRef tree_item $ \tree_itemPtr -> childByIndex' tree_itemPtr index' >>= toMaybeRef {# fun Fl_Tree_Item_has_children as hasChildren' { id `Ptr ()' } -> `Bool' cToBool #} instance (impl ~ (IO (Bool))) => Op (HasChildren ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> hasChildren' tree_itemPtr {# fun Fl_Tree_Item_find_child as findChild' { id `Ptr ()',unsafeToCString `T.Text' } -> `Int' #} {# fun Fl_Tree_Item_find_child_by_item as findChildByItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} -instance (impl ~ ( TreeItemLocator -> IO (Maybe TreeItemIndex))) => Op (FindChild ()) TreeItem orig impl where +instance (impl ~ ( TreeItemLocator -> IO (Maybe AtIndex))) => Op (FindChild ()) TreeItem orig impl where runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> do idx' <- case locator' of (TreeItemPointerLocator (TreeItemPointer item')) -> withRef item' $ \itemPtr-> findChildByItem' tree_itemPtr itemPtr (TreeItemNameLocator (TreeItemName name')) -> findChild' tree_itemPtr name' - if idx' == -1 then return Nothing else (return $ Just (TreeItemIndex idx')) + if idx' == -1 then return Nothing else (return $ Just (AtIndex idx')) {# fun Fl_Tree_Item_remove_child_by_item as removeChildByItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun Fl_Tree_Item_remove_child as removeChild' { id `Ptr ()',unsafeToCString `T.Text' } -> `Int' #} @@ -154,8 +152,8 @@ instance (impl ~ (IO ())) => Op (ClearChildren ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> clearChildren' tree_itemPtr {# fun Fl_Tree_Item_swap_children as swapChildren' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ ( Int -> Int -> IO ())) => Op (SwapChildren ()) TreeItem orig impl where - runOp _ _ tree_item ax bx = withRef tree_item $ \tree_itemPtr -> swapChildren' tree_itemPtr ax bx +instance (impl ~ ( AtIndex -> AtIndex -> IO ())) => Op (SwapChildren ()) TreeItem orig impl where + runOp _ _ tree_item (AtIndex ax) (AtIndex bx) = withRef tree_item $ \tree_itemPtr -> swapChildren' tree_itemPtr ax bx {# fun Fl_Tree_Item_swap_children_by_tree_item as swapChildrenByTreeItem' { id `Ptr ()',id `Ptr ()',id `Ptr ()' } -> `Int' #} instance (Parent a TreeItem, impl ~ (Ref a -> Ref a -> IO (Either TreeItemNotFound ()))) => Op (SwapChildrenByTreeItem ()) TreeItem orig impl where runOp _ _ tree_item a b = withRef tree_item $ \tree_itemPtr -> withRef a $ \aPtr -> withRef b $ \bPtr -> do @@ -188,12 +186,12 @@ Just i' -> withRef i' $ \i'Ptr -> addWithAt' tree_itemPtr prefsPtr i'Ptr pathPtr >>= toMaybeRef {# fun Fl_Tree_Item_insert as insert' { id `Ptr ()',id `Ptr ()',unsafeToCString `T.Text' } -> `Ptr ()' id #} {# fun Fl_Tree_Item_insert_with_pos as insertWithPos' { id `Ptr ()',id `Ptr ()',unsafeToCString `T.Text',`Int' } -> `Ptr ()' id #} -instance (Parent a TreePrefs, impl ~ (Ref a -> T.Text -> Maybe Int -> IO (Maybe (Ref TreeItem)))) => Op (Insert ()) TreeItem orig impl where +instance (Parent a TreePrefs, impl ~ (Ref a -> T.Text -> Maybe AtIndex -> IO (Maybe (Ref TreeItem)))) => Op (Insert ()) TreeItem orig impl where runOp _ _ tree_item prefs new_label pos' = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> case pos' of Nothing -> insert' tree_itemPtr prefsPtr new_label >>= toMaybeRef - Just p' -> insertWithPos' tree_itemPtr prefsPtr new_label p' >>= toMaybeRef + Just (AtIndex p') -> insertWithPos' tree_itemPtr prefsPtr new_label p' >>= toMaybeRef {# fun Fl_Tree_Item_insert_above as insertAbove' { id `Ptr ()',id `Ptr ()', unsafeToCString `T.Text' } -> `Ptr ()' id #} instance (Parent a TreePrefs, impl ~ (Ref a -> T.Text -> IO (Maybe (Ref TreeItem)))) => Op (InsertAbove ()) TreeItem orig impl where runOp _ _ tree_item prefs new_label = @@ -201,19 +199,19 @@ \tree_itemPtr -> withRef prefs $ \prefsPtr -> insertAbove' tree_itemPtr prefsPtr new_label >>= toMaybeRef {# fun Fl_Tree_Item_deparent as deparent' { id `Ptr ()', `Int'} -> `Ptr ()' id #} -instance (impl ~ (Int -> IO (Either UnknownError (Ref orig)))) => Op (Deparent ()) TreeItem orig impl where - runOp _ _ tree_item pos' = withRef tree_item $ \tree_itemPtr -> do +instance (impl ~ (AtIndex -> IO (Either UnknownError (Ref orig)))) => Op (Deparent ()) TreeItem orig impl where + runOp _ _ tree_item (AtIndex pos') = withRef tree_item $ \tree_itemPtr -> do item' <- deparent' tree_itemPtr pos' if (item' == nullPtr) then (return $ Left UnknownError) else toRef item' >>= return . Right {# fun Fl_Tree_Item_reparent as reparent' { id `Ptr ()', id `Ptr ()', `Int'} -> `Int' #} -instance (Parent a TreeItem, impl ~ (Ref a -> Int -> IO (Either UnknownError ()))) => Op (Reparent ()) TreeItem orig impl where - runOp _ _ tree_item child_item pos' = +instance (Parent a TreeItem, impl ~ (Ref a -> AtIndex -> IO (Either UnknownError ()))) => Op (Reparent ()) TreeItem orig impl where + runOp _ _ tree_item child_item (AtIndex pos') = withRef tree_item $ \tree_itemPtr -> withRef child_item $ \child_itemPtr -> do status' <- reparent' tree_itemPtr child_itemPtr pos' if (status' < 0) then (return $ Left UnknownError) else (return $ Right ()) {# fun Fl_Tree_Item_move as move' { id `Ptr ()', `Int', `Int'} -> `Int' #} -instance (impl ~ (Int -> Int -> IO (Either OutOfRange ()))) => Op (Move ()) TreeItem orig impl where - runOp _ _ tree_item pos' spos' = +instance (impl ~ (AtIndex -> AtIndex -> IO (Either OutOfRange ()))) => Op (Move ()) TreeItem orig impl where + runOp _ _ tree_item (AtIndex pos') (AtIndex spos') = withRef tree_item $ \tree_itemPtr -> do status' <- move' tree_itemPtr pos' spos' if status' == -1 then (return $ Left OutOfRange) else return (Right ()) @@ -247,8 +245,8 @@ instance (impl ~ (IO (Maybe (Ref TreeItem)))) => Op (PrevSibling ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> prevSibling' tree_itemPtr >>= toMaybeRef {# fun Fl_Tree_Item_update_prev_next as updatePrevNext' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (UpdatePrevNext ()) TreeItem orig impl where - runOp _ _ tree_item index' = withRef tree_item $ \tree_itemPtr -> updatePrevNext' tree_itemPtr index' +instance (impl ~ ( AtIndex -> IO ())) => Op (UpdatePrevNext ()) TreeItem orig impl where + runOp _ _ tree_item (AtIndex index') = withRef tree_item $ \tree_itemPtr -> updatePrevNext' tree_itemPtr index' {# fun Fl_Tree_Item_next_displayed as nextDisplayed' { id `Ptr ()',id `Ptr ()' } -> `Ptr ()' id #} instance (Parent a TreePrefs, impl ~ (Ref a -> IO (Maybe (Ref TreeItem)))) => Op (NextDisplayed ()) TreeItem orig impl where runOp _ _ tree_item prefs = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> nextDisplayed' tree_itemPtr prefsPtr >>= toMaybeRef @@ -279,8 +277,8 @@ {# fun Fl_Tree_Item_select as select' { id `Ptr ()' } -> `()' #} instance (impl ~ (IO ())) => Op (Select ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> select' tree_itemPtr -{# fun Fl_Tree_Item_select_with_val as selectWithVal' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SelectWithVal ()) TreeItem orig impl where +{# fun Fl_Tree_Item_select_with_val as selectWithVal' { id `Ptr ()',cFromBool `Bool' } -> `()' #} +instance (impl ~ ( Bool -> IO ())) => Op (SelectSet ()) TreeItem orig impl where runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> selectWithVal' tree_itemPtr val {# fun Fl_Tree_Item_select_toggle as selectToggle' { id `Ptr ()' } -> `()' #} instance (impl ~ (IO ())) => Op (SelectToggle ()) TreeItem orig impl where @@ -356,7 +354,7 @@ -- -- addAt:: ('Parent' a 'TreeItem', 'Parent' b 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' b -> ['T.Text'] -> 'Maybe' ('Ref' a) -> 'IO' ('Maybe' ('Ref' a)) -- --- child :: 'Ref' 'TreeItem' -> 'Int' -> 'IO' ('Maybe' ('Ref' 'Widget')) +-- child :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'Widget')) -- -- children :: 'Ref' 'TreeItem' -> 'IO' ('Int') -- @@ -364,7 +362,7 @@ -- -- close :: 'Ref' 'TreeItem' -> 'IO' () -- --- deparent :: 'Ref' 'TreeItem' -> 'Int' -> 'IO' ('Either' 'UnknownError' ('Ref' orig)) +-- deparent :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'IO' ('Either' 'UnknownError' ('Ref' orig)) -- -- deselect :: 'Ref' 'TreeItem' -> 'IO' () -- @@ -376,7 +374,7 @@ -- -- eventOnLabel:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Int') -- --- findChild :: 'Ref' 'TreeItem' -> 'TreeItemLocator' -> 'IO' ('Maybe' 'TreeItemIndex') +-- findChild :: 'Ref' 'TreeItem' -> 'TreeItemLocator' -> 'IO' ('Maybe' 'AtIndex') -- -- findClicked:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- @@ -414,7 +412,7 @@ -- -- hasChildren :: 'Ref' 'TreeItem' -> 'IO' ('Bool') -- --- insert:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'T.Text' -> 'Maybe' 'Int' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) +-- insert:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'T.Text' -> 'Maybe' 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- -- insertAbove:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'T.Text' -> 'IO' ('Maybe' ('Ref' 'TreeItem')) -- @@ -438,7 +436,7 @@ -- -- labelY :: 'Ref' 'TreeItem' -> 'IO' ('Int') -- --- move :: 'Ref' 'TreeItem' -> 'Int' -> 'Int' -> 'IO' ('Either' 'OutOfRange' ()) +-- move :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' ()) -- -- moveTo:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'MoveType' -> 'IO' ('Either' 'MoveError' ()) -- @@ -460,15 +458,15 @@ -- -- removeChild :: 'Ref' 'TreeItem' -> 'TreeItemLocator' -> 'IO' ('Either' 'UnknownError' ()) -- --- reparent:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'Int' -> 'IO' ('Either' 'UnknownError' ()) +-- reparent:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'AtIndex' -> 'IO' ('Either' 'UnknownError' ()) -- -- select :: 'Ref' 'TreeItem' -> 'IO' () -- -- selectAll :: 'Ref' 'TreeItem' -> 'IO' ('Int') -- --- selectToggle :: 'Ref' 'TreeItem' -> 'IO' () +-- selectSet :: 'Ref' 'TreeItem' -> 'Bool' -> 'IO' () -- --- selectWithVal :: 'Ref' 'TreeItem' -> 'Int' -> 'IO' () +-- selectToggle :: 'Ref' 'TreeItem' -> 'IO' () -- -- setLabel :: 'Ref' 'TreeItem' -> 'T.Text' -> 'IO' () -- @@ -490,11 +488,11 @@ -- -- showSelf :: 'Ref' 'TreeItem' -> 'Maybe' 'T.Text' -> 'IO' () -- --- swapChildren :: 'Ref' 'TreeItem' -> 'Int' -> 'Int' -> 'IO' () +-- swapChildren :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'AtIndex' -> 'IO' () -- -- swapChildrenByTreeItem:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'Ref' a -> 'IO' ('Either' 'TreeItemNotFound' ()) -- --- updatePrevNext :: 'Ref' 'TreeItem' -> 'Int' -> 'IO' () +-- updatePrevNext :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'IO' () -- -- visible :: 'Ref' 'TreeItem' -> 'IO' ('Bool') -- diff --git a/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs b/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs --- a/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs +++ b/src/Graphics/UI/FLTK/LowLevel/TreePrefs.chs @@ -170,10 +170,33 @@ {# fun Fl_Tree_Prefs_set_selectmode as setSelectmode' { id `Ptr ()', cFromEnum `TreeSelect' } -> `()' #} instance (impl ~ (TreeSelect -> IO ())) => Op (SetSelectmode ()) TreePrefs orig impl where runOp _ _ tree_prefs val = withRef tree_prefs $ \tree_prefsPtr -> setSelectmode' tree_prefsPtr val +{# fun Fl_Tree_Prefs_marginbottom as marginbottom' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Int)) ) => Op (GetMarginbottom ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> marginbottom' treePtr +{# fun Fl_Tree_Prefs_set_marginbottom as setMarginbottom' { id `Ptr ()',`Int' } -> `()' #} +instance (impl ~ (Int -> IO ()) ) => Op (SetMarginbottom ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setMarginbottom' treePtr val +{# fun Fl_Tree_Prefs_widgetmarginleft as widgetmarginleft' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Int)) ) => Op (GetWidgetmarginleft ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> widgetmarginleft' treePtr +{# fun Fl_Tree_Prefs_set_widgetmarginleft as setWidgetmarginleft' { id `Ptr ()',`Int' } -> `()' #} +instance (impl ~ (Int -> IO ()) ) => Op (SetWidgetmarginleft ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setWidgetmarginleft' treePtr val +{# fun Fl_Tree_Prefs_item_reselect_mode as item_reselect_mode' { id `Ptr ()' } -> `TreeItemReselectMode' cToEnum #} +instance (impl ~ ( IO (TreeItemReselectMode)) ) => Op (GetItemReselectMode ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> item_reselect_mode' treePtr +{# fun Fl_Tree_Prefs_set_item_reselect_mode as setItem_Reselect_Mode' { id `Ptr ()', cFromEnum `TreeItemReselectMode' } -> `()' #} +instance (impl ~ (TreeItemReselectMode -> IO ()) ) => Op (SetItemReselectMode ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Reselect_Mode' treePtr val +{# fun Fl_Tree_Prefs_item_draw_mode as item_draw_mode' { id `Ptr ()' } -> `CInt'#} +instance (impl ~ ( IO ([TreeItemDrawMode])) ) => Op (GetItemDrawMode ()) Tree orig impl where + runOp _ _ tree = withRef tree $ \treePtr -> item_draw_mode' treePtr >>= return . extract allTreeItemDrawModes +{# fun Fl_Tree_Prefs_set_item_draw_mode as setItem_Draw_Mode' { id `Ptr ()', `CInt' } -> `()' #} +instance (impl ~ ([TreeItemDrawMode] -> IO ()) ) => Op (SetItemDrawMode ()) Tree orig impl where + runOp _ _ tree val = withRef tree $ \treePtr -> setItem_Draw_Mode' treePtr (fromIntegral (combine val)) -- $functions -- @ --- -- getCloseicon :: 'Ref' 'TreePrefs' -> 'IO' ('Maybe' ('Ref' 'Image')) -- -- getConnectorcolor :: 'Ref' 'TreePrefs' -> 'IO' ('Color') @@ -182,12 +205,16 @@ -- -- getConnectorwidth :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- +-- getItemDrawMode :: 'Ref' 'Tree' -> 'IO' (['TreeItemDrawMode')] +-- -- getItemLabelbgcolor :: 'Ref' 'TreePrefs' -> 'IO' ('Color') -- -- getItemLabelfont :: 'Ref' 'TreePrefs' -> 'IO' ('Font') -- -- getItemLabelsize :: 'Ref' 'TreePrefs' -> 'IO' ('FontSize') -- +-- getItemReselectMode :: 'Ref' 'Tree' -> 'IO' ('TreeItemReselectMode') +-- -- getLabelbgcolor :: 'Ref' 'TreePrefs' -> 'IO' ('Color') -- -- getLabelfgcolor :: 'Ref' 'TreePrefs' -> 'IO' ('Color') @@ -200,6 +227,8 @@ -- -- getLinespacing :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- +-- getMarginbottom :: 'Ref' 'Tree' -> 'IO' ('Int') +-- -- getMarginleft :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- -- getMargintop :: 'Ref' 'TreePrefs' -> 'IO' ('Int') @@ -222,6 +251,8 @@ -- -- getUsericonmarginleft :: 'Ref' 'TreePrefs' -> 'IO' ('Int') -- +-- getWidgetmarginleft :: 'Ref' 'Tree' -> 'IO' ('Int') +-- -- setCloseicon:: ('Parent' a 'Image') => 'Ref' 'TreePrefs' -> 'Maybe' ( 'Ref' a ) -> 'IO' () -- -- setConnectorcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () @@ -230,12 +261,16 @@ -- -- setConnectorwidth :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- +-- setItemDrawMode :: 'Ref' 'Tree' -> ['TreeItemDrawMode'] -> 'IO' () +-- -- setItemLabelbgcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () -- -- setItemLabelfgcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () -- -- setItemLabelsize :: 'Ref' 'TreePrefs' -> 'FontSize' -> 'IO' () -- +-- setItemReselectMode :: 'Ref' 'Tree' -> 'TreeItemReselectMode' -> 'IO' () +-- -- setLabelbgcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () -- -- setLabelfgcolor :: 'Ref' 'TreePrefs' -> 'Color' -> 'IO' () @@ -248,6 +283,8 @@ -- -- setLinespacing :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- +-- setMarginbottom :: 'Ref' 'Tree' -> 'Int' -> 'IO' () +-- -- setMarginleft :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () -- -- setMargintop :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () @@ -269,6 +306,8 @@ -- setUsericon:: ('Parent' a 'Image') => 'Ref' 'TreePrefs' -> 'Maybe' ( 'Ref' a ) -> 'IO' () -- -- setUsericonmarginleft :: 'Ref' 'TreePrefs' -> 'Int' -> 'IO' () +-- +-- setWidgetmarginleft :: 'Ref' 'Tree' -> 'Int' -> 'IO' () -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/Utils.hs b/src/Graphics/UI/FLTK/LowLevel/Utils.hs --- a/src/Graphics/UI/FLTK/LowLevel/Utils.hs +++ b/src/Graphics/UI/FLTK/LowLevel/Utils.hs @@ -26,15 +26,15 @@ foreign import ccall "wrapper" mkCallbackPtr :: CallbackPrim -> IO (FunPtr CallbackPrim) foreign import ccall "wrapper" - mkColorAverageCallbackPtr :: ColorAverageCallbackPrim -> IO (FunPtr ColorAverageCallbackPrim) + mkCustomColorAveragePtr :: CustomColorAveragePrim -> IO (FunPtr CustomColorAveragePrim) foreign import ccall "wrapper" mkGlobalEventHandlerPtr :: GlobalEventHandlerPrim -> IO (FunPtr GlobalEventHandlerPrim) foreign import ccall "wrapper" mkDrawCallbackPrimPtr :: DrawCallbackPrim -> IO (FunPtr DrawCallbackPrim) foreign import ccall "wrapper" - mkImageDrawCallbackPrimPtr :: ImageDrawCallbackPrim -> IO (FunPtr ImageDrawCallbackPrim) + mkCustomImageDrawPrimPtr :: CustomImageDrawPrim -> IO (FunPtr CustomImageDrawPrim) foreign import ccall "wrapper" - mkImageCopyCallbackPrimPtr :: ImageCopyCallbackPrim -> IO (FunPtr ImageCopyCallbackPrim) + mkCustomImageCopyPrimPtr :: CustomImageCopyPrim -> IO (FunPtr CustomImageCopyPrim) foreign import ccall "wrapper" mkUnfinishedStyleCbPrim :: UnfinishedStyleCbPrim -> IO (FunPtr UnfinishedStyleCbPrim) foreign import ccall "wrapper" @@ -55,7 +55,45 @@ mkFDHandlerPrim :: FDHandlerPrim -> IO (FunPtr FDHandlerPrim) foreign import ccall "wrapper" mkGlobalCallbackPtr:: GlobalCallback -> IO (FunPtr GlobalCallback) +foreign import ccall "wrapper" + mkMenuItemDrawFPtr :: MenuItemDrawF -> IO (FunPtr MenuItemDrawF) +foreign import ccall "wrapper" + mkTabPositionsPrim :: TabPositionsPrim -> IO (FunPtr TabPositionsPrim) +foreign import ccall "wrapper" + mkTabHeightPrim :: TabHeightPrim -> IO (FunPtr TabHeightPrim) +foreign import ccall "wrapper" + mkTabWhichPrim :: TabWhichPrim -> IO (FunPtr TabWhichPrim) +foreign import ccall "wrapper" + mkTabClientAreaPrim :: TabClientAreaPrim -> IO (FunPtr TabClientAreaPrim) +foreign import ccall "wrapper" + mkGetDouble :: GetDoublePrim -> IO (FunPtr GetDoublePrim) +foreign import ccall "wrapper" + mkGetInt :: GetIntPrim -> IO (FunPtr GetIntPrim) +foreign import ccall "wrapper" + mkSetInt :: SetIntPrim -> IO (FunPtr SetIntPrim) +foreign import ccall "wrapper" + mkColorSetPrim :: ColorSetPrim -> IO (FunPtr ColorSetPrim) +toTabPositionsPrim :: (Ref a -> IO (Maybe AtIndex, Int, [(X,Width)])) -> IO (FunPtr TabPositionsPrim) +toTabPositionsPrim f = + mkTabPositionsPrim (\tabPtr posPtr widthPtr -> do + pp <- wrapNonNull tabPtr "Null pointer. toTabPositionsPrim" + (selected, padding, posAndWidths) <- f (castTo (wrapInRef pp)) + pokeArray posPtr ([fromIntegral padding] ++ (map (\(X x,_) -> fromIntegral x) posAndWidths)) + pokeArray widthPtr (map (\(_,Width w) -> fromIntegral w) posAndWidths) + maybe (return (0 :: CInt)) (\(AtIndex i) -> return (fromIntegral i)) selected + ) + +toTabHeightPrim :: + (Ref a -> IO Height) -> + IO (FunPtr TabHeightPrim) +toTabHeightPrim f = + mkTabHeightPrim (\ptr -> do + pp <- wrapNonNull ptr "Null pointer. toTabHeightPrim" + (Height res) <- f (castTo (wrapInRef pp)) + return (fromIntegral res) + ) + toCallbackPrim :: (Ref a -> IO ()) -> IO (FunPtr (Ptr () -> IO ())) toCallbackPrim f = mkCallbackPtr $ \ptr -> do @@ -115,13 +153,19 @@ then Just (ShortcutKeySequence evs (NormalKeyType $ toEnum $ fromIntegral masked)) else Just (ShortcutKeySequence evs (SpecialKeyType $ head special)) +#ifdef CALLSTACK_AVAILABLE +wrapNonNull :: (?loc :: CallStack) => Ptr a -> String -> IO (ForeignPtr (Ptr a)) +#elif defined(HASCALLSTACK_AVAILABLE) +wrapNonNull :: (HasCallStack) => Ptr a -> String -> IO (ForeignPtr (Ptr a)) +#else wrapNonNull :: Ptr a -> String -> IO (ForeignPtr (Ptr a)) +#endif wrapNonNull ptr msg = if (ptr == nullPtr) then error msg else do pptr <- malloc poke pptr ptr - FC.newForeignPtr pptr (return ()) + FC.newForeignPtr pptr (free pptr) toGlobalEventHandlerPrim :: GlobalEventHandlerF -> IO (FunPtr GlobalEventHandlerPrim) @@ -168,11 +212,12 @@ mkTextModifyCb ( \pos' nInserted' nDeleted' nRestyled' stringPtr _ -> - cStringToText stringPtr >>= - f (fromIntegral pos') - (fromIntegral nInserted') - (fromIntegral nDeleted') - (fromIntegral nRestyled') + cStringToText stringPtr >>= \deletedText -> + f (AtIndex (fromIntegral pos')) + (NumInserted (fromIntegral nInserted')) + (NumDeleted (fromIntegral nDeleted')) + (NumRestyled (fromIntegral nRestyled')) + (DeletedText deletedText) ) toTextPredeleteCbPrim :: TextPredeleteCb -> IO (FunPtr TextPredeleteCbPrim) @@ -180,17 +225,17 @@ mkTextPredeleteCb ( \pos' nDeleted' _ -> - f (BufferOffset (fromIntegral pos')) (fromIntegral nDeleted') + f (AtIndex (fromIntegral pos')) (NumDeleted (fromIntegral nDeleted')) ) toFDHandlerPrim :: FDHandler -> IO (FunPtr FDHandlerPrim) -toFDHandlerPrim f = mkFDHandlerPrim (\fd _ -> f fd) +toFDHandlerPrim f = mkFDHandlerPrim (\fd _ -> f (FlSocket fd)) toUnfinishedStyleCbPrim :: UnfinishedStyleCb -> IO (FunPtr UnfinishedStyleCbPrim) toUnfinishedStyleCbPrim f = mkUnfinishedStyleCbPrim ( - \pos' _ -> f (BufferOffset (fromIntegral pos')) + \pos' _ -> f (AtIndex (fromIntegral pos')) ) orNullFunPtr :: (a -> IO (FunPtr b)) -> Maybe a -> IO (FunPtr b) @@ -325,9 +370,6 @@ intToModes :: Int -> Modes intToModes modeCode = Modes (extract allModes (fromIntegral modeCode)) -withByteStrings :: [B.ByteString] -> (Ptr (Ptr CChar) -> IO a) -> IO a -withByteStrings bs f = B.useAsCString (foldl1 B.append bs) (\ptr -> new ptr >>= f) - withPixmap :: PixmapHs -> ((Ptr (Ptr CChar)) -> IO a) -> IO a withPixmap (PixmapHs strings) f = do cStrings <- sequence (map copyTextToCString strings) @@ -362,9 +404,10 @@ copyByteStringToCString :: B.ByteString -> IO CString copyByteStringToCString bs = B.useAsCStringLen bs - (\(cstring, len) -> do - dest <- mallocArray (len + 1) - copyArray dest cstring (len + 1) + (\(cstring,len) -> do + dest <- mallocArray (len+1) + copyArray dest cstring len + pokeElemOff dest len (0 :: CChar) return dest ) @@ -376,3 +419,24 @@ withText :: T.Text -> (CString -> IO a) -> IO a withText t f = B.useAsCString (E.encodeUtf8 t) f + +#ifdef CALLSTACK_AVAILABLE +drawShortcutFromC :: (?loc :: CallStack) => CChar -> Maybe DrawShortcut +#elif defined(HASCALLSTACK_AVAILABLE) +drawShortcutFromC :: (HasCallStack) => CChar -> Maybe DrawShortcut +#else +drawShortcutFromC :: CChar -> Maybe DrawShortcut +#endif +drawShortcutFromC c = + case c of + 0 -> Nothing + 1 -> Just NormalDrawShortcut + 2 -> Just ElideAmpersandDrawShortcut + _ -> error "fl_draw_shortcut should be 0,1 or 2." + +drawShortcutToC :: Maybe DrawShortcut -> CChar +drawShortcutToC ds = + case ds of + Nothing -> 0 + Just NormalDrawShortcut -> 1 + Just ElideAmpersandDrawShortcut -> 2 diff --git a/src/Graphics/UI/FLTK/LowLevel/Valuator.chs b/src/Graphics/UI/FLTK/LowLevel/Valuator.chs --- a/src/Graphics/UI/FLTK/LowLevel/Valuator.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Valuator.chs @@ -52,12 +52,13 @@ valuatorNew :: Rectangle -> Maybe T.Text -> IO (Ref Valuator) valuatorNew rectangle l' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> valuatorNew' x_pos y_pos width height >>= - toRef - Just l -> valuatorNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenValuatorNew' + overriddenValuatorNewWithLabel' {# fun Fl_Valuator_Destroy as valuatorDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Valuator orig impl where @@ -106,7 +107,7 @@ runOp _ _ valuator a b = withRef valuator $ \valuatorPtr -> range' valuatorPtr a b {# fun Fl_Valuator_set_step_with_a_b as setStepWithAB' { id `Ptr ()', `Double', `Int' } -> `()' supressWarningAboutRes #} instance (impl ~ (Rational -> IO ())) => Op (SetStep ()) Valuator orig impl where - runOp _ _ valuator r = withRef valuator $ \valuatorPtr -> setStepWithAB' valuatorPtr (fromIntegral (denominator r)) (fromIntegral (numerator r)) + runOp _ _ valuator r = withRef valuator $ \valuatorPtr -> setStepWithAB' valuatorPtr (fromIntegral (numerator r)) (fromIntegral (denominator r)) {# fun Fl_Valuator_step as step' { id `Ptr ()' } -> `Double' #} instance (impl ~ ( IO (Rational))) => Op (GetStep ()) Valuator orig impl where runOp _ _ valuator = withRef valuator $ \valuatorPtr -> step' valuatorPtr >>= \r -> return $ approxRational r 0 @@ -117,11 +118,25 @@ instance (impl ~ ( IO (Double))) => Op (GetValue ()) Valuator orig impl where runOp _ _ valuator = withRef valuator $ \valuatorPtr -> value' valuatorPtr {# fun Fl_Valuator_set_value as setValue' { id `Ptr ()',`Double' } -> `Int' #} -instance (impl ~ (Double -> IO (Int))) => Op (SetValue ()) Valuator orig impl where - runOp _ _ valuator v = withRef valuator $ \valuatorPtr -> setValue' valuatorPtr v -{# fun Fl_Valuator_format as format' { id `Ptr ()', unsafeToCString `T.Text' } -> `Int' #} -instance (impl ~ (T.Text -> IO (Int))) => Op (SetFormat ()) Valuator orig impl where - runOp _ _ valuator f = withRef valuator $ \valuatorPtr -> format' valuatorPtr f +instance (impl ~ (Double -> IO (Either NoChange ()))) => Op (SetValue ()) Valuator orig impl where + runOp _ _ valuator v = withRef valuator $ \valuatorPtr -> do + ret <- setValue' valuatorPtr v + return (if (ret == 0) then Left NoChange else Right ()) +{# fun Fl_Valuator_format as format' { id `Ptr ()', id `Ptr CChar' } -> `Int' #} +instance (impl ~ (IO (Either UnknownError T.Text))) => Op (Format ()) Valuator orig impl where + runOp _ _ valuator = + let bufSize = 128 + in + withRef valuator + (\valuatorPtr -> + allocaBytes 128 + (\bufPtr -> do + res <- format' valuatorPtr bufPtr + if (res < 0 || res > bufSize) + then return (Left UnknownError) + else fmap Right (cStringToText (castPtr bufPtr)) + ) + ) {# fun Fl_Valuator_round as round' { id `Ptr ()',`Double' } -> `Double' #} instance (impl ~ (Double -> IO (Double))) => Op (Round ()) Valuator orig impl where runOp _ _ valuator v = withRef valuator $ \valuatorPtr -> round' valuatorPtr v @@ -146,6 +161,8 @@ -- -- destroy :: 'Ref' 'Valuator' -> 'IO' () -- +-- format :: 'Ref' 'Valuator' -> 'IO' ('Either' 'UnknownError' 'T.Text') +-- -- getMaximum :: 'Ref' 'Valuator' -> 'IO' ('Double') -- -- getMinimum :: 'Ref' 'Valuator' -> 'IO' ('Double') @@ -156,9 +173,9 @@ -- -- getValue :: 'Ref' 'Valuator' -> 'IO' ('Double') -- --- handle :: 'Ref' 'Valuator' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handle :: 'Ref' 'Valuator' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- --- handleSuper :: 'Ref' 'Valuator' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handleSuper :: 'Ref' 'Valuator' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'Valuator' -> ( 'IO' ()) -- @@ -176,8 +193,6 @@ -- -- round :: 'Ref' 'Valuator' -> 'Double' -> 'IO' ('Double') -- --- setFormat :: 'Ref' 'Valuator' -> 'T.Text' -> 'IO' ('Int') --- -- setMaximum :: 'Ref' 'Valuator' -> 'Double' -> 'IO' () -- -- setMinimum :: 'Ref' 'Valuator' -> 'Double' -> 'IO' () @@ -186,7 +201,7 @@ -- -- setType :: 'Ref' 'Valuator' -> 'ValuatorType' -> 'IO' () -- --- setValue :: 'Ref' 'Valuator' -> 'Double' -> 'IO' ('Int') +-- setValue :: 'Ref' 'Valuator' -> 'Double' -> 'IO' ('Either' 'NoChange' ()) -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/ValueInput.chs b/src/Graphics/UI/FLTK/LowLevel/ValueInput.chs --- a/src/Graphics/UI/FLTK/LowLevel/ValueInput.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ValueInput.chs @@ -46,12 +46,13 @@ {# fun Fl_Value_Input_New_WithLabel as valueInputNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} valueInputNew :: Rectangle -> Maybe T.Text -> IO (Ref ValueInput) valueInputNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> valueInputNew' x_pos y_pos width height >>= - toRef - Just l -> valueInputNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Value_Input_Destroy as valueInputDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) ValueInput orig impl where @@ -168,10 +169,6 @@ -- showWidget :: 'Ref' 'ValueInput' -> 'IO' () -- -- showWidgetSuper :: 'Ref' 'ValueInput' -> 'IO' () - --- Available in FLTK 1.3.4 only: - - -- @ -- $hierarchy diff --git a/src/Graphics/UI/FLTK/LowLevel/ValueOutput.chs b/src/Graphics/UI/FLTK/LowLevel/ValueOutput.chs --- a/src/Graphics/UI/FLTK/LowLevel/ValueOutput.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ValueOutput.chs @@ -47,12 +47,13 @@ {# fun Fl_Value_Output_New_WithLabel as valueOutputNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `T.Text'} -> `Ptr ()' id #} valueOutputNew :: Rectangle -> Maybe T.Text -> IO (Ref ValueOutput) valueOutputNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> valueOutputNew' x_pos y_pos width height >>= - toRef - Just l -> valueOutputNewWithLabel' x_pos y_pos width height l >>= - toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Value_Output_Destroy as valueOutputDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ IO ()) => Op (Destroy ()) ValueOutput orig impl where diff --git a/src/Graphics/UI/FLTK/LowLevel/ValueSlider.chs b/src/Graphics/UI/FLTK/LowLevel/ValueSlider.chs --- a/src/Graphics/UI/FLTK/LowLevel/ValueSlider.chs +++ b/src/Graphics/UI/FLTK/LowLevel/ValueSlider.chs @@ -48,10 +48,13 @@ {# fun Fl_Value_Slider_New_WithLabel as valueSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} valueSliderNew :: Rectangle -> Maybe T.Text -> IO (Ref ValueSlider) valueSliderNew rectangle l'= - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case l' of - Nothing -> valueSliderNew' x_pos y_pos width height >>= toRef - Just l -> valueSliderNewWithLabel' x_pos y_pos width height l >>= toRef + widgetMaker + rectangle + l' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' -- {# fun Fl_Hor_Value_Slider_New as horValueSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -- {# fun Fl_Hor_Value_Slider_New_WithLabel as horValueSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} diff --git a/src/Graphics/UI/FLTK/LowLevel/Widget.chs b/src/Graphics/UI/FLTK/LowLevel/Widget.chs --- a/src/Graphics/UI/FLTK/LowLevel/Widget.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Widget.chs @@ -10,6 +10,7 @@ defaultCustomWidgetFuncs, fillCustomWidgetFunctionStruct, customWidgetFunctionStruct, + WidgetFlag(..) -- * Hierarchy -- -- $hierarchy @@ -29,8 +30,67 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Dispatch import qualified Data.Text as T +import qualified Data.Text.Foreign as TF import Graphics.UI.FLTK.LowLevel.Hierarchy +#c +enum WidgetFlag { + WidgetFlagInactive = INACTIVE, + WidgetFlagInvisible = INVISIBLE, + WidgetFlagOutput = OUTPUT, + WidgetFlagNoBorder = NOBORDER, + WidgetFlagForcePosition = FORCE_POSITION, + WidgetFlagNonModal = NON_MODAL, + WidgetFlagShortcutLabel = SHORTCUT_LABEL, + WidgetFlagChanged = CHANGED, + WidgetFlagOverride = OVERRIDE, + WidgetFlagVisibleFocus = VISIBLE_FOCUS, + WidgetFlagCopiedLabel = COPIED_LABEL, + WidgetFlagClipChildren = CLIP_CHILDREN, + WidgetFlagMenuWindow = MENU_WINDOW, + WidgetFlagTooltipWindow = TOOLTIP_WINDOW, + WidgetFlagModal = MODAL, + WidgetFlagNoOverlay = NO_OVERLAY, + WidgetFlagGroupRelative = GROUP_RELATIVE, + WidgetFlagCopiedTooltip = COPIED_TOOLTIP, + WidgetFlagFullscreen = FULLSCREEN, + WidgetFlagMacUseAccentsMenu = MAC_USE_ACCENTS_MENU, + WidgetFlagNeedsKeyboard = NEEDS_KEYBOARD, + WidgetFlagUserFlag3 = USERFLAG3, + WidgetFlagUserFlag2 = USERFLAG2, + WidgetFlagUserFlag1 = USERFLAG1 +}; +#endc +{#enum WidgetFlag {} deriving (Show, Eq) #} +allWidgetFlags :: [WidgetFlag] +allWidgetFlags = + [ + WidgetFlagInactive, + WidgetFlagInvisible, + WidgetFlagOutput, + WidgetFlagNoBorder, + WidgetFlagForcePosition, + WidgetFlagNonModal, + WidgetFlagShortcutLabel, + WidgetFlagChanged, + WidgetFlagOverride, + WidgetFlagVisibleFocus, + WidgetFlagCopiedLabel, + WidgetFlagClipChildren, + WidgetFlagMenuWindow, + WidgetFlagTooltipWindow, + WidgetFlagModal, + WidgetFlagNoOverlay, + WidgetFlagGroupRelative, + WidgetFlagCopiedTooltip, + WidgetFlagFullscreen, + WidgetFlagMacUseAccentsMenu, + WidgetFlagNeedsKeyboard, + WidgetFlagUserFlag3, + WidgetFlagUserFlag2, + WidgetFlagUserFlag1 + ] + type RectangleFPrim = Ptr () -> CInt -> CInt -> CInt -> CInt -> IO () foreign import ccall "wrapper" @@ -132,7 +192,10 @@ widget <- maybe (newWithCustomFuncs' x_pos y_pos width height (castPtr ptr)) (\l -> newWithCustomFuncsLabel' x_pos y_pos width height l (castPtr ptr)) _label' - toRef widget + ref <- toRef widget + setFlag (safeCast ref :: Ref Widget) WidgetFlagCopiedLabel + setFlag (safeCast ref :: Ref Widget) WidgetFlagCopiedTooltip + return ref {# fun Fl_OverriddenWidget_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenWidget_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} @@ -142,14 +205,17 @@ -> (Ref Widget -> IO ()) -- ^ Custom drawing function -> CustomWidgetFuncs Widget -- ^ Other custom functions -> IO (Ref Widget) -widgetCustom rectangle l' draw' funcs' = - widgetMaker - rectangle - l' - (Just draw') - (Just funcs') - overriddenWidgetNew' - overriddenWidgetNewWithLabel' +widgetCustom rectangle l' draw' funcs' = do + ref <- widgetMaker + rectangle + l' + (Just draw') + (Just funcs') + overriddenWidgetNew' + overriddenWidgetNewWithLabel' + setFlag ref WidgetFlagCopiedLabel + setFlag ref WidgetFlagCopiedTooltip + return ref {# fun Fl_Widget_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ IO ()) => Op (Destroy ()) Widget orig impl where @@ -189,26 +255,26 @@ drawLabelWithXywhAlignment' widgetPtr x_pos y_pos w_pos h_pos (alignmentsToInt align_) {# fun Fl_Widget_x as x' { id `Ptr ()' } -> `Int' #} -instance (impl ~ IO (Int)) => Op (GetX ()) Widget orig impl where - runOp _ _ widget = withRef widget $ \widgetPtr -> x' widgetPtr +instance (impl ~ IO (X)) => Op (GetX ()) Widget orig impl where + runOp _ _ widget = withRef widget $ \widgetPtr -> x' widgetPtr >>= return . X {# fun Fl_Widget_y as y' { id `Ptr ()' } -> `Int' #} -instance (impl ~ IO (Int)) => Op (GetY ()) Widget orig impl where - runOp _ _ widget = withRef widget $ \widgetPtr -> y' widgetPtr +instance (impl ~ IO (Y)) => Op (GetY ()) Widget orig impl where + runOp _ _ widget = withRef widget $ \widgetPtr -> y' widgetPtr >>= return . Y {# fun Fl_Widget_w as w' { id `Ptr ()' } -> `Int' #} -instance (impl ~ IO (Int)) => Op (GetW ()) Widget orig impl where - runOp _ _ widget = withRef widget $ \widgetPtr -> w' widgetPtr +instance (impl ~ IO (Width)) => Op (GetW ()) Widget orig impl where + runOp _ _ widget = withRef widget $ \widgetPtr -> w' widgetPtr >>= return . Width {# fun Fl_Widget_h as h' { id `Ptr ()' } -> `Int' #} -instance (impl ~ IO (Int)) => Op (GetH ()) Widget orig impl where - runOp _ _ widget = withRef widget $ \widgetPtr -> h' widgetPtr +instance (impl ~ IO (Height)) => Op (GetH ()) Widget orig impl where + runOp _ _ widget = withRef widget $ \widgetPtr -> h' widgetPtr >>= return . Height instance ( Match obj ~ FindOp orig orig (GetX ()), Match obj ~ FindOp orig orig (GetY ()), Match obj ~ FindOp orig orig (GetW ()), Match obj ~ FindOp orig orig (GetH ()), - Op (GetX ()) obj orig (IO Int), - Op (GetY ()) obj orig (IO Int), - Op (GetW ()) obj orig (IO Int), - Op (GetH ()) obj orig (IO Int), + Op (GetX ()) obj orig (IO X), + Op (GetY ()) obj orig (IO Y), + Op (GetW ()) obj orig (IO Width), + Op (GetH ()) obj orig (IO Height), impl ~ IO Rectangle ) => @@ -218,7 +284,7 @@ _y <- getY (castTo widget :: Ref orig) _w <- getW (castTo widget :: Ref orig) _h <- getH (castTo widget :: Ref orig) - return (toRectangle (_x,_y,_w,_h)) + return (Rectangle (Position _x _y) (Size _w _h)) {# fun Fl_Widget_set_align as setAlign' { id `Ptr ()', `Int' } -> `()' supressWarningAboutRes #} instance (impl ~ (Alignments -> IO ())) => Op (SetAlign ()) Widget orig impl where runOp _ _ widget _align = withRef widget $ \widgetPtr -> setAlign' widgetPtr (alignmentsToInt _align) @@ -249,18 +315,27 @@ {# fun Fl_Widget_label as label' { id `Ptr ()' } -> `T.Text' unsafeFromCString #} instance (impl ~ IO T.Text) => Op (GetLabel ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> label' widgetPtr -{# fun Fl_Widget_copy_label as copyLabel' { id `Ptr ()', unsafeToCString `T.Text' } -> `()' supressWarningAboutRes #} -instance (impl ~ (T.Text -> IO ())) => Op (CopyLabel ()) Widget orig impl where - runOp _ _ widget new_label = withRef widget $ \widgetPtr -> copyLabel' widgetPtr new_label -{# fun Fl_Widget_set_label as setLabel' { id `Ptr ()', unsafeToCString `T.Text' } -> `()' supressWarningAboutRes #} +{# fun Fl_Widget_copy_label as copyLabel' { id `Ptr ()', `CString' } -> `()' supressWarningAboutRes #} instance (impl ~ ( T.Text -> IO ())) => Op (SetLabel ()) Widget orig impl where - runOp _ _ widget text = withRef widget $ \widgetPtr -> setLabel' widgetPtr text + runOp _ _ widget text = + withRef widget $ \widgetPtr -> withCString (T.unpack text) (\sPtr -> copyLabel' widgetPtr sPtr) {# fun Fl_Widget_labeltype as labeltype' { id `Ptr ()' } -> `Labeltype' cToEnum #} instance (impl ~ (IO (Labeltype))) => Op (GetLabeltype ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> labeltype' widgetPtr {# fun Fl_Widget_set_labeltype as setLabeltype' { id `Ptr ()',cFromEnum `Labeltype' } -> `()' supressWarningAboutRes #} -instance (impl ~ ( Labeltype -> IO ())) => Op (SetLabeltype ()) Widget orig impl where - runOp _ _ widget a = withRef widget $ \widgetPtr -> setLabeltype' widgetPtr a +instance (impl ~ ( Labeltype -> ResolveImageLabelConflict -> IO ())) => Op (SetLabeltype ()) Widget orig impl where + runOp _ _ widget a resolve = withRef widget $ \widgetPtr -> do + lt <- getLabeltype widget + case (lt, resolve) of + (ImageLabelType, ResolveImageLabelDoNothing) -> return () + (ImageLabelType, ResolveImageLabelOverwrite) -> do + setLabeltype' widgetPtr a + copyLabel' widgetPtr nullPtr + (MultiLabelType, ResolveImageLabelDoNothing) -> return () + (MultiLabelType, ResolveImageLabelOverwrite) -> do + setLabeltype' widgetPtr a + copyLabel' widgetPtr nullPtr + (_,_) -> setLabeltype' widgetPtr a {# fun Fl_Widget_labelcolor as labelcolor' { id `Ptr ()' } -> `Color' cToColor #} instance (impl ~ (IO (Color))) => Op (GetLabelcolor ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> labelcolor' widgetPtr @@ -297,9 +372,9 @@ {# fun Fl_Widget_copy_tooltip as copyTooltip' { id `Ptr ()', unsafeToCString `T.Text' } -> `()' supressWarningAboutRes #} instance (impl ~ ( T.Text -> IO ())) => Op (CopyTooltip ()) Widget orig impl where runOp _ _ widget text = withRef widget $ \widgetPtr -> copyTooltip' widgetPtr text -{# fun Fl_Widget_set_tooltip as setTooltip' { id `Ptr ()', unsafeToCString `T.Text' } -> `()' supressWarningAboutRes #} +{# fun Fl_Widget_set_tooltip as setTooltip' { id `Ptr ()', `CString' } -> `()' supressWarningAboutRes #} instance (impl ~ ( T.Text -> IO ())) => Op (SetTooltip ()) Widget orig impl where - runOp _ _ widget text = withRef widget $ \widgetPtr -> setTooltip' widgetPtr text + runOp _ _ widget text = withRef widget $ \widgetPtr -> withCString (T.unpack text) (\sPtr -> copyTooltip' widgetPtr text) {# fun Fl_Widget_when as when' { id `Ptr ()' } -> `CInt' id #} instance (impl ~ IO [When]) => Op (GetWhen ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> @@ -383,8 +458,8 @@ {# fun Fl_Widget_clear_visible_focus as clearVisibleFocus' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (ClearVisibleFocus ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> clearVisibleFocus' widgetPtr -{# fun Fl_Widget_modify_visible_focus as modifyVisibleFocus' { id `Ptr ()',`Int' } -> `()' supressWarningAboutRes #} -instance (impl ~ ( Int -> IO ())) => Op (ModifyVisibleFocus ()) Widget orig impl where +{# fun Fl_Widget_modify_visible_focus as modifyVisibleFocus' { id `Ptr ()',cFromBool `Bool' } -> `()' supressWarningAboutRes #} +instance (impl ~ ( Bool -> IO ())) => Op (ModifyVisibleFocus ()) Widget orig impl where runOp _ _ widget v = withRef widget $ \widgetPtr -> modifyVisibleFocus' widgetPtr v {# fun Fl_Widget_visible_focus as visibleFocus' { id `Ptr ()' } -> `Bool' cToBool #} instance (impl ~ (IO (Bool))) => Op (GetVisibleFocus ()) Widget orig impl where @@ -409,7 +484,7 @@ d <- damage' widgetPtr return (extract allDamages (fromIntegral d)) {# fun Fl_Widget_clear_damage_with_bitmask as clearDamageWithBitmask' { id `Ptr ()',`Word8' } -> `()' supressWarningAboutRes #} -instance (impl ~ ( [Damage] -> IO ())) => Op (ClearDamageExcept ()) Widget orig impl where +instance (impl ~ ( [Damage] -> IO ())) => Op (ClearDamageThenSet ()) Widget orig impl where runOp _ _ widget damages = withRef widget $ \widgetPtr -> clearDamageWithBitmask' widgetPtr (fromIntegral (combine damages)) {# fun Fl_Widget_clear_damage as clearDamage' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (ClearDamage ()) Widget orig impl where @@ -422,9 +497,19 @@ runOp _ _ widget damages rectangle = withRef widget $ \widgetPtr -> do let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle damageInsideWidget' widgetPtr (fromIntegral (combine damages)) x_pos y_pos w_pos h_pos -{# fun Fl_Widget_measure_label as measureLabel' {id `Ptr ()',alloca- `Int' peekIntConv*, alloca- `Int' peekIntConv*} -> `()' #} -instance (impl ~ ( IO (Size))) => Op (MeasureLabel ()) Widget orig impl where - runOp _ _ widget = withRef widget $ \widgetPtr -> measureLabel' widgetPtr >>= \(width, height) -> return $ Size (Width width) (Height height) +{# fun Fl_Widget_measure_label as measureLabel' {id `Ptr ()',id `Ptr CInt', id `Ptr CInt'} -> `()' #} +instance (impl ~ ( Maybe Width -> IO (Size))) => Op (MeasureLabel ()) Widget orig impl where + runOp _ _ widget wrap = + withRef widget + $ \widgetPtr -> + alloca $ \widthPtr -> + alloca $ \heightPtr -> do + poke widthPtr (maybe 0 (\(Width w) -> fromIntegral w) wrap) + poke heightPtr 0 + measureLabel' widgetPtr widthPtr heightPtr + w <- peekIntConv widthPtr + h <- peekIntConv heightPtr + return (Size (Width w) (Height h)) {# fun Fl_Widget_window as window' { id `Ptr ()' } -> `Ptr ()' id #} instance (impl ~ (IO (Maybe (Ref Window)))) => Op (GetWindow ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> window' widgetPtr >>= toMaybeRef @@ -481,6 +566,20 @@ let (x_pos,y_pos,w_pos,h_pos) = fromRectangle r widgetDrawFocusWithTXywh' widgetPtr bx x_pos y_pos w_pos h_pos +{# fun Fl_Widget_set_flag as setFlag' { id `Ptr ()', cFromEnum `WidgetFlag' } -> `()' #} +{# fun Fl_Widget_clear_flag as clearFlag' { id `Ptr ()', cFromEnum `WidgetFlag' } -> `()' #} +{# fun Fl_Widget_flags as flags' { id `Ptr ()' } -> `CUInt' #} + +instance (impl ~ (WidgetFlag -> IO ())) => Op (SetFlag ()) Widget orig impl where + runOp _ _ widget flag = withRef widget (\widgetPtr -> setFlag' widgetPtr flag) + +instance (impl ~ (WidgetFlag -> IO ())) => Op (ClearFlag ()) Widget orig impl where + runOp _ _ widget flag = withRef widget (\widgetPtr -> clearFlag' widgetPtr flag) + +instance (impl ~ (IO [WidgetFlag])) => Op (Flags ()) Widget orig impl where + runOp _ _ widget = withRef widget (\widgetPtr -> do + flagsUInt <- flags' widgetPtr + return (extract allWidgetFlags (fromIntegral flagsUInt))) -- $widgetfunctions -- @ -- activate :: 'Ref' 'Widget' -> 'IO' () @@ -497,8 +596,10 @@ -- -- clearDamage :: 'Ref' 'Widget' -> 'IO' () -- --- clearDamageExcept :: 'Ref' 'Widget' -> ['Damage'] -> 'IO' () +-- clearDamageThenSet :: 'Ref' 'Widget' -> ['Damage'] -> 'IO' () -- +-- clearFlag :: 'Ref' 'Widget' -> 'WidgetFlag' -> 'IO' () +-- -- clearOutput :: 'Ref' 'Widget' -> 'IO' () -- -- clearVisible :: 'Ref' 'Widget' -> 'IO' () @@ -507,8 +608,6 @@ -- -- contains:: ('Parent' a 'Widget') => 'Ref' 'Widget' -> 'Ref' a -> 'IO' 'Bool' -- --- copyLabel :: 'Ref' 'Widget' -> 'T.Text' -> 'IO' () --- -- copyTooltip :: 'Ref' 'Widget' -> 'T.Text' -> 'IO' () -- -- deactivate :: 'Ref' 'Widget' -> 'IO' () @@ -527,6 +626,8 @@ -- -- drawLabel :: 'Ref' 'Widget' -> 'Maybe' ('Rectangle,Alignments') -> 'IO' () -- +-- flags :: 'Ref' 'Widget' -> 'IO' ['WidgetFlag'] +-- -- getAlign :: 'Ref' 'Widget' -> 'IO' 'Alignments' -- -- getBox :: 'Ref' 'Widget' -> 'IO' ('Boxtype') @@ -537,7 +638,7 @@ -- -- getDeimage :: 'Ref' 'Widget' -> 'IO' ('Maybe' ('Ref' 'Image')) -- --- getH :: 'Ref' 'Widget' -> 'IO' ('Int') +-- getH :: 'Ref' 'Widget' -> 'IO' ('Height') -- -- getImage :: 'Ref' 'Widget' -> 'IO' ('Maybe' ('Ref' 'Image')) -- @@ -555,7 +656,7 @@ -- -- getParent :: 'Ref' 'Widget' -> 'IO' ('Maybe' ('Ref' 'Group')) -- --- getRectangle:: ('Match' obj ~ 'FindOp' orig orig ('GetX' ()), 'Match' obj ~ 'FindOp' orig orig ('GetY' ()), 'Match' obj ~ 'FindOp' orig orig ('GetW' ()), 'Match' obj ~ 'FindOp' orig orig ('GetH' ()), 'Op' ('GetX' ()) obj orig ('IO' 'Int',) 'Op' ('GetY' ()) obj orig ('IO' 'Int',) 'Op' ('GetW' ()) obj orig ('IO' 'Int',) 'Op' ('GetH' ()) obj orig ('IO' 'Int',)) => 'Ref' 'Widget' -> 'IO' 'Rectangle' +-- getRectangle:: ('Match' obj ~ 'FindOp' orig orig ('GetX' ()), 'Match' obj ~ 'FindOp' orig orig ('GetY' ()), 'Match' obj ~ 'FindOp' orig orig ('GetW' ()), 'Match' obj ~ 'FindOp' orig orig ('GetH' ()), 'Op' ('GetX' ()) obj orig ('IO' 'X',) 'Op' ('GetY' ()) obj orig ('IO' 'Y',) 'Op' ('GetW' ()) obj orig ('IO' 'Width',) 'Op' ('GetH' ()) obj orig ('IO' 'Height',)) => 'Ref' 'Widget' -> 'IO' 'Rectangle' -- -- getSelectionColor :: 'Ref' 'Widget' -> 'IO' ('Color') -- @@ -573,15 +674,15 @@ -- -- getVisibleR :: 'Ref' 'Widget' -> 'IO' 'Bool' -- --- getW :: 'Ref' 'Widget' -> 'IO' ('Int') +-- getW :: 'Ref' 'Widget' -> 'IO' ('Width') -- -- getWhen :: 'Ref' 'Widget' -> 'IO' ['When'] -- -- getWindow :: 'Ref' 'Widget' -> 'IO' ('Maybe' ('Ref' 'Window')) -- --- getX :: 'Ref' 'Widget' -> 'IO' ('Int') +-- getX :: 'Ref' 'Widget' -> 'IO' ('X') -- --- getY :: 'Ref' 'Widget' -> 'IO' ('Int') +-- getY :: 'Ref' 'Widget' -> 'IO' ('Y') -- -- handle :: 'Ref' 'Widget' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- @@ -593,9 +694,9 @@ -- -- inside:: ('Parent' a 'Widget') => 'Ref' 'Widget' -> 'Ref' a -> 'IO' ('Bool') -- --- measureLabel :: 'Ref' 'Widget' -> 'IO' ('Size') +-- measureLabel :: 'Ref' 'Widget' -> 'Maybe' 'Width' -> 'IO' ('Size') -- --- modifyVisibleFocus :: 'Ref' 'Widget' -> 'Int' -> 'IO' () +-- modifyVisibleFocus :: 'Ref' 'Widget' -> 'Bool' -> 'IO' () -- -- redraw :: 'Ref' 'Widget' -> 'IO' () -- @@ -625,6 +726,8 @@ -- -- setDeimage:: ('Parent' a 'Image') => 'Ref' 'Widget' -> 'Maybe'( 'Ref' a ) -> 'IO' () -- +-- setFlag :: 'Ref' 'Widget' -> 'WidgetFlag' -> 'IO' () +-- -- setImage:: ('Parent' a 'Image') => 'Ref' 'Widget' -> 'Maybe'( 'Ref' a ) -> 'IO' () -- -- setLabel :: 'Ref' 'Widget' -> 'T.Text' -> 'IO' () @@ -635,7 +738,7 @@ -- -- setLabelsize :: 'Ref' 'Widget' -> 'FontSize' -> 'IO' () -- --- setLabeltype :: 'Ref' 'Widget' -> 'Labeltype' -> 'IO' () +-- setLabeltype :: 'Ref' 'Widget' -> 'Labeltype' -> 'ResolveImageLabelConflict' -> 'IO' () -- -- setOutput :: 'Ref' 'Widget' -> 'IO' () -- diff --git a/src/Graphics/UI/FLTK/LowLevel/Window.chs b/src/Graphics/UI/FLTK/LowLevel/Window.chs --- a/src/Graphics/UI/FLTK/LowLevel/Window.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Window.chs @@ -110,11 +110,14 @@ p <- virtualFuncs' fillCustomWidgetFunctionStruct p draw' customWidgetFuncs' fillCustomWindowFunctionStruct p customWindowFuncs' - case (position, title) of - (Nothing, Nothing) -> custom' w h p >>= toRef - (Just (Position (X x) (Y y)), Nothing) -> customXY' x y w h p >>= toRef - (Just (Position (X x) (Y y)), (Just l')) -> customXYWithLabel' x y w h l' p >>= toRef - (Nothing, (Just l')) -> customWithLabel' w h l' p >>= toRef + ref <- case (position, title) of + (Nothing, Nothing) -> custom' w h p >>= toRef + (Just (Position (X x) (Y y)), Nothing) -> customXY' x y w h p >>= toRef + (Just (Position (X x) (Y y)), (Just l')) -> customXYWithLabel' x y w h l' p >>= toRef + (Nothing, (Just l')) -> customWithLabel' w h l' p >>= toRef + setFlag (safeCast ref :: Ref Window) WidgetFlagCopiedLabel + setFlag (safeCast ref :: Ref Window) WidgetFlagCopiedTooltip + return ref {# fun Fl_OverriddenWindow_New as overriddenWindowNew' {`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenWindow_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #} @@ -302,11 +305,11 @@ {# fun Fl_Window_size_range as sizeRange' { id `Ptr ()',`Int',`Int' } -> `()' supressWarningAboutRes #} {# fun Fl_Window_size_range_with_args as sizeRangeWithArgs' { id `Ptr ()',`Int',`Int', id `Ptr ()' } -> `()' supressWarningAboutRes #} -instance (impl ~ (Int -> Int -> IO ())) => Op (SizeRange ()) Window orig impl where - runOp _ _ win minw' minh' = +instance (impl ~ (Size -> IO ())) => Op (SizeRange ()) Window orig impl where + runOp _ _ win (Size (Width minw') (Height minh')) = withRef win $ \winPtr -> sizeRange' winPtr minw' minh' -instance (impl ~ (Int -> Int -> OptionalSizeRangeArgs -> IO ())) => Op (SizeRangeWithArgs ()) Window orig impl where - runOp _ _ win minw' minh' args = +instance (impl ~ (Size -> OptionalSizeRangeArgs -> IO ())) => Op (SizeRangeWithArgs ()) Window orig impl where + runOp _ _ win (Size (Width minw') (Height minh')) args = withRef win $ \winPtr -> do structPtr <- optionalSizeRangeArgsToStruct args sizeRangeWithArgs' winPtr minw' minh' structPtr @@ -513,9 +516,9 @@ -- -- getYRoot :: 'Ref' 'Window' -> 'IO' ('Int') -- --- handle :: 'Ref' 'Window' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handle :: 'Ref' 'Window' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- --- handleSuper :: 'Ref' 'Window' -> 'Event' -> 'IO' ('Int') +-- handleSuper :: 'Ref' 'Window' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'Window' -> 'IO' () -- @@ -575,9 +578,9 @@ -- -- shown :: 'Ref' 'Window' -> 'IO' ('Bool') -- --- sizeRange :: 'Ref' 'Window' -> 'Int' -> 'Int' -> 'IO' () +-- sizeRange :: 'Ref' 'Window' -> 'Size' -> 'IO' () -- --- sizeRangeWithArgs :: 'Ref' 'Window' -> 'Int' -> 'Int' -> 'OptionalSizeRangeArgs' -> 'IO' () +-- sizeRangeWithArgs :: 'Ref' 'Window' -> 'Size' -> 'OptionalSizeRangeArgs' -> 'IO' () -- -- waitForExpose :: 'Ref' 'Window' -> 'IO' () -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Wizard.chs b/src/Graphics/UI/FLTK/LowLevel/Wizard.chs --- a/src/Graphics/UI/FLTK/LowLevel/Wizard.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Wizard.chs @@ -46,10 +46,13 @@ {# fun Fl_Wizard_New_WithLabel as wizardNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `T.Text'} -> `Ptr ()' id #} wizardNew :: Rectangle -> Maybe T.Text -> IO (Ref Wizard) wizardNew rectangle label' = - let (x_pos, y_pos, width, height) = fromRectangle rectangle - in case label' of - (Just l') -> wizardNewWithLabel' x_pos y_pos width height l' >>= toRef - Nothing -> wizardNew' x_pos y_pos width height >>= toRef + widgetMaker + rectangle + label' + Nothing + Nothing + overriddenWidgetNew' + overriddenWidgetNewWithLabel' {# fun Fl_Wizard_Destroy as wizardDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} instance (impl ~ (IO ())) => Op (Destroy ()) Wizard orig impl where @@ -109,7 +112,6 @@ -- $functions -- @ --- -- destroy :: 'Ref' 'Wizard' -> 'IO' () -- -- draw :: 'Ref' 'Wizard' -> 'IO' () diff --git a/src/TestPrograms/OpenGL.hs b/src/TestPrograms/OpenGL.hs --- a/src/TestPrograms/OpenGL.hs +++ b/src/TestPrograms/OpenGL.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, PatternSynonyms #-} +{-# LANGUAGE OverloadedStrings #-} {- | Ported from [cube.cxx]. @@ -223,12 +223,12 @@ (Just (drawCubeWindow s2)) defaultCustomWidgetFuncs{handleCustom = Just handleCubeWindow} defaultCustomWindowFuncs - cube1X <- getX cube1 - cube1W <- getW cube1 - cube2X <- getX cube2 - cube2W <- getW cube2 - sizeY <- getY size - sizeH <- getH size + (X cube1X) <- getX cube1 + (Width cube1W) <- getW cube1 + (X cube2X) <- getX cube2 + (Width cube2W) <- getW cube2 + (Y sizeY) <- getY size + (Height sizeH) <- getH size b <- boxNew (toRectangle (cube1X, sizeY, (cube2X + cube2W) - cube1X, sizeH)) Nothing diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,35 +1,7 @@ -# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html - -# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-8.13 - -# Local packages, usually specified by relative directory name +resolver: lts-12.6 packages: - '.' - -# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps: [] - -# Override default flag values for local packages and extra-deps flags: {} - -# Extra package databases containing global packages extra-package-dbs: [] - -# Control whether we use the GHC we find on the path -# system-ghc: true - -# Require a specific version of stack, using version ranges -# require-stack-version: -any # Default -# require-stack-version: >= 1.0.0 - -# Override the architecture used by stack, especially useful on Windows -# arch: i386 -# arch: x86_64 - -# Extra directories used by stack for building -# extra-include-dirs: [/path/to/dir] -# extra-lib-dirs: [/path/to/dir] - -# Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor +allow-newer: true diff --git a/temporary-workaround/freetype-config b/temporary-workaround/freetype-config new file mode 100644 --- /dev/null +++ b/temporary-workaround/freetype-config @@ -0,0 +1,4 @@ +#!/bin/sh +# Workaround for bleeding edge distros that have stopped shipping the 'freetype-config' script with 'freetype2' +# FLTK uses that script to populate C compiler flags so we delegate to 'pkg-config' for now. +pkg-config $@ freetype2