diff --git a/fltkhs.cabal b/fltkhs.cabal --- a/fltkhs.cabal +++ b/fltkhs.cabal @@ -1,5 +1,5 @@ name : fltkhs -version : 0.4.0.8 +version : 0.4.0.9 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. @@ -82,6 +82,7 @@ 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.Table Graphics.UI.FLTK.LowLevel.TableRow diff --git a/src/Fluid/Generate.hs b/src/Fluid/Generate.hs --- a/src/Fluid/Generate.hs +++ b/src/Fluid/Generate.hs @@ -321,7 +321,7 @@ trees) modify (\ns -> concatTakenNames ns newNames) let code = (constructorG newFlClassName hsConstructor (Just newName) posSize) ++ - (map (attributeG hsClassName newName) restAttrs) ++ + (map (attributeG newFlClassName newName) restAttrs) ++ ["begin " ++ newName] ++ innerTreeOutput ++ ["end " ++ newName] diff --git a/src/Fluid/Lookup.hs b/src/Fluid/Lookup.hs --- a/src/Fluid/Lookup.hs +++ b/src/Fluid/Lookup.hs @@ -289,6 +289,10 @@ ,("Fl_Browser",("Browser", "browserNew" )) ,("Fl_Tabs",("Tabs", "tabsNew")) ,("Fl_Progress", ("Progress", "progressNew")) + ,("Fl_File_Input", ("FileInput", "fileInputNew")) + ,("Fl_Text_Display", ("TextDisplay", "textDisplayNew")) + ,("Fl_Text_Editor", ("TextEditor", "textEditorNew")) + ,("Fl_Tile", ("Tile", "tileNew")) ] imageExtensions = diff --git a/src/Fluid/Parser.hs b/src/Fluid/Parser.hs --- a/src/Fluid/Parser.hs +++ b/src/Fluid/Parser.hs @@ -326,6 +326,7 @@ , (string "Fl_Pack") , (string "Fl_Table") , (string "Fl_Scroll") + , (string "Fl_Tile") ]) ++ [(string "Fl_Tabs")] @@ -372,6 +373,9 @@ , (string "Fl_File_Browser") , (string "Fl_Tree") , (string "Fl_Progress") + , (string "Fl_File_Input") + , (string "Fl_Text_Display") + , (string "Fl_Text_Editor") ]) testIdentifier :: String @@ -514,6 +518,7 @@ body <- manyTill fluidP (trimAfter $ char '}') return (Class (InvalidHaskell name) otherArgs body) + declBlockP :: ParsecT String () Identity FluidBlock declBlockP = 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 @@ -83,6 +83,7 @@ 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.LightButton, module Graphics.UI.FLTK.LowLevel.LineDial, module Graphics.UI.FLTK.LowLevel.MenuPrim, @@ -209,6 +210,7 @@ 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 diff --git a/src/Graphics/UI/FLTK/LowLevel/FileInput.chs b/src/Graphics/UI/FLTK/LowLevel/FileInput.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/FLTK/LowLevel/FileInput.chs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Graphics.UI.FLTK.LowLevel.FileInput + ( + fileInputNew + -- * Hierarchy + -- + -- $hierarchy + ) +where +#include "Fl_ExportMacros.h" +#include "Fl_Types.h" +#include "Fl_File_InputC.h" +import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum) +import Foreign.C.Types +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_File_Input_New as fileInputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} +{# fun Fl_File_Input_New_WithLabel as fileInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} +fileInputNew :: Rectangle -> Maybe String -> 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 + +{# fun Fl_File_Input_down_box as downBox' { id `Ptr ()' } -> `Boxtype' cToEnum #} +instance (impl ~ ( IO (Boxtype))) => Op (GetDownBox ()) FileInput orig impl where + runOp _ _ fileInput = withRef fileInput $ \fileInputPtr -> downBox' fileInputPtr +{# fun Fl_File_Input_set_down_box as setDownBox' { id `Ptr ()',cFromEnum `Boxtype' } -> `()' #} +instance (impl ~ (Boxtype -> IO ())) => Op (SetDownBox ()) FileInput orig impl where + runOp _ _ fileInput b = withRef fileInput $ \fileInputPtr -> setDownBox' fileInputPtr b +{# fun Fl_File_Input_errorcolor as errorColor' { id `Ptr ()' } -> `Color' cToColor #} +instance (impl ~ ( IO (Color))) => Op (GetErrorColor ()) FileInput orig impl where + runOp _ _ fileInput = withRef fileInput $ \fileInputPtr -> errorColor' fileInputPtr +{# fun Fl_File_Input_set_errorcolor as setErrorColor' { id `Ptr ()',cFromColor `Color' } -> `()' #} +instance (impl ~ (Color -> IO ())) => Op (SetErrorColor ()) FileInput orig impl where + runOp _ _ fileInput b = withRef fileInput $ \fileInputPtr -> setErrorColor' fileInputPtr b +{# fun Fl_File_Input_set_value as setValue' { id `Ptr ()', unsafeToCString `String'} -> `()' #} +instance (impl ~ (String -> IO ())) => Op (SetValue ()) FileInput orig impl where + runOp _ _ fileInput s = withRef fileInput $ \fileInputPtr -> setValue' fileInputPtr s +{# fun Fl_File_Input_value as getValue' { id `Ptr ()' } -> `String' unsafeFromCString #} +instance (impl ~ (IO (String))) => Op (GetValue ()) FileInput orig impl where + runOp _ _ fileInput = withRef fileInput $ \fileInputPtr -> getValue' fileInputPtr + +-- $hierarchy +-- @ +-- @ + +-- $functions +-- @ +-- @ 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 @@ -1546,8 +1546,14 @@ -- PNGImage PNGImage, -- PNMImage - PNMImage - ) + PNMImage, + -- FileInput + FileInput, + GetErrorColor, + getErrorColor, + SetErrorColor, + setErrorColor + ) where import Prelude hiding (round) import Graphics.UI.FLTK.LowLevel.Fl_Types @@ -4037,3 +4043,18 @@ data CPNMImage parent type PNMImage = CPNMImage RGBImage type instance Functions PNMImage = () + +data CFileInput parent +type FileInput = CFileInput Input +type FileInputFuncs = + (SetDownBox + (GetDownBox + (SetErrorColor + (GetErrorColor + (GetValue + (SetValue + ())))))) + +type instance Functions FileInput = FileInputFuncs +MAKE_METHOD(SetErrorColor, setErrorColor) +MAKE_METHOD(GetErrorColor, getErrorColor)