diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,22 +3,24 @@ Fltkhs aims to be a complete Haskell binding to the [FLTK GUI library] [1]. +NOTE: As of version 0.5.0.1 only FLTK 1.3.4-1 is supported. Old code written against FLTK 1.3.3 will still work, 1.3.4 does not remove any functionality. + NOTE: As of version 0.4.0.0, due to the introduction of closed type families, only GHC >= 7.8.1 is supported. Quick Install ------------- ### Linux and *BSD -Install FLTK-1.3.3 from source: +Install FLTK-1.3.4-1 from source: ``` - > wget http://fltk.org/pub/fltk/1.3.3/fltk-1.3.3-source.tar.gz - > tar -zxvf fltk-1.3.3-source.tar.gz - > cd fltk-1.3.3 - > configure --enable-shared --enable-gl + > wget http://fltk.org/pub/fltk/1.3.4/fltk-1.3.4-1-source.tar.gz + > tar -zxvf fltk-1.3.4-1-source.tar.gz + > cd fltk-1.3.4-1 + > ./configure --enable-shared --enable-gl > make > sudo make install > fltk-config --version - 1.3.3 + 1.3.4-1 ``` Build the FLTKHS skeleton project: @@ -33,13 +35,13 @@ ### OSX Yosemite only -Install FLTK-1.3.3 from Brew: +Install FLTK-1.3.4-1 from Brew: ``` > brew install autoconf > brew install fltk > fltk-config --version - 1.3.3 + 1.3.4-1 ``` Build the FLTKHS skeleton project: 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 @@ -594,6 +594,30 @@ Fl_Widget* refPtr = &ref; Fl::release_widget_pointer(refPtr); } + FL_EXPORT_C(void,Fl_set_box_color)(Fl_Color c) { + Fl::set_box_color(c); + } + FL_EXPORT_C(Fl_Color,Fl_box_color)(Fl_Color c){ + return Fl::box_color(c); + } + FL_EXPORT_C(int,Fl_abi_version)(){ + return Fl::abi_version(); + } + FL_EXPORT_C(int,Fl_api_version)(){ + return Fl::api_version(); + } + FL_EXPORT_C(const char*,Fl_local_ctrl)(){ + return fl_local_ctrl; + } + FL_EXPORT_C(const char*,Fl_local_meta)(){ + return fl_local_meta; + } + FL_EXPORT_C(const char*,Fl_local_alt)(){ + return fl_local_alt; + } + FL_EXPORT_C(const char*,Fl_local_shift)(){ + return fl_local_shift; + } #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 @@ -256,6 +256,15 @@ FL_EXPORT_C(void ,Fl_watch_widget_pointer)(fl_Widget w); FL_EXPORT_C(void ,Fl_release_widget_pointer)(fl_Widget w); FL_EXPORT_C(void ,Fl_clear_widget_pointer)(fl_Widget w); + FL_EXPORT_C(void ,Fl_clear_widget_pointer)(fl_Widget w); + FL_EXPORT_C(void ,Fl_set_box_color)(Fl_Color c); + FL_EXPORT_C(Fl_Color ,Fl_box_color)(Fl_Color c); + FL_EXPORT_C(int ,Fl_abi_version)(); + FL_EXPORT_C(int ,Fl_api_version)(); + FL_EXPORT_C(const char* ,Fl_local_ctrl)(); + FL_EXPORT_C(const char* ,Fl_local_meta)(); + FL_EXPORT_C(const char* ,Fl_local_alt)(); + FL_EXPORT_C(const char* ,Fl_local_shift)(); #ifdef __cplusplus } #endif 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 @@ -43,6 +43,10 @@ Fl_Font_Descriptor* _d = static_cast(d); return (static_cast(graphics_driver))->font_descriptor(_d); } +FL_EXPORT_C(int, fl_Graphics_Driver_draw_scaled)(fl_Graphics_Driver graphics_driver, fl_Image i, int X, int Y, int W, int H) +{ + return (static_cast(graphics_driver))->draw_scaled(static_cast(i),X,Y,W,H); +} FL_EXPORT_C(void,Fl_Graphics_Driver_Destroy)(fl_Graphics_Driver graphics_driver){ delete (static_cast(graphics_driver)); } 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 @@ -25,6 +25,7 @@ FL_EXPORT_C(Fl_Color, Fl_Graphics_Driver_color)(fl_Graphics_Driver graphics_driver); FL_EXPORT_C(fl_Font_Descriptor, Fl_Graphics_Driver_font_descriptor)(fl_Graphics_Driver graphics_driver); FL_EXPORT_C(void, Fl_Graphics_Driver_set_font_descriptor)(fl_Graphics_Driver graphics_driver,fl_Font_Descriptor d); + FL_EXPORT_C(int, fl_Graphics_Driver_draw_scaled)(fl_Graphics_Driver graphics_driver, fl_Image i,int X, int Y, int W, int H); FL_EXPORT_C(void, Fl_Graphics_Driver_Destroy)(fl_Graphics_Driver graphics_driver); // Fl_Surface_Device 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 @@ -147,6 +147,10 @@ FL_EXPORT_C(void,Fl_Image_uncache)(fl_Image image){ return (static_cast(image))->uncache(); } + FL_EXPORT_C(int, Fl_Image_fail)(fl_Image image){ + return (static_cast(image))->fail(); + } + #ifdef __cplusplus } #endif 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 @@ -32,6 +32,13 @@ ~Fl_DerivedImage(); }; #endif +#ifndef INTERNAL_LINKAGE + typedef enum Image_Fail_Type { + ERR_NO_IMAGE = -1, + ERR_FILE_ACCESS = -2, + ERR_FORMAT = -3 + } Image_Fail_Type; +#endif FL_EXPORT_C(fl_Image_Virtual_Funcs*, Fl_Image_default_virtual_funcs)(); FL_EXPORT_C(void*, Fl_Image_other_data)(fl_Image image); FL_EXPORT_C(void, Fl_Image_set_other_data)(fl_Image image, void* v); @@ -54,6 +61,7 @@ FL_EXPORT_C(void,Fl_Image_draw_with)(fl_Image image,int X,int Y,int W,int H); FL_EXPORT_C(void, Fl_Image_draw)(fl_Image image,int X, int Y); FL_EXPORT_C(void, Fl_Image_uncache)(fl_Image image); + FL_EXPORT_C(int, Fl_Image_fail)(fl_Image image); #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Menu_C.cpp b/c-src/Fl_Menu_C.cpp --- a/c-src/Fl_Menu_C.cpp +++ b/c-src/Fl_Menu_C.cpp @@ -615,6 +615,9 @@ FL_EXPORT_C(void,Fl_Menu__set_down_color)(fl_Menu_ menu_,unsigned c){ (static_cast(menu_))->down_color(c); } + FL_EXPORT_C(void, Fl_Menu__set_only)(fl_Menu_ menu_, fl_Menu_Item m){ + (static_cast(menu_))->setonly(static_cast(m)); + } #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Menu_C.h b/c-src/Fl_Menu_C.h --- a/c-src/Fl_Menu_C.h +++ b/c-src/Fl_Menu_C.h @@ -207,6 +207,7 @@ FL_EXPORT_C(void, Fl_Menu__set_down_box)(fl_Menu_ menu_, Fl_Boxtype b); FL_EXPORT_C(Fl_Color, Fl_Menu__down_color)(fl_Menu_ menu_); FL_EXPORT_C(void, Fl_Menu__set_down_color)(fl_Menu_ menu_, unsigned c); + FL_EXPORT_C(void, Fl_Menu__set_only)(fl_Menu_ menu_, fl_Menu_Item m); #ifdef __cplusplus } #endif diff --git a/fltkhs.cabal b/fltkhs.cabal --- a/fltkhs.cabal +++ b/fltkhs.cabal @@ -1,5 +1,5 @@ name : fltkhs -version : 0.5.0.0 +version : 0.5.0.1 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. diff --git a/src/Fluid/Generate.hs b/src/Fluid/Generate.hs --- a/src/Fluid/Generate.hs +++ b/src/Fluid/Generate.hs @@ -350,7 +350,10 @@ "Submenu" -> menuName; _ -> (Just newName) }) - ([newLabel] ++ menuPath) + (case flClassName of { + "Fl_Choice" -> []; + _ -> ([newLabel] ++ menuPath) + }) tree) takenNames' in (concatTakenNames takenNames' newNames, outputSoFar ++ output)) @@ -379,6 +382,11 @@ "MenuItem" -> (constructorG newFlClassName hsConstructor (Just newName) posSize) ++ (map (attributeG newFlClassName newName) attrsWithoutLabel) ++ + innerTreeOutput + "Fl_Choice" -> + (constructorG newFlClassName hsConstructor (Just newName) posSize) ++ + (map (attributeG newFlClassName newName) restAttrs) ++ + ["setMenu " ++ newName ++ " ([] :: [Ref MenuItem])"] ++ innerTreeOutput _ -> (constructorG newFlClassName hsConstructor (Just newName) posSize) ++ 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 @@ -157,6 +157,14 @@ setEventDispatch, eventText, eventLength, + setBoxColor, + boxColor, + abiVersion, + apiVersion, + localCtrl, + localMeta, + localAlt, + localShift ) where #include "Fl_C.h" @@ -826,3 +834,19 @@ 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 #} +setBoxColor :: Color -> IO () +setBoxColor c = {#call Fl_set_box_color as fl_set_box_color #} (cFromColor c) +boxColor :: Color -> IO Color +boxColor c = {#call Fl_box_color as fl_box_color #} (cFromColor c) >>= return . cToColor +abiVersion :: IO Int +abiVersion = {#call Fl_abi_version as fl_abi_version #} >>= return . fromIntegral +apiVersion :: IO Int +apiVersion = {#call Fl_abi_version as fl_abi_version #} >>= return . fromIntegral +localCtrl :: IO T.Text +localCtrl = {#call Fl_local_ctrl as fl_local_ctrl #} >>= cStringToText +localAlt :: IO T.Text +localAlt = {#call Fl_local_alt as fl_local_alt #} >>= cStringToText +localMeta :: IO T.Text +localMeta = {#call Fl_local_meta as fl_local_meta #} >>= cStringToText +localShift :: IO T.Text +localShift = {#call Fl_local_shift as fl_local_shift #} >>= cStringToText 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 @@ -462,16 +462,16 @@ -- -- - Make sure to 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.3 +-- == Download & Install FLTK-1.3.4-1 -- Please make sure to only download version --- . +-- . -- It should build and install smoothly with the standard: -- -- @ @@ -486,11 +486,11 @@ -- > ./configure --enable-shared --enable-gl -- @ -- --- If you didn't install FLTK from source you can use the 'fltk-config' tool to ensure that version 1.3.3 is installed: +-- 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: -- -- @ -- > fltk-config --version --- 1.3.3 +-- 1.3.4-1 -- @ -- -- Additionally the FLTK headers should be in the include path and, along with @@ -538,7 +538,7 @@ -- @ -- -- __Note:__ If the `install` step produces a flood of `undefined reference` errors --- please ensure that you have the right version of FLTK (1.3.3) installed and +-- please ensure that you have the right version of FLTK (1.3.4-1) installed and -- that the headers are in the expected locations. It seems as though some -- package managers put the libraries and headers in non-standard places so it -- is best to build from source. @@ -557,8 +557,8 @@ -- The general steps are: -- -- - Brew Install Stack --- - Brew Install FLTK-1.3.3 (Yosemite) --- - Brew Install FLTK-1.3.3 (El Capitan) +-- - Brew Install FLTK-1.3.4-1 (Yosemite) +-- - Brew Install FLTK-1.3.4-1 (El Capitan) -- - Download & install the -- - Verify the install by running `fltkhs-hello-world` -- @@ -569,7 +569,7 @@ -- > brew install haskell-stack -- @ -- --- == Brew Install FLTK-1.3.3 (Yosemite) +-- == Brew Install FLTK-1.3.4-1 (Yosemite) -- -- @ -- > brew install autoconf @@ -579,13 +579,13 @@ -- Unfortunately 'autoconf' is required to build FLTKHS but has been removed -- for the default XCode install since Yosemite so it is required here. -- --- == Brew Install FLTK-1.3.3 (El Capitan) +-- == Brew Install FLTK-1.3.4-1 (El Capitan) -- -- @ -- > brew install --devel fltk -- @ --- Unfortunately the version of Clang bundled with El Capitan does not compile the stable FLTK-1.3.3. --- This installs the as-yet unreleased development version. Although FLTKHS only support 1.3.3 +-- Unfortunately the version of Clang bundled with El Capitan does not compile the stable FLTK-1.3.4-1. +-- This installs the as-yet unreleased development version. Although FLTKHS only support 1.3.4-1 -- it seems to work. -- -- == Download & Install the FLTKHS Hello World Skeleton @@ -644,7 +644,7 @@ -- - Install 'make' via MSYS2. -- - Install -- - Download the --- - Download & compile +-- - Download & compile -- - Build & install the FLTKHS hello world skeleton project. -- - Verify the install by running `fltkhs-hello-world` -- @@ -715,9 +715,9 @@ -- started with a plain FLKTHS project, so two birds with one stone and all that ... -- -- --- == Download & compile FLTK-1.3.3 +-- == Download & compile FLTK-1.3.4-1 -- Please make sure to only download version --- . +-- . -- -- If you haven't already installed 'tar' and 'gzip' at the MSYS prompt do: -- @@ -730,13 +730,13 @@ -- -- @ -- > cd \ # This is usually \/C\/Users/\\/Downloads --- > tar -zxvf fltk-1.3.3-source.tar.gz +-- > tar -zxvf fltk-1.3.4-1-source.tar.gz -- @ -- -- Then descend into the source directory: -- -- @ --- > cd fltkh-1.3.3-source +-- > cd fltkh-1.3.4-1-source -- @ -- -- Make a build directory to hold the generated CMake files: 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 @@ -534,6 +534,8 @@ setTextcolor, DownBox, downBox, + SetOnly, + setOnly, -- * MenuBar MenuBar, -- * SysMenuBar @@ -560,6 +562,8 @@ drawResize, Uncache, uncache, + Fail, + fail, -- * Bitmap Bitmap, -- * Pixmap @@ -1553,7 +1557,7 @@ setErrorColor ) where -import Prelude hiding (round) +import Prelude hiding (round, fail) import Graphics.UI.FLTK.LowLevel.Fl_Types import Graphics.UI.FLTK.LowLevel.Dispatch #if defined(CALLSTACK_AVAILABLE) || defined(HASCALLSTACK_AVAILABLE) @@ -2274,7 +2278,8 @@ (SetDownBox (GetDownColor (SetDownColor - ()))))))))))))))))))))))))))))))))))))))))))))) + (SetOnly + ())))))))))))))))))))))))))))))))))))))))))))))) type instance Functions MenuPrim = MenuPrimFuncs @@ -2303,6 +2308,7 @@ MAKE_METHOD(GetTextcolor,getTextcolor) MAKE_METHOD(SetTextcolor,setTextcolor) MAKE_METHOD(DownBox,downBox) +MAKE_METHOD(SetOnly,setOnly) data CMenuBar parent type MenuBar = CMenuBar MenuPrim @@ -2373,7 +2379,8 @@ (DrawResize (Draw (Uncache - ()))))))))))))) + (Fail + ())))))))))))))) type instance Functions Image = ImageFuncs @@ -2385,6 +2392,7 @@ MAKE_METHOD(Desaturate,desaturate) MAKE_METHOD(DrawResize,drawResize) MAKE_METHOD(Uncache,uncache) +MAKE_METHOD(Fail,fail) data CBitmap parent type Bitmap = CBitmap Image 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,6 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.Image ( + ImageFail(..), ImageFuncs(..), defaultImageFuncs, imageNew, @@ -31,6 +32,15 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch +#c +enum ImageFail { + ImageErrNoImage = ERR_NO_IMAGE, + ImageErrFileAccess = ERR_FILE_ACCESS, + ImageErrFormat = ERR_FORMAT +}; +#endc +{#enum ImageFail {} deriving (Show, Eq, Ord) #} + 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) @@ -171,9 +181,16 @@ instance (impl ~ ( IO ())) => Op (Uncache ()) Image orig impl where runOp _ _ image = withRef image $ \imagePtr -> uncache' imagePtr +{#fun Fl_Image_fail as fail' { id `Ptr ()'} -> `CInt' #} +instance (impl ~ (IO (Either ImageFail ()))) => Op (Fail ()) Image orig impl where + runOp _ _ image = withRef image $ \imagePtr -> do + res <- fail' imagePtr + if (res == 0) + then return (Right ()) + else return (Left (cToEnum res)) + -- $functions -- @ --- -- colorAverage :: 'Ref' 'Image' -> 'Color' -> 'Float' -> 'IO' () -- -- copy :: 'Ref' 'Image' -> 'Maybe' 'Size' -> 'IO' ('Maybe' ('Ref' 'Image')) @@ -186,6 +203,8 @@ -- -- 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') @@ -200,7 +219,6 @@ -- -- uncache :: 'Ref' 'Image' -> 'IO' () -- @ - -- $hierarchy -- @ 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 @@ -297,6 +297,10 @@ {# 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 +{# 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 -- $functions -- @ @@ -339,9 +343,9 @@ -- -- global :: 'Ref' 'MenuPrim' -> 'IO' () -- --- handle :: 'Ref' 'MenuPrim' -> ('Event' -> 'IO' ('Either' 'UnknownEvent' ())) +-- handle :: 'Ref' 'MenuPrim' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- --- handleSuper :: 'Ref' 'MenuPrim' -> 'Event' -> 'IO' ('Int') +-- handleSuper :: 'Ref' 'MenuPrim' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ()) -- -- hide :: 'Ref' 'MenuPrim' -> 'IO' () -- @@ -372,6 +376,8 @@ -- setMenu:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> ['Ref' a] -> 'IO' () -- -- setMode :: 'Ref' 'MenuPrim' -> 'Int' -> 'MenuItemFlags' -> 'IO' () +-- +-- setOnly:: ('Parent' a 'MenuItem') => 'Ref' 'MenuPrim' -> 'Ref' a -> 'IO' () -- -- setShortcut :: 'Ref' 'MenuPrim' -> 'Int' -> 'ShortcutKeySequence' -> 'IO' () -- diff --git a/src/TestPrograms/Buttons.hs b/src/TestPrograms/Buttons.hs --- a/src/TestPrograms/Buttons.hs +++ b/src/TestPrograms/Buttons.hs @@ -3,7 +3,6 @@ import Graphics.UI.FLTK.LowLevel.FL import Graphics.UI.FLTK.LowLevel.FLTKHS -import Graphics.UI.FLTK.LowLevel.Fl_Enumerations main :: IO () main = do