diff --git a/.git/index b/.git/index Binary files a/.git/index and b/.git/index differ diff --git a/.git/logs/HEAD b/.git/logs/HEAD --- a/.git/logs/HEAD +++ b/.git/logs/HEAD @@ -1,1 +1,1 @@ -0000000000000000000000000000000000000000 dd91a893ef0896be0748af993a8bc2b654f68de5 deech 1424483718 -0600 clone: from http://github.com/deech/fltkhs +0000000000000000000000000000000000000000 8fae34c12b758b8247b79cc29df29238ddd17e21 deech 1424905185 -0600 clone: from http://github.com/deech/fltkhs diff --git a/.git/logs/refs/heads/master b/.git/logs/refs/heads/master --- a/.git/logs/refs/heads/master +++ b/.git/logs/refs/heads/master @@ -1,1 +1,1 @@ -0000000000000000000000000000000000000000 dd91a893ef0896be0748af993a8bc2b654f68de5 deech 1424483718 -0600 clone: from http://github.com/deech/fltkhs +0000000000000000000000000000000000000000 8fae34c12b758b8247b79cc29df29238ddd17e21 deech 1424905185 -0600 clone: from http://github.com/deech/fltkhs diff --git a/.git/logs/refs/remotes/origin/HEAD b/.git/logs/refs/remotes/origin/HEAD --- a/.git/logs/refs/remotes/origin/HEAD +++ b/.git/logs/refs/remotes/origin/HEAD @@ -1,1 +1,1 @@ -0000000000000000000000000000000000000000 dd91a893ef0896be0748af993a8bc2b654f68de5 deech 1424483718 -0600 clone: from http://github.com/deech/fltkhs +0000000000000000000000000000000000000000 8fae34c12b758b8247b79cc29df29238ddd17e21 deech 1424905185 -0600 clone: from http://github.com/deech/fltkhs diff --git a/.git/objects/pack/pack-81ea553411e65ea3b77abc8b515369312788978a.idx b/.git/objects/pack/pack-81ea553411e65ea3b77abc8b515369312788978a.idx deleted file mode 100644 Binary files a/.git/objects/pack/pack-81ea553411e65ea3b77abc8b515369312788978a.idx and /dev/null differ diff --git a/.git/objects/pack/pack-81ea553411e65ea3b77abc8b515369312788978a.pack b/.git/objects/pack/pack-81ea553411e65ea3b77abc8b515369312788978a.pack deleted file mode 100644 Binary files a/.git/objects/pack/pack-81ea553411e65ea3b77abc8b515369312788978a.pack and /dev/null differ diff --git a/.git/objects/pack/pack-df1277a71712eb9f9144a96c7fa9d332a97d5426.idx b/.git/objects/pack/pack-df1277a71712eb9f9144a96c7fa9d332a97d5426.idx new file mode 100644 Binary files /dev/null and b/.git/objects/pack/pack-df1277a71712eb9f9144a96c7fa9d332a97d5426.idx differ diff --git a/.git/objects/pack/pack-df1277a71712eb9f9144a96c7fa9d332a97d5426.pack b/.git/objects/pack/pack-df1277a71712eb9f9144a96c7fa9d332a97d5426.pack new file mode 100644 # file too large to diff: .git/objects/pack/pack-df1277a71712eb9f9144a96c7fa9d332a97d5426.pack diff --git a/.git/packed-refs b/.git/packed-refs --- a/.git/packed-refs +++ b/.git/packed-refs @@ -1,3 +1,3 @@ # pack-refs with: peeled fully-peeled 8943336c272ff8dab557abb3ee781cb1d209bd32 refs/remotes/origin/ABI -dd91a893ef0896be0748af993a8bc2b654f68de5 refs/remotes/origin/master +8fae34c12b758b8247b79cc29df29238ddd17e21 refs/remotes/origin/master diff --git a/.git/refs/heads/master b/.git/refs/heads/master --- a/.git/refs/heads/master +++ b/.git/refs/heads/master @@ -1,1 +1,1 @@ -dd91a893ef0896be0748af993a8bc2b654f68de5 +8fae34c12b758b8247b79cc29df29238ddd17e21 diff --git a/c-src/Fl_Native_File_ChooserC.cpp b/c-src/Fl_Native_File_ChooserC.cpp --- a/c-src/Fl_Native_File_ChooserC.cpp +++ b/c-src/Fl_Native_File_ChooserC.cpp @@ -3,73 +3,76 @@ EXPORT { #endif FL_EXPORT_C(fl_Native_File_Chooser,Fl_Native_File_Chooser_New_WithVal)(int val){ - Fl_Native_File_Chooser* c = new Fl_Native_File_Chooser(val); - return (fl_Native_File_Chooser) c; -} + Fl_Native_File_Chooser* c = new Fl_Native_File_Chooser(val); + return (fl_Native_File_Chooser) c; + } FL_EXPORT_C(fl_Native_File_Chooser,Fl_Native_File_Chooser_New)( ){ - Fl_Native_File_Chooser* c = new Fl_Native_File_Chooser(); - return (fl_Native_File_Chooser) c; -} + Fl_Native_File_Chooser* c = new Fl_Native_File_Chooser(); + return (fl_Native_File_Chooser) c; + } + FL_EXPORT_C(void, Fl_Native_File_Chooser_Destroy)(fl_Native_File_Chooser chooser){ + delete (static_cast(chooser)); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_type)(fl_Native_File_Chooser chooser,int type){ - (static_cast(chooser))->type(type); -} + (static_cast(chooser))->type(type); + } FL_EXPORT_C(int,Fl_Native_File_Chooser_type)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->type(); -} + return (static_cast(chooser))->type(); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_options)(fl_Native_File_Chooser chooser,int options){ - (static_cast(chooser))->options(options); -} + (static_cast(chooser))->options(options); + } FL_EXPORT_C(int,Fl_Native_File_Chooser_options)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->options(); -} + return (static_cast(chooser))->options(); + } FL_EXPORT_C(int,Fl_Native_File_Chooser_count)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->count(); -} + return (static_cast(chooser))->count(); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_filename)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->filename(); -} + return (static_cast(chooser))->filename(); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_filename_with_i)(fl_Native_File_Chooser chooser,int i){ - return (static_cast(chooser))->filename(i); -} + return (static_cast(chooser))->filename(i); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_directory)(fl_Native_File_Chooser chooser,const char *val){ - (static_cast(chooser))->directory(val); -} + (static_cast(chooser))->directory(val); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_directory)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->directory(); -} + return (static_cast(chooser))->directory(); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_title)(fl_Native_File_Chooser chooser,const char * title){ - (static_cast(chooser))->title(title); -} + (static_cast(chooser))->title(title); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_title)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->title(); -} + return (static_cast(chooser))->title(); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_filter)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->filter(); -} + return (static_cast(chooser))->filter(); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_filter)(fl_Native_File_Chooser chooser,const char * filter){ - (static_cast(chooser))->filter(filter); -} + (static_cast(chooser))->filter(filter); + } FL_EXPORT_C(int,Fl_Native_File_Chooser_filters)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->filters(); -} + return (static_cast(chooser))->filters(); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_filter_value)(fl_Native_File_Chooser chooser,int i){ - (static_cast(chooser))->filter_value(i); -} + (static_cast(chooser))->filter_value(i); + } FL_EXPORT_C(int,Fl_Native_File_Chooser_filter_value)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->filter_value(); -} + return (static_cast(chooser))->filter_value(); + } FL_EXPORT_C(void,Fl_Native_File_Chooser_set_preset_file)(fl_Native_File_Chooser chooser,const char* preset_file){ - (static_cast(chooser))->preset_file(preset_file); -} + (static_cast(chooser))->preset_file(preset_file); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_preset_file)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->preset_file(); -} + return (static_cast(chooser))->preset_file(); + } FL_EXPORT_C(const char*,Fl_Native_File_Chooser_errmsg)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->errmsg(); -} + return (static_cast(chooser))->errmsg(); + } FL_EXPORT_C(int,Fl_Native_File_Chooser_show)(fl_Native_File_Chooser chooser){ - return (static_cast(chooser))->show(); -} + return (static_cast(chooser))->show(); + } #ifdef __cplusplus } #endif diff --git a/c-src/Fl_Native_File_ChooserC.h b/c-src/Fl_Native_File_ChooserC.h --- a/c-src/Fl_Native_File_ChooserC.h +++ b/c-src/Fl_Native_File_ChooserC.h @@ -28,6 +28,7 @@ #endif FL_EXPORT_C(fl_Native_File_Chooser, Fl_Native_File_Chooser_New_WithVal)(int val); FL_EXPORT_C(fl_Native_File_Chooser, Fl_Native_File_Chooser_New)(); + FL_EXPORT_C(void, Fl_Native_File_Chooser_Destroy)(fl_Native_File_Chooser chooser); FL_EXPORT_C(void, Fl_Native_File_Chooser_set_type)(fl_Native_File_Chooser chooser, int type); FL_EXPORT_C(int, Fl_Native_File_Chooser_type)(fl_Native_File_Chooser chooser); FL_EXPORT_C(void, Fl_Native_File_Chooser_set_options)(fl_Native_File_Chooser chooser, int options); diff --git a/fltkhs.cabal b/fltkhs.cabal --- a/fltkhs.cabal +++ b/fltkhs.cabal @@ -1,5 +1,5 @@ name: fltkhs -version: 0.1.0.0 +version: 0.1.0.1 synopsis: FLTK bindings description: Low level bindings for the FLTK GUI toolkit. @@ -89,6 +89,7 @@ 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 build-depends: base == 4.*, @@ -100,6 +101,33 @@ default-extensions: GADTs default-language: Haskell2010 ghc-options: -Wall -fcontext-stack=220 + +Executable fltkhs-nativefilechooser-simple-app + Main-Is: nativefilechooser-simple-app.hs + Hs-Source-Dirs: src/Examples + Build-Depends: + base == 4.*, + directory, + fltkhs + default-language: Haskell2010 + ghc-Options: -Wall -threaded -fcontext-stack=220 + if os(linux) + ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" + else + ghc-Options: + +Executable fltkhs-table-as-container + Main-Is: table-as-container.hs + Hs-Source-Dirs: src/Examples + Build-Depends: + base == 4.*, + fltkhs + default-language: Haskell2010 + ghc-Options: -Wall -threaded -fcontext-stack=220 + if os(linux) + ghc-Options: -pgml g++ "-optl-Wl,--whole-archive" "-optl-Wl,-Bstatic" "-optl-Wl,-lfltkc" "-optl-Wl,-Bdynamic" "-optl-Wl,--no-whole-archive" + else + ghc-Options: Executable fltkhs-texteditor-simple Main-Is: texteditor-simple.hs diff --git a/scripts/header-to-function-definition.hs b/scripts/header-to-function-definition.hs --- a/scripts/header-to-function-definition.hs +++ b/scripts/header-to-function-definition.hs @@ -410,6 +410,7 @@ ,("Fl_Boxtype", "Boxtype") ,("Fl_Mode", "Mode") ,("fl_Widget", "Ptr ()") + ,("fl_Native_File_Chooser", "Ptr ()") ,("fl_Text_Buffer", "Ptr ()") ,("fl_Text_Selection", "Ptr ()") ,("fl_Text_Display" , "Ptr ()") @@ -476,6 +477,7 @@ [ ("fl_Region" , "Region"), ("fl_Widget" , "Widget"), + ("fl_Native_File_Chooser" , "NativeFileChooser"), ("fl_Text_Buffer" , "TextBuffer"), ("fl_Text_Selection" , "TextSelection"), ("fl_Text_Display" , "TextDisplay"), diff --git a/src/Examples/nativefilechooser-simple-app.hs b/src/Examples/nativefilechooser-simple-app.hs new file mode 100644 --- /dev/null +++ b/src/Examples/nativefilechooser-simple-app.hs @@ -0,0 +1,92 @@ +module Main where +import qualified Graphics.UI.FLTK.LowLevel.FL as FL +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +import Graphics.UI.FLTK.LowLevel.FLTKHS +import System.Directory +import System.Exit + +openFile :: FilePath -> IO () +openFile fp = print $ "Open '" ++ fp ++ "''" + +saveFile :: FilePath -> IO () +saveFile fp = do + print $ "Saving '" ++ fp ++ "'" + exists' <- doesFileExist fp + if not exists' + then writeFile fp "Hello world.\n" + else return () + +openCb :: Ref NativeFileChooser -> Ref SysMenuBar -> IO () +openCb fc _ = do + setTitle fc "Open" + res' <- showWidget fc + case res' of + NativeFileChooserPicked -> do + f' <- getFilename fc + case f' of + (Just f'') -> do + setPresetFile fc f'' + openFile f'' + _ -> return () + _ -> return () + +saveAsCb :: Ref NativeFileChooser -> Ref SysMenuBar -> IO () +saveAsCb fc _ = do + setTitle fc "Open" + res' <- showWidget fc + case res' of + NativeFileChooserPicked -> do + f' <- getFilename fc + case f' of + (Just f'') -> do + setPresetFile fc f'' + saveFile f'' + _ -> return () + _ -> return () + +saveCb :: Ref NativeFileChooser -> Ref SysMenuBar -> IO () +saveCb fc w' = do + f' <- getFilename fc + case f' of + Nothing -> saveAsCb fc w' + (Just f'') -> saveFile f'' + +quitCb :: Ref SysMenuBar -> IO () +quitCb _ = exitSuccess + +initializeWindow :: Ref Window -> IO () +initializeWindow w' = do + chooser <- nativeFileChooserNew Nothing + setFilter chooser "Text\t*.txt\n" + setPresetFile chooser "untitiled.txt" + begin w' + menu <- sysMenuBarNew (toRectangle (0,0,400,25)) Nothing + _ <- add menu "&File/&Open" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'o')))) (openCb chooser) (MenuItemFlags []) + _ <- add menu "&File/&Save" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 's')))) (saveCb chooser) (MenuItemFlags []) + _ <- add menu "&File/&Save As" Nothing (saveAsCb chooser) (MenuItemFlags []) + _ <- add menu "&File/&Quit" (Just (KeySequence (ShortcutKeySequence [kb_CommandState] (NormalKeyType 'q')))) quitCb (MenuItemFlags []) + w_w' <- getW w' + w_h' <- getH w' + box' <- boxNew (toRectangle (20,25+20,w_w'-40,w_h'-40-25)) Nothing Nothing + setColor box' (Color 45) + setBox box' FlatBox + setAlign box' (Alignments [AlignTypeCenter, AlignTypeInside, AlignTypeWrap]) + setLabel box' $ "This demo shows an example of implementing " ++ + "common 'File' menu operations like:\n" ++ + " File/Open, File/Save, File/Save As\n" ++ + "..using the Fl_Native_File_Chooser widget.\n\n" ++ + "Note 'Save' and 'Save As' really *does* create files! " ++ + "This is to show how behavior differs when " ++ + "files exist vs. do not."; + setLabelsize box' (FontSize 12) + end w' + +main :: IO () +main = do + _ <- FL.setScheme "gtk+" + app <- windowNew (toSize (400,200)) Nothing (Just "Native File Chooser Example") + initializeWindow app + showWidget app + _ <- FL.run + return () diff --git a/src/Examples/table-as-container.hs b/src/Examples/table-as-container.hs new file mode 100644 --- /dev/null +++ b/src/Examples/table-as-container.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Main where +import qualified Graphics.UI.FLTK.LowLevel.FL as FL +import Graphics.UI.FLTK.LowLevel.Fl_Types +import Graphics.UI.FLTK.LowLevel.Fl_Enumerations +import Graphics.UI.FLTK.LowLevel.FLTKHS + +buttonCb :: Ref LightButton -> IO () +buttonCb lightButton = do + l' <- getLabel lightButton + print $ "BUTTON: " ++ l' + +setTableSize :: Ref Table -> Int -> Int -> IO () +setTableSize t' nr' nc' = do + clear t' + setRows t' nr' + setCols t' nc' + begin t' + let (rowCols :: [(Int,Int)]) = [(r',c') | r' <- [0..(nr'-1)], c' <- [0..(nc'-1)]] + mapM_ + (\(_r,_c) -> do + cellRectangle <- findCell t' ContextTable (TableCoordinate (Row _r) (Column _c)) + case cellRectangle of + Just cellRectangle' -> + if (odd _c) + then do + let s = (show _r) ++ "." ++ (show _c) + input_ <- inputNew Nothing cellRectangle' Nothing + _ <- setValue input_ s Nothing + return () + else + do + let s = (show _r) ++ "/" ++ (show _c) + butt <- lightButtonNew cellRectangle' (Just s) + setAlign butt (Alignments [AlignTypeCenter, AlignTypeInside]) + setCallback butt buttonCb + _ <- setValue butt ((_r+_c*2) `mod` 4 == 0) + return () + Nothing -> return () + ) + rowCols + end t' + +drawCell :: Ref Table -> TableContext -> TableCoordinate -> Rectangle -> IO () +drawCell t' tcontext' (TableCoordinate (Row tr') (Column tc')) r' = + case tcontext' of + ContextStartPage -> flcSetFont helvetica (FontSize 12) + ContextRCResize -> do + rows' <- getRows t' + cols' <- getCols t' + let (rowCols :: [(Int,Int)]) = [(_r,_c) | _r <- [0..(rows'-1)], _c <- [0..(cols'-1)]] + mapM_ + (\((i::Int), (_r',_c')) -> do + children' <- children t' + if (i >= children') + then return () + else do + cellRectangle <- findCell t' ContextTable (TableCoordinate (Row _r') (Column _c')) + case cellRectangle of + Just cellRectangle' -> do + child' <- getChild t' i + resize child' cellRectangle' + Nothing -> return () + ) + (zip [0..] rowCols) + initSizes t' + ContextRowHeader -> do + flcPushClip r' + let s = "Row " ++ (show tr') + headerColor <- getRowHeaderColor t' + flcDrawBox ThinUpBox r' headerColor + flcSetColor blackColor + flcDrawInBox s r' (Alignments [AlignTypeCenter]) Nothing Nothing + flcPopClip + ContextColHeader -> do + flcPushClip r' + let s = "Column " ++ (show tc') + headerColor <- getColHeaderColor t' + flcDrawBox ThinUpBox r' headerColor + flcSetColor blackColor + flcDrawInBox s r' (Alignments [AlignTypeCenter]) Nothing Nothing + flcPopClip + _ -> return () +initializeTable :: Ref Table -> IO () +initializeTable t = do + begin t + setColHeader t True + setColResize t True + setColHeaderHeight t 25 + setRowHeader t True + setRowResize t True + setRowHeaderWidth t 80 + end t +main :: IO () +main = do + win <- doubleWindowNew (toSize (940,500)) Nothing (Just "table as container") + win_w <- getW win + win_h <- getH win + begin win + table <- tableCustom + (toRectangle (20,20,win_w-40,win_h-40)) + (Just "FLTK widget table") + defaultCustomWidgetFuncs + (defaultCustomTableFuncs{ + drawCellCustom = (Just drawCell) + }) + initializeTable table + setTableSize table 50 50 + end win + setResizable win table + showWidget win + _ <- FL.run + return () diff --git a/src/Examples/table-sort.hs b/src/Examples/table-sort.hs --- a/src/Examples/table-sort.hs +++ b/src/Examples/table-sort.hs @@ -161,7 +161,7 @@ mapM_ (\(colNum, colName) -> do (Size (Width w') _) <- flcMeasure colName Nothing - setColWidth table colNum (w' + pad) + setColWidth table (Column colNum) (w' + pad) ) (zip [0 ..] dirHeaders) flcSetFont rowFontFace rowFontSize @@ -170,9 +170,9 @@ mapM_ (\(colIdx,col) -> do (Size (Width wc') _) <- flcMeasure col Nothing - colWidth' <- getColWidth table colIdx + colWidth' <- getColWidth table (Column colIdx) if (wc' + pad > colWidth') - then setColWidth table colIdx (wc' + pad) + then setColWidth table (Column colIdx) (wc' + pad) else return () ) (zip [0..] row') @@ -187,7 +187,7 @@ resize_window window table = do let width = (4 :: Int) numCols <- getCols table - colWidthTotal <- liftM sum $ mapM (getColWidth table) [0..(numCols - 1)] + colWidthTotal <- liftM sum $ mapM (getColWidth table . Column) [0..(numCols - 1)] let totalWidth = width + colWidthTotal + (margin * 2) appWidth <- FL.w if (totalWidth < 200 || totalWidth > appWidth) 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 @@ -4,6 +4,10 @@ ( -- * Constructor adjusterNew, + -- * Hierarchy + -- + -- $hierarchy + -- * Functions -- -- $functions @@ -20,7 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Adjuster_New as adjusterNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Adjuster_New_WithLabel as adjusterNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Adjuster_New_WithLabel as adjusterNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} adjusterNew :: Rectangle -> Maybe String -> IO (Ref Adjuster) adjusterNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -42,6 +46,18 @@ {# fun unsafe Fl_Adjuster_set_soft as setSoft' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ (Int -> IO ())) => Op (SetSoft ()) Adjuster orig impl where runOp _ _ adjuster soft = withRef adjuster $ \adjusterPtr -> setSoft' adjusterPtr soft + +-- $hierarchy +-- @ +-- "Graphics.UI.FLTK.LowLevel.Widget" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.Valuator" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.Adjuster" +-- @ + -- $functions -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/Bitmap.chs b/src/Graphics/UI/FLTK/LowLevel/Bitmap.chs --- a/src/Graphics/UI/FLTK/LowLevel/Bitmap.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Bitmap.chs @@ -3,6 +3,13 @@ module Graphics.UI.FLTK.LowLevel.Bitmap ( bitmapNew + -- * Hierarchy + -- + -- $hierarchy + + -- * Functions + -- + -- $functions ) where #include "Fl_ExportMacros.h" @@ -75,3 +82,39 @@ {# fun unsafe Fl_Bitmap_uncache as uncache' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (Uncache ()) Bitmap orig impl where runOp _ _ bitmap = withRef bitmap $ \bitmapPtr -> uncache' bitmapPtr + +-- $hierarchy +-- @ +-- "Graphics.UI.FLTK.LowLevel.Image" +-- | +-- v +-- "Graphics.UI.FLTK.LowLevel.Bitmap" + +-- $functions +-- @ +-- colorAverage :: 'Ref' 'Bitmap' -> 'Color' -> 'Float' -> 'IO' () +-- +-- copy :: 'Ref' 'Bitmap' -> 'Maybe' 'Size' -> 'IO' ('Ref' 'Bitmap') +-- +-- desaturate :: 'Ref' 'Bitmap' -> 'IO' () +-- +-- destroy :: 'Ref' 'Bitmap' -> 'IO' () +-- +-- draw :: 'Ref' 'Bitmap' -> 'Position' -> 'IO' () +-- +-- drawResize :: 'Ref' 'Bitmap' -> 'Position' -> 'Size' -> 'Maybe' 'X' -> 'Maybe' 'Y' -> 'IO' () +-- +-- getCount :: 'Ref' 'Bitmap' -> 'IO' 'Int' +-- +-- getD :: 'Ref' 'Bitmap' -> 'IO' 'Int' +-- +-- getH :: 'Ref' 'Bitmap' -> 'IO' 'Int' +-- +-- getLd :: 'Ref' 'Bitmap' -> 'IO' 'Int' +-- +-- getW :: 'Ref' 'Bitmap' -> 'IO' 'Int' +-- +-- inactive :: 'Ref' 'Bitmap' -> 'IO' () +-- +-- uncache :: 'Ref' 'Bitmap' -> '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 @@ -27,11 +27,11 @@ import Graphics.UI.FLTK.LowLevel.Widget {# fun Fl_Box_New as boxNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Box_New_WithLabel as boxNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenBox_New_WithLabel as overriddenBoxNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Box_New_WithLabel as boxNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenBox_New_WithLabel as overriddenBoxNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenBox_New as overriddenBoxNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_Box_New_WithBoxtype as boxNewWithBoxtype' {cFromEnum `Boxtype', `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenBox_New_WithBoxtype as overriddenBoxNewWithBoxtype' {cFromEnum `Boxtype', `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Box_New_WithBoxtype as boxNewWithBoxtype' {cFromEnum `Boxtype', `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenBox_New_WithBoxtype as overriddenBoxNewWithBoxtype' {cFromEnum `Boxtype', `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} boxNew :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Box) -> IO (Ref Box) boxNew rectangle l' funcs' = widgetMaker @@ -60,7 +60,7 @@ -- $functions -- @ --- +-- handle :: 'Ref' 'Box' -> 'Event' -> 'IO' 'Int' -- @ -- $hierarchy 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 @@ -26,8 +26,8 @@ import Graphics.UI.FLTK.LowLevel.Widget {# fun Fl_Browser_New as browserNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Browser_New_WithLabel as browserNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenBrowser_New_WithLabel as overriddenBrowserNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Browser_New_WithLabel as browserNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenBrowser_New_WithLabel as overriddenBrowserNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenBrowser_New as overriddenBrowserNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} browserNew :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Browser) -> IO (Ref Browser) browserNew rectangle l' funcs' = @@ -51,16 +51,16 @@ {# fun unsafe 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 -{# fun unsafe Fl_Browser_add as add' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Browser_add as add' { id `Ptr ()',unsafeToCString `String' } -> `()' #} instance (impl ~ (String -> IO ())) => Op (Add ()) Browser orig impl where runOp _ _ browser newtext = withRef browser $ \browserPtr -> add' browserPtr newtext -{# fun unsafe Fl_Browser_insert as insert' { id `Ptr ()',`Int',`String' } -> `()' #} +{# fun unsafe Fl_Browser_insert as insert' { id `Ptr ()',`Int',unsafeToCString `String' } -> `()' #} instance (impl ~ (Int -> String -> IO ())) => Op (Insert ()) Browser orig impl where runOp _ _ browser line newtext = withRef browser $ \browserPtr -> insert' browserPtr line newtext {# fun unsafe Fl_Browser_move as move' { id `Ptr ()',`Int',`Int' } -> `()' #} instance (impl ~ (Int -> Int -> IO ())) => Op (Move ()) Browser orig impl where runOp _ _ browser to from = withRef browser $ \browserPtr -> move' browserPtr to from -{# fun unsafe Fl_Browser_load as load' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Browser_load as load' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} instance (impl ~ (String -> IO (Int))) => Op (Load ()) Browser orig impl where runOp _ _ browser filename = withRef browser $ \browserPtr -> load' browserPtr filename {# fun unsafe Fl_Browser_swap as swap' { id `Ptr ()',`Int',`Int' } -> `()' #} @@ -120,7 +120,7 @@ {# fun unsafe Fl_Browser_text as text' { id `Ptr ()',`Int' } -> `String' #} instance (impl ~ (Int -> IO (String))) => Op (GetText ()) Browser orig impl where runOp _ _ browser line = withRef browser $ \browserPtr -> text' browserPtr line -{# fun unsafe Fl_Browser_set_text as setText' { id `Ptr ()',`Int',`String' } -> `()' #} +{# fun unsafe Fl_Browser_set_text as setText' { id `Ptr ()',`Int', unsafeToCString `String' } -> `()' #} instance (impl ~ (Int -> String -> IO ())) => Op (SetText ()) Browser orig impl where runOp _ _ browser line newtext = withRef browser $ \browserPtr -> setText' browserPtr line newtext {# fun unsafe Fl_Browser_format_char as formatChar' { id `Ptr ()' } -> `CChar' id #} diff --git a/src/Graphics/UI/FLTK/LowLevel/Button.chs b/src/Graphics/UI/FLTK/LowLevel/Button.chs --- a/src/Graphics/UI/FLTK/LowLevel/Button.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Button.chs @@ -29,8 +29,8 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# fun Fl_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenButton_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenButton_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenButton_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} buttonCustom :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Button) -> IO (Ref Button) buttonCustom rectangle l' funcs' = 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 @@ -23,7 +23,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Check_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Check_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Check_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} checkButtonNew :: Rectangle -> Maybe String -> IO (Ref CheckButton) checkButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -27,7 +27,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# fun Fl_Choice_New as choiceNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Choice_New_WithLabel as choiceNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Choice_New_WithLabel as choiceNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} choiceNew :: Rectangle -> Maybe String -> IO (Ref Choice) choiceNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -47,8 +47,8 @@ data ClockSinceEpoch = ClockSinceEpoch Second data ClockSetTimeType = ClockSetByTime ClockByTime | ClockSetSinceEpoch ClockSinceEpoch {# fun Fl_Clock_New as clockNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Clock_New_WithLabel as clockNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_Clock_New_WithClockType as clockNewWithClockType' { id `CUChar', `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Clock_New_WithLabel as clockNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_Clock_New_WithClockType as clockNewWithClockType' { id `CUChar', `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} clockNew :: Rectangle -> Maybe String -> IO (Ref Clock) clockNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -101,6 +101,7 @@ -- handle :: 'Ref' 'Clock' -> 'Event' -> 'IO' 'Int' -- -- setValue :: 'Ref' 'Clock' -> 'ClockSetTimeType' -> 'IO' () +-- @ -- $hierarchy -- @ 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 @@ -8,6 +8,10 @@ -- -- $hierarchy + -- * Functions + -- + -- $Counterfunctions + -- ) where #include "Fl_ExportMacros.h" @@ -22,7 +26,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Counter_New as counterNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Counter_New_WithLabel as counterNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Counter_New_WithLabel as counterNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} counterNew :: Rectangle -> Maybe String -> IO (Ref Counter) counterNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Dial_New as dialNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Dial_New_WithLabel as dialNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Dial_New_WithLabel as dialNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} dialNew :: Rectangle -> Maybe String -> IO (Ref Dial) dialNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -29,8 +29,8 @@ {# fun Fl_OverriddenDouble_Window_New as overriddenWindowNew' {`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenDouble_Window_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenDouble_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenDouble_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenDouble_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenDouble_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} doubleWindowCustom :: Size -> Maybe Position -> Maybe String -> CustomWidgetFuncs DoubleWindow -> CustomWindowFuncs DoubleWindow -> IO (Ref DoubleWindow) doubleWindowCustom size position title customWidgetFuncs' customWindowFuncs' = windowMaker 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 @@ -678,7 +678,7 @@ {# fun Fl_get_font_sizes as getFontSizes { cFromFont `Font', alloca- `Int' peekIntConv* } -> `Int' #} {# fun Fl_set_font_by_string as setFontByString - { cFromFont `Font',`String' } -> `()' supressWarningAboutRes #} + { cFromFont `Font', unsafeToCString `String' } -> `()' supressWarningAboutRes #} {# fun Fl_set_font_by_font as setFontByFont { cFromFont `Font',cFromFont `Font' } -> `()' supressWarningAboutRes #} {# fun Fl_set_fonts as setFonts 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 @@ -91,6 +91,7 @@ module Graphics.UI.FLTK.LowLevel.TextBuffer, module Graphics.UI.FLTK.LowLevel.TextDisplay, module Graphics.UI.FLTK.LowLevel.TextEditor, + module Graphics.UI.FLTK.LowLevel.NativeFileChooser, -- * Machinery for static dispatch module Graphics.UI.FLTK.LowLevel.Dispatch, -- * Association of widgets and functions @@ -164,6 +165,7 @@ import Graphics.UI.FLTK.LowLevel.TextBuffer import Graphics.UI.FLTK.LowLevel.TextDisplay import Graphics.UI.FLTK.LowLevel.TextEditor +import Graphics.UI.FLTK.LowLevel.NativeFileChooser -- $Module Documentation -- This module re-exports all the available widgets and their core types. The types and list 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 @@ -16,7 +16,7 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Hierarchy -{# fun Fl_Fill_Dial_New as fillDialNew' { `Int',`Int',`Int',`Int', `String' } -> `Ptr ()' id #} +{# fun Fl_Fill_Dial_New as fillDialNew' { `Int',`Int',`Int',`Int', unsafeToCString `String' } -> `Ptr ()' id #} fillDialNew :: Rectangle -> String -> IO (Ref FillDial) fillDialNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -19,7 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Fill_Slider_New_WithLabel as fillSliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} fillSliderNew :: Rectangle -> Maybe String -> IO (Ref FillSlider) fillSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -29,8 +29,8 @@ {# fun Fl_OverriddenGl_Window_New as overriddenWindowNew' {`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenGl_Window_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenGl_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenGl_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenGl_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenGl_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} glWindowCustom :: Size -> Maybe Position -> Maybe String -> 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# fun Fl_Group_New as groupNew' { `Int',`Int', `Int', `Int'} -> `Ptr ()' id #} -{# fun Fl_Group_New_WithLabel as groupNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Group_New_WithLabel as groupNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} groupNew :: Rectangle -> Maybe String -> IO (Ref Group) groupNew rectangle label' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -707,8 +707,8 @@ setCols, GetCols, getCols, - SetVisibleCells, - setVisibleCells, + GetVisibleCells, + getVisibleCells, IsInteractiveResize, isInteractiveResize, GetRowResize, @@ -1404,7 +1404,41 @@ GetDefaultKeyBindings, getDefaultKeyBindings, ReplaceKeyBindings, - replaceKeyBindings + replaceKeyBindings, + -- * NativeFileChooser + NativeFileChooser, + SetOptions, + setOptions, + GetOptions, + getOptions, + GetFilename, + getFilename, + GetFilenameAt, + getFilenameAt, + SetDirectory, + setDirectory, + GetDirectory, + getDirectory, + SetTitle, + setTitle, + GetTitle, + getTitle, + GetFilter, + getFilter, + SetFilter, + setFilter, + Filters, + filters, + SetFilterValue, + setFilterValue, + GetFilterValue, + getFilterValue, + SetPresetFile, + setPresetFile, + GetPresetFile, + getPresetFile, + GetErrmsg, + getErrmsg ) where import Prelude hiding (round) @@ -2588,7 +2622,6 @@ (Destroy (GetMenu (SetMenu - (Add (Insert (Remove (Replace @@ -2599,7 +2632,7 @@ (GetMode (SetShortcut (Handle - ())))))))))))))) + ()))))))))))))) instance Functions SysMenuBar SysMenuBarFuncs data CChoice parent @@ -3152,7 +3185,7 @@ (GetRows (SetCols (GetCols - (SetVisibleCells + (GetVisibleCells (IsInteractiveResize (GetRowResize (SetRowResize @@ -3239,9 +3272,9 @@ data GetCols a getCols :: (FindOp a (GetCols ()) (Match r), Op (GetCols ()) r a impl) => Ref a -> impl getCols = dispatch (undefined :: GetCols ()) -data SetVisibleCells a -setVisibleCells :: (FindOp a (SetVisibleCells ()) (Match r), Op (SetVisibleCells ()) r a impl) => Ref a -> impl -setVisibleCells = dispatch (undefined :: SetVisibleCells ()) +data GetVisibleCells a +getVisibleCells :: (FindOp a (GetVisibleCells ()) (Match r), Op (GetVisibleCells ()) r a impl) => Ref a -> impl +getVisibleCells = dispatch (undefined :: GetVisibleCells ()) data IsInteractiveResize a isInteractiveResize :: (FindOp a (IsInteractiveResize ()) (Match r), Op (IsInteractiveResize ()) r a impl) => Ref a -> impl isInteractiveResize = dispatch (undefined :: IsInteractiveResize ()) @@ -4824,3 +4857,79 @@ data ReplaceKeyBindings a replaceKeyBindings :: (FindOp a (ReplaceKeyBindings ()) (Match r), Op (ReplaceKeyBindings ()) r a impl) => Ref a -> impl replaceKeyBindings = dispatch (undefined :: ReplaceKeyBindings ()) + +data CNativeFileChooser parent +type NativeFileChooser = CNativeFileChooser Base +type NativeFileChooserFuncs = + (Destroy + (SetType + (GetType + (SetOptions + (GetOptions + (GetCount + (GetFilename + (GetFilenameAt + (SetDirectory + (GetDirectory + (SetTitle + (GetTitle + (GetFilter + (SetFilter + (Filters + (SetFilterValue + (GetFilterValue + (SetPresetFile + (GetPresetFile + (GetErrmsg + (ShowWidget + ()))))))))))))))))))))) +instance Functions NativeFileChooser NativeFileChooserFuncs + +data SetOptions a +setOptions :: (FindOp a (SetOptions ()) (Match r), Op (SetOptions ()) r a impl) => Ref a -> impl +setOptions = dispatch (undefined :: SetOptions ()) +data GetOptions a +getOptions :: (FindOp a (GetOptions ()) (Match r), Op (GetOptions ()) r a impl) => Ref a -> impl +getOptions = dispatch (undefined :: GetOptions ()) +data GetFilename a +getFilename :: (FindOp a (GetFilename ()) (Match r), Op (GetFilename ()) r a impl) => Ref a -> impl +getFilename = dispatch (undefined :: GetFilename ()) +data GetFilenameAt a +getFilenameAt :: (FindOp a (GetFilenameAt ()) (Match r), Op (GetFilenameAt ()) r a impl) => Ref a -> impl +getFilenameAt = dispatch (undefined :: GetFilenameAt ()) +data SetDirectory a +setDirectory :: (FindOp a (SetDirectory ()) (Match r), Op (SetDirectory ()) r a impl) => Ref a -> impl +setDirectory = dispatch (undefined :: SetDirectory ()) +data GetDirectory a +getDirectory :: (FindOp a (GetDirectory ()) (Match r), Op (GetDirectory ()) r a impl) => Ref a -> impl +getDirectory = dispatch (undefined :: GetDirectory ()) +data SetTitle a +setTitle :: (FindOp a (SetTitle ()) (Match r), Op (SetTitle ()) r a impl) => Ref a -> impl +setTitle = dispatch (undefined :: SetTitle ()) +data GetTitle a +getTitle :: (FindOp a (GetTitle ()) (Match r), Op (GetTitle ()) r a impl) => Ref a -> impl +getTitle = dispatch (undefined :: GetTitle ()) +data GetFilter a +getFilter :: (FindOp a (GetFilter ()) (Match r), Op (GetFilter ()) r a impl) => Ref a -> impl +getFilter = dispatch (undefined :: GetFilter ()) +data SetFilter a +setFilter :: (FindOp a (SetFilter ()) (Match r), Op (SetFilter ()) r a impl) => Ref a -> impl +setFilter = dispatch (undefined :: SetFilter ()) +data Filters a +filters :: (FindOp a (Filters ()) (Match r), Op (Filters ()) r a impl) => Ref a -> impl +filters = dispatch (undefined :: Filters ()) +data SetFilterValue a +setFilterValue :: (FindOp a (SetFilterValue ()) (Match r), Op (SetFilterValue ()) r a impl) => Ref a -> impl +setFilterValue = dispatch (undefined :: SetFilterValue ()) +data GetFilterValue a +getFilterValue :: (FindOp a (GetFilterValue ()) (Match r), Op (GetFilterValue ()) r a impl) => Ref a -> impl +getFilterValue = dispatch (undefined :: GetFilterValue ()) +data SetPresetFile a +setPresetFile :: (FindOp a (SetPresetFile ()) (Match r), Op (SetPresetFile ()) r a impl) => Ref a -> impl +setPresetFile = dispatch (undefined :: SetPresetFile ()) +data GetPresetFile a +getPresetFile :: (FindOp a (GetPresetFile ()) (Match r), Op (GetPresetFile ()) r a impl) => Ref a -> impl +getPresetFile = dispatch (undefined :: GetPresetFile ()) +data GetErrmsg a +getErrmsg :: (FindOp a (GetErrmsg ()) (Match r), Op (GetErrmsg ()) r a impl) => Ref a -> impl +getErrmsg = dispatch (undefined :: GetErrmsg ()) 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 @@ -19,7 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Hor_Fill_Slider_New_WithLabel as horFillSliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} horFillSliderNew :: Rectangle -> Maybe String -> IO (Ref HorFillSlider) horFillSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -19,7 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Hor_Nice_Slider_New_WithLabel as horNiceSliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} horNiceSliderNew :: Rectangle -> Maybe String -> IO (Ref HorNiceSlider) horNiceSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -19,7 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Hor_Slider_New_WithLabel as horSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} horSliderNew :: Rectangle -> Maybe String -> IO (Ref HorSlider) horSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -19,7 +19,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Hor_Value_Slider_New_WithLabel as horValueSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} horValueSliderNew :: Rectangle -> Maybe String -> IO (Ref HorValueSlider) horValueSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -44,19 +44,19 @@ #endc {#enum FlInputType {}#} {# fun Fl_Input_New as inputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Input_New_WithLabel as inputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Input_New_WithLabel as inputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} {# fun Fl_Multiline_Input_New as multilineInputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Multiline_Input_New_WithLabel as multilineInputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Multiline_Input_New_WithLabel as multilineInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} {# fun Fl_Float_Input_New as floatInputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Float_Input_New_WithLabel as floatInputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Float_Input_New_WithLabel as floatInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Int_Input_New_WithLabel as intInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} {# fun Fl_Secret_Input_New as secretInputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Secret_Input_New_WithLabel as secretInputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Secret_Input_New_WithLabel as secretInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} {# fun Fl_Output_New as outputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Output_New_WithLabel as outputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Output_New_WithLabel as outputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} {# fun Fl_Multiline_Output_New as multilineOutputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Multiline_Output_New_WithLabel as multilineOutputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Multiline_Output_New_WithLabel as multilineOutputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} inputNew :: Maybe FlInputType -> Rectangle -> Maybe String -> IO (Ref Input) inputNew flInputType rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -90,15 +90,15 @@ FlSecretInput -> secretInputHandle' p (fromIntegral . fromEnum $ event) _ -> inputHandle' p (fromIntegral . fromEnum $ event) ) -{# fun unsafe Fl_Input_set_value as setValue' { id `Ptr ()',`String' } -> `Int' #} -{# fun unsafe Fl_Input_set_value_with_length as setValueWithLength' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Input_set_value as setValue' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} +{# fun unsafe Fl_Input_set_value_with_length as setValueWithLength' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance (impl ~ (String -> 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 -{# fun unsafe Fl_Input_static_value as staticValue' { id `Ptr ()',`String' } -> `Int' #} -{# fun unsafe Fl_Input_static_value_with_length as staticValueWithLength' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Input_static_value as staticValue' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} +{# fun unsafe Fl_Input_static_value_with_length as staticValueWithLength' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance (impl ~ (String -> Maybe Int -> IO (Either NoChange ()))) => Op (StaticValue ()) Input orig impl where runOp _ _ input text l'= do status' <- case l' of @@ -140,7 +140,7 @@ {# fun unsafe Fl_Input_set_mark as setMark' { id `Ptr ()',`Int' } -> `Int' #} instance (impl ~ (Int -> IO (Either NoChange ()))) => Op (SetMark ()) Input orig impl where runOp _ _ input m = withRef input $ \inputPtr -> setMark' inputPtr m >>= return . successOrNoChange -{# fun unsafe Fl_Input_replace as replace' { id `Ptr ()',`Int',`Int',`String' } -> `Int' #} +{# fun unsafe Fl_Input_replace as replace' { id `Ptr ()',`Int',`Int', unsafeToCString `String' } -> `Int' #} instance (impl ~ (Int -> Int -> String -> IO (Either NoChange ()))) => Op (Replace ()) Input orig impl where runOp _ _ input b e text = withRef input $ \inputPtr -> replace' inputPtr b e text >>= return . successOrNoChange {# fun unsafe Fl_Input_cut as cut' { id `Ptr ()' } -> `Int' #} @@ -152,10 +152,10 @@ {# fun unsafe 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 -{# fun unsafe Fl_Input_insert as insert' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Input_insert as insert' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} instance (impl ~ (String -> IO (Either NoChange ()))) => Op (Insert ()) Input orig impl where runOp _ _ input t = withRef input $ \inputPtr -> insert' inputPtr t >>= return . successOrNoChange -{# fun unsafe Fl_Input_insert_with_length as insertWithLength' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Input_insert_with_length as insertWithLength' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance (impl ~ (String -> Int -> IO (Either NoChange ()))) => Op (InsertWithLength ()) Input orig impl where runOp _ _ input t l = withRef input $ \inputPtr -> insertWithLength' inputPtr t l >>= return . successOrNoChange {# fun unsafe Fl_Input_copy as copy' { id `Ptr ()',`Int' } -> `Int' #} diff --git a/src/Graphics/UI/FLTK/LowLevel/IntInput.chs b/src/Graphics/UI/FLTK/LowLevel/IntInput.chs --- a/src/Graphics/UI/FLTK/LowLevel/IntInput.chs +++ b/src/Graphics/UI/FLTK/LowLevel/IntInput.chs @@ -6,10 +6,6 @@ -- * Hierarchy -- -- $hierarchy - - -- * Functions - -- - -- $functions ) where #include "Fl_ExportMacros.h" @@ -22,7 +18,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Int_Input_New_WithLabel as intInputNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} intInputNew :: Rectangle -> Maybe String -> IO (Ref IntInput) intInputNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -31,11 +27,6 @@ toRef Just l -> intInputNewWithLabel' x_pos y_pos width height l >>= toRef --- $functions --- @ --- - --- @ -- $hierarchy -- @ 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 @@ -24,7 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Light_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Light_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Light_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} lightButtonNew :: Rectangle -> Maybe String -> IO (Ref LightButton) lightButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -5,10 +5,6 @@ -- * Hierarchy -- -- $hierarchy - - -- * Functions - -- - -- $functions ) where #include "Fl_ExportMacros.h" @@ -21,7 +17,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Line_Dial_New_WithLabel as lineDialNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} lineDialNew :: Rectangle -> Maybe String -> IO (Ref LineDial) lineDialNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -30,11 +26,6 @@ toRef Just l -> lineDialNewWithLabel' x_pos y_pos width height l >>= toRef --- $functions --- @ --- - --- @ -- $hierarchy -- @ 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 @@ -26,7 +26,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# fun Fl_Menu_Button_New as menuButtonNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Menu_Button_New_WithLabel as menuButtonNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Menu_Button_New_WithLabel as menuButtonNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} menuButtonNew :: Rectangle -> Maybe String -> IO (Ref MenuButton) menuButtonNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -8,6 +8,11 @@ MenuItemPointer(..), MenuItemReference(..), MenuItemLocator(..) + -- * Hierarchy + -- + -- $hierarchy + -- + -- * Functions -- -- $functions @@ -54,11 +59,11 @@ instance (impl ~ IO (String)) => Op (GetLabel ()) MenuItem orig impl where runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> label' menu_itemPtr -{# fun unsafe Fl_Menu_Item_set_label as setLabel' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Menu_Item_set_label as setLabel' { id `Ptr ()', unsafeToCString `String' } -> `()' #} instance (impl ~ (String -> IO ())) => Op (SetLabel ()) MenuItem orig impl where runOp _ _ menu_item a = withRef menu_item $ \menu_itemPtr -> setLabel' menu_itemPtr a -{# fun unsafe Fl_Menu_Item_set_label_with_labeltype as setLabelWithLabeltype' { id `Ptr ()',cFromEnum `Labeltype',`String' } -> `()' #} +{# fun unsafe Fl_Menu_Item_set_label_with_labeltype as setLabelWithLabeltype' { id `Ptr ()',cFromEnum `Labeltype', unsafeToCString `String' } -> `()' #} instance (impl ~ (Labeltype -> String -> IO ())) => Op (SetLabelWithLabeltype ()) MenuItem orig impl where runOp _ _ menu_item labeltype b = withRef menu_item $ \menu_itemPtr -> setLabelWithLabeltype' menu_itemPtr labeltype b @@ -229,9 +234,9 @@ instance (impl ~ (Ref Widget -> IO ())) => Op (DoCallback ()) MenuItem orig impl where runOp _ _ menu_item o = withRef menu_item $ \menu_itemPtr -> withRef o $ \oPtr -> doCallback' menu_itemPtr oPtr -{# fun Fl_Menu_Item_insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',`String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} -{# fun Fl_Menu_Item_add_with_flags as addWithFlags' { id `Ptr ()',`String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} -{# fun Fl_Menu_Item_add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()',`String',`String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} +{# fun Fl_Menu_Item_insert_with_flags as insertWithFlags' { id `Ptr ()',`Int', unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} +{# fun Fl_Menu_Item_add_with_flags as addWithFlags' { id `Ptr ()', unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} +{# fun Fl_Menu_Item_add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} instance (Parent a MenuItem, impl ~ (String -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) MenuItem orig impl where runOp _ _ menu_item name shortcut cb flags = withRef menu_item $ \menu_itemPtr -> do @@ -283,6 +288,11 @@ {# fun unsafe Fl_Menu_Item_size as size' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (GetSize ()) MenuItem orig impl where runOp _ _ menu_item = withRef menu_item $ \menu_itemPtr -> size' menu_itemPtr + +-- $hierarchy +-- @ +-- "Graphics.UI.FLTK.LowLevel.MenuItem" +-- @ -- $functions -- @ 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 @@ -28,8 +28,8 @@ import qualified Data.ByteString.Char8 as C {# fun Fl_Menu__New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Menu__New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenMenu__New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Menu__New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenMenu__New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenMenu__New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} menu_New :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs MenuPrim) -> IO (Ref MenuPrim) menu_New rectangle l' funcs' = @@ -104,7 +104,7 @@ {# fun unsafe Fl_Menu__picked as picked' { id `Ptr ()',id `Ptr ()' } -> `Ptr ()' id #} instance (Parent a MenuItem, Parent b MenuItem, impl ~ (Ref a -> IO (Ref b))) => Op (Picked ()) MenuPrim orig impl where runOp _ _ menu_ item = withRef menu_ $ \menu_Ptr -> withRef item $ \itemPtr -> picked' menu_Ptr itemPtr >>= toRef -{# fun unsafe Fl_Menu__find_index_with_name as findIndexWithName' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Menu__find_index_with_name as findIndexWithName' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} {# fun unsafe Fl_Menu__find_index_with_item as findIndexWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} instance (impl ~ (MenuItemLocator -> IO (Maybe Int))) => Op (FindIndex ()) MenuPrim orig impl where runOp _ _ menu_ menu_item_referene = @@ -132,8 +132,8 @@ instance (Parent a MenuItem, impl ~ (Ref a-> IO ())) => Op (Copy ()) MenuPrim orig impl where runOp _ _ menu_ m = withRef menu_ $ \menu_Ptr -> withRef m $ \mPtr -> copy' menu_Ptr mPtr -{# fun Fl_Menu__insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',`String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} -{# fun Fl_Menu__insert_with_shortcutname_flags as insertWithShortcutnameFlags' { id `Ptr ()',`Int',`String',`String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} +{# fun Fl_Menu__insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} +{# fun Fl_Menu__insert_with_shortcutname_flags as insertWithShortcutnameFlags' { id `Ptr ()',`Int',unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} instance (Parent a MenuPrim, impl ~ ( Int -> String -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) MenuPrim orig impl where runOp _ _ menu_ index' name shortcut cb flags = withRef menu_ $ \menu_Ptr -> do @@ -168,11 +168,11 @@ (castFunPtr ptr) combinedFlags return (MenuItemIndex idx') -{# fun Fl_Menu__add_with_name as add' { id `Ptr ()',`String'} -> `()' #} +{# fun Fl_Menu__add_with_name as add' { id `Ptr ()',unsafeToCString `String'} -> `()' #} instance (impl ~ (String -> 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 ()',`String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} -{# fun Fl_Menu__add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()',`String',`String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} +{# fun Fl_Menu__add_with_flags as addWithFlags' { id `Ptr ()',unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} +{# fun Fl_Menu__add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} instance (Parent a MenuPrim, impl ~ ( String -> Maybe Shortcut -> (Ref a-> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) MenuPrim orig (impl) where runOp _ _ menu_ name shortcut cb flags = withRef menu_ $ \menu_Ptr -> do @@ -216,7 +216,7 @@ {# fun unsafe 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 ()) -{# fun unsafe Fl_Menu__replace as replace' { id `Ptr ()',`Int',`String' } -> `()' #} +{# fun unsafe Fl_Menu__replace as replace' { id `Ptr ()',`Int', unsafeToCString `String' } -> `()' #} instance (impl ~ (Int -> String -> IO ())) => Op (Replace ()) MenuPrim orig impl where runOp _ _ menu_ index' name = withRef menu_ $ \menu_Ptr -> replace' menu_Ptr index' name {# fun unsafe Fl_Menu__remove as remove' { id `Ptr ()',`Int' } -> `()' #} diff --git a/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs b/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs @@ -0,0 +1,206 @@ +{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Graphics.UI.FLTK.LowLevel.NativeFileChooser + ( + NativeFileChooserType(..), + NativeFileChooserOption(..), + NativeFileChooserUserAction(..), + allNativeFileChooserOptions, + -- * Constructor + nativeFileChooserNew + -- * Hierarchy + -- + -- $hierarchy + + -- * Native_File_Chooser + -- + -- $functions + ) +where +#include "Fl_ExportMacros.h" +#include "Fl_Types.h" +#include "Fl_Native_File_ChooserC.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 + +#c +enum NativeFileChooserType { + BrowseFile = BROWSE_FILE, + BrowseDirectory = BROWSE_DIRECTORY, + BrowseMultiFile = BROWSE_MULTI_FILE, + BrowseMultiDirectory = BROWSE_MULTI_DIRECTORY, + BrowseSaveFile = BROWSE_SAVE_FILE, + BrowseSaveDirectory = BROWSE_SAVE_DIRECTORY +}; + +enum NativeFileChooserOption { + NoOptions = NO_OPTIONS, + SaveasConfirm = SAVEAS_CONFIRM, + NewFolder = NEW_FOLDER, + Preview = PREVIEW, + UseFilterExt = USE_FILTER_EXT +}; +#endc + +{#enum NativeFileChooserType {} deriving (Show, Eq, Ord) #} +{#enum NativeFileChooserOption {} deriving (Show, Eq, Ord) #} + +data NativeFileChooserUserAction = + NativeFileChooserPicked | + NativeFileChooserCancelled | + NativeFileChooserError + +allNativeFileChooserOptions :: [NativeFileChooserOption] +allNativeFileChooserOptions = + [ + NoOptions, + SaveasConfirm, + NewFolder, + Preview, + UseFilterExt + ] + +{# fun unsafe Fl_Native_File_Chooser_New_WithVal as newWithVal' { `Int' } -> `Ptr ()' id #} +{# fun unsafe Fl_Native_File_Chooser_New as new' { } -> `Ptr ()' id #} +nativeFileChooserNew :: Maybe NativeFileChooserType -> IO (Ref NativeFileChooser) +nativeFileChooserNew t = + case t of + (Just t') -> newWithVal' (fromEnum t') >>= toRef + Nothing -> new' >>= toRef + +{# fun Fl_Native_File_Chooser_Destroy as nativeFileChooserDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #} +instance (impl ~ IO ()) => Op (Destroy ()) NativeFileChooser orig impl where + runOp _ _ chooser = swapRef chooser $ \chooserPtr -> do + nativeFileChooserDestroy' chooserPtr + return nullPtr +{# fun unsafe Fl_Native_File_Chooser_set_type as setType' { id `Ptr ()',`Int' } -> `()' #} +instance (impl ~ (NativeFileChooserType -> IO ())) => Op (SetType ()) NativeFileChooser orig impl where + runOp _ _ chooser type'' = withRef chooser $ \chooserPtr -> setType' chooserPtr (fromEnum type'') +{# fun unsafe Fl_Native_File_Chooser_type as type' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (NativeFileChooserType))) => Op (GetType ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> type' chooserPtr >>= return . toEnum +{# fun unsafe Fl_Native_File_Chooser_set_options as setOptions' { id `Ptr ()',`Int' } -> `()' #} +instance (impl ~ ([NativeFileChooserOption] -> IO ())) => Op (SetOptions ()) NativeFileChooser orig impl where + runOp _ _ chooser options = withRef chooser $ \chooserPtr -> setOptions' chooserPtr (combine options) +{# fun unsafe Fl_Native_File_Chooser_options as options' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO ([NativeFileChooserOption]))) => Op (GetOptions ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> do + opts <- options' chooserPtr + if (opts == 0) + then return [] + else return (extract allNativeFileChooserOptions $ fromIntegral opts) +{# fun unsafe Fl_Native_File_Chooser_count as count' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Int))) => Op (GetCount ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> count' chooserPtr +{# fun unsafe Fl_Native_File_Chooser_filename as filename' { id `Ptr ()' } -> `String' #} +instance (impl ~ ( IO (Maybe String))) => Op (GetFilename ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> filename' chooserPtr >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_filename_with_i as filenameWithI' { id `Ptr ()',`Int' } -> `String' #} +instance (impl ~ (Int -> IO (Maybe String))) => Op (GetFilenameAt ()) NativeFileChooser orig impl where + runOp _ _ chooser i = withRef chooser $ \chooserPtr -> filenameWithI' chooserPtr i >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_set_directory as setDirectory' { id `Ptr ()',unsafeToCString `String' } -> `()' #} +instance (impl ~ (String -> IO ())) => Op (SetDirectory ()) NativeFileChooser orig impl where + runOp _ _ chooser val = withRef chooser $ \chooserPtr -> setDirectory' chooserPtr val +{# fun unsafe Fl_Native_File_Chooser_directory as directory' { id `Ptr ()' } -> `String' #} +instance (impl ~ ( IO (Maybe String))) => Op (GetDirectory ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> directory' chooserPtr >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_set_title as setTitle' { id `Ptr ()',unsafeToCString `String' } -> `()' #} +instance (impl ~ (String -> IO ())) => Op (SetTitle ()) NativeFileChooser orig impl where + runOp _ _ chooser title'' = withRef chooser $ \chooserPtr -> setTitle' chooserPtr title'' +{# fun unsafe Fl_Native_File_Chooser_title as title' { id `Ptr ()' } -> `String' #} +instance (impl ~ ( IO (Maybe String))) => Op (GetTitle ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> title' chooserPtr >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_filter as filter' { id `Ptr ()' } -> `String' #} +instance (impl ~ ( IO (Maybe String))) => Op (GetFilter ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> filter' chooserPtr >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_set_filter as setFilter' { id `Ptr ()', unsafeToCString `String' } -> `()' #} +instance (impl ~ (String -> IO ())) => Op (SetFilter ()) NativeFileChooser orig impl where + runOp _ _ chooser filter'' = withRef chooser $ \chooserPtr -> setFilter' chooserPtr filter'' +{# fun unsafe Fl_Native_File_Chooser_filters as filters' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (Int))) => Op (Filters ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> filters' chooserPtr +{# fun unsafe 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 +{# fun unsafe 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 +{# fun unsafe Fl_Native_File_Chooser_set_preset_file as setPresetFile' { id `Ptr ()',unsafeToCString `String' } -> `()' #} +instance (impl ~ (String -> IO ())) => Op (SetPresetFile ()) NativeFileChooser orig impl where + runOp _ _ chooser preset' = withRef chooser $ \chooserPtr -> setPresetFile' chooserPtr preset' +{# fun unsafe Fl_Native_File_Chooser_preset_file as presetFile' { id `Ptr ()' } -> `String' #} +instance (impl ~ ( IO (Maybe String))) => Op (GetPresetFile ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> presetFile' chooserPtr >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_errmsg as errmsg' { id `Ptr ()' } -> `String' #} +instance (impl ~ ( IO (Maybe String))) => Op (GetErrmsg ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> errmsg' chooserPtr >>= \s -> + if (null s) then return Nothing else return (Just s) +{# fun unsafe Fl_Native_File_Chooser_show as show' { id `Ptr ()' } -> `Int' #} +instance (impl ~ ( IO (NativeFileChooserUserAction))) => Op (ShowWidget ()) NativeFileChooser orig impl where + runOp _ _ chooser = withRef chooser $ \chooserPtr -> do + res' <- show' chooserPtr + return $ case res' of + 0 -> NativeFileChooserPicked + 1 -> NativeFileChooserCancelled + (-1) -> NativeFileChooserError + x'' -> error $ "NativeFileChooser::showWidget, unknown option:" ++ (show x'') + +-- $hierarchy +-- @ +-- "Graphics.UI.FLTK.LowLevel.NativeFileChooser" +-- @ + +-- $functions +-- @ +-- destroy :: 'Ref' 'NativeFileChooser' -> 'IO' () +-- +-- filters :: 'Ref' 'NativeFileChooser' -> 'IO' 'Int' +-- +-- getCount :: 'Ref' 'NativeFileChooser' -> 'IO' 'Int' +-- +-- getDirectory :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'String') +-- +-- getErrmsg :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'String') +-- +-- getFilename :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'String') +-- +-- getFilenameAt :: 'Ref' 'NativeFileChooser' -> 'Int' -> 'IO' ('Maybe' 'String') +-- +-- getFilter :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'String') +-- +-- getFilterValue :: 'Ref' 'NativeFileChooser' -> 'IO' 'Int' +-- +-- getOptions :: 'Ref' 'NativeFileChooser' -> 'IO' ['NativeFileChooserOption'] +-- +-- getPresetFile :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'String') +-- +-- getTitle :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'String') +-- +-- getType :: 'Ref' 'NativeFileChooser' -> 'IO' 'NativeFileChooserType' +-- +-- setDirectory :: 'Ref' 'NativeFileChooser' -> 'String' -> 'IO' () +-- +-- setFilter :: 'Ref' 'NativeFileChooser' -> 'String' -> 'IO' () +-- +-- setFilterValue :: 'Ref' 'NativeFileChooser' -> 'Int' -> 'IO' () +-- +-- setOptions :: 'Ref' 'NativeFileChooser' -> ['NativeFileChooserOption'] -> 'IO' () +-- +-- setPresetFile :: 'Ref' 'NativeFileChooser' -> 'String' -> 'IO' () +-- +-- setTitle :: 'Ref' 'NativeFileChooser' -> 'String' -> 'IO' () +-- +-- setType :: 'Ref' 'NativeFileChooser' -> 'NativeFileChooserType' -> 'IO' () +-- +-- showWidget :: 'Ref' 'NativeFileChooser' -> 'IO' 'NativeFileChooserUserAction' +-- @ 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 @@ -22,7 +22,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Nice_Slider_New_WithLabel as niceSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} niceSliderNew :: Rectangle -> Maybe String -> IO (Ref NiceSlider) niceSliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -22,9 +22,9 @@ import Graphics.UI.FLTK.LowLevel.Dispatch import C2HS hiding (cFromEnum, toBool,cToEnum) -{# fun Fl_Overlay_Window_New_WithLabel as windowNewWithLabel' { `Int', `Int', `String', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} +{# fun Fl_Overlay_Window_New_WithLabel as windowNewWithLabel' { `Int', `Int', unsafeToCString `String', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} {# fun Fl_Overlay_Window_New as windowNew' { `Int', `Int', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} -{# fun Fl_Overlay_Window_NewXY_WithLabel as windowNewWithXYLabel' { `Int', `Int', `Int', `Int', `String', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} +{# fun Fl_Overlay_Window_NewXY_WithLabel as windowNewWithXYLabel' { `Int', `Int', `Int', `Int', unsafeToCString `String', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} {# fun Fl_Overlay_Window_NewXY as windowNewWithXY' { `Int', `Int', `Int', `Int', id `FunPtr CallbackPrim' } -> `Ptr ()' id #} overlayWindowNew :: forall a. (Parent a OverlayWindow) => Size -> Maybe String -> Maybe Position -> (Ref a -> IO ()) -> IO (Ref OverlayWindow) 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Positioner_New as positionerNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Positioner_New_WithLabel as positionerNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Positioner_New_WithLabel as positionerNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} positionerNew :: Rectangle -> Maybe String -> IO (Ref Positioner) positionerNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -24,7 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Progress_New as progressNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Progress_New_WithLabel as progressNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Progress_New_WithLabel as progressNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} progressNew :: Rectangle -> Maybe String -> IO (Ref Progress) progressNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -23,7 +23,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Radio_Light_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} radioLightButtonNew :: Rectangle -> Maybe String -> IO (Ref RadioLightButton) radioLightButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Return_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Return_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Return_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} repeatButtonNew :: Rectangle -> Maybe String -> IO (Ref RepeatButton) repeatButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Return_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Return_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Return_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} returnButtonNew :: Rectangle -> Maybe String -> IO (Ref ReturnButton) returnButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Roller_New as rollerNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Roller_New_WithLabel as rollerNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Roller_New_WithLabel as rollerNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} rollerNew :: Rectangle -> Maybe String -> IO (Ref Roller) rollerNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -24,7 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Round_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Round_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Round_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} roundButtonNew :: Rectangle -> Maybe String -> IO (Ref RoundButton) roundButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Scrollbar_New as scrollbarNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Scrollbar_New_WithLabel as scrollbarNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Scrollbar_New_WithLabel as scrollbarNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} scrollbarNew :: Rectangle -> Maybe String -> IO (Ref Scrollbar) scrollbarNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -6,10 +6,6 @@ -- * Hierarchy -- -- $hierarchy - - -- * Functions - -- - -- $functions ) where #include "Fl_ExportMacros.h" @@ -22,7 +18,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Select_Browser_New_WithLabel as selectBrowserNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} selectBrowserNew :: Rectangle -> Maybe String -> IO (Ref SelectBrowser) selectBrowserNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -31,11 +27,6 @@ toRef Just l -> selectBrowserNewWithLabel' x_pos y_pos width height l >>= toRef --- $functions --- @ --- - --- @ -- $hierarchy -- @ diff --git a/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs b/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs --- a/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs +++ b/src/Graphics/UI/FLTK/LowLevel/SimpleCounter.chs @@ -5,10 +5,6 @@ -- * Hierarchy -- -- $hierarchy - - -- * Functions - -- - -- $functions ) where #include "Fl_ExportMacros.h" @@ -21,7 +17,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# 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',`String'} -> `Ptr ()' id #} +{# fun Fl_Simple_Counter_New_WithLabel as simpleCounterNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} simpleCounterNew :: Rectangle -> Maybe String -> IO (Ref SimpleCounter) simpleCounterNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -31,11 +27,6 @@ Just l -> simpleCounterNewWithLabel' x_pos y_pos width height l >>= toRef --- $functions --- @ --- - --- @ -- $hierarchy -- @ 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 @@ -28,8 +28,8 @@ {# fun Fl_OverriddenSingle_Window_New as overriddenWindowNew' {`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenSingle_Window_NewXY as overriddenWindowNewXY' {`Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenSingle_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenSingle_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenSingle_Window_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenSingle_Window_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} singleWindowCustom :: Size -> Maybe Position -> Maybe String -> CustomWidgetFuncs SingleWindow -> CustomWindowFuncs SingleWindow -> IO (Ref SingleWindow) singleWindowCustom size position title customWidgetFuncs' customWindowFuncs' = windowMaker 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 @@ -24,7 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# fun Fl_Slider_New as sliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Slider_New_WithLabel as sliderNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Slider_New_WithLabel as sliderNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} sliderNew :: Rectangle -> Maybe String -> IO (Ref Slider) sliderNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy {# fun Fl_Sys_Menu_Bar_New as sysMenuBarNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Sys_Menu_Bar_New_WithLabel as sysMenuBarNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Sys_Menu_Bar_New_WithLabel as sysMenuBarNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} sysMenuBarNew :: Rectangle -> Maybe String -> IO (Ref SysMenuBar) sysMenuBarNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -45,7 +45,7 @@ {# fun unsafe Fl_Sys_Menu_Bar_remove as remove' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ (Int -> IO ())) => Op (Remove ()) SysMenuBar orig impl where runOp _ _ menu_ index' = withRef menu_ $ \menu_Ptr -> remove' menu_Ptr index' -{# fun unsafe Fl_Sys_Menu_Bar_replace as replace' { id `Ptr ()',`Int',`String' } -> `()' #} +{# fun unsafe Fl_Sys_Menu_Bar_replace as replace' { id `Ptr ()',`Int', unsafeToCString `String' } -> `()' #} instance (impl ~ (Int -> String -> IO ())) => Op (Replace ()) SysMenuBar orig impl where runOp _ _ menu_ index' name = withRef menu_ $ \menu_Ptr -> replace' menu_Ptr index' name {# fun unsafe Fl_Sys_Menu_Bar_clear as clear' { id `Ptr ()' } -> `()' #} 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 @@ -117,7 +117,7 @@ return ptr {# fun unsafe Fl_Table_New as tableNew' { `Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #} -{# fun unsafe Fl_Table_New_WithLabel as tableNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun unsafe Fl_Table_New_WithLabel as tableNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} tableCustom :: Rectangle -> Maybe String -> CustomWidgetFuncs Table -> CustomTableFuncs Table -> IO (Ref Table) tableCustom rectangle label' customWidgetFuncs' customTableFuncs' = do @@ -149,22 +149,22 @@ instance (impl ~ ( IO (Int))) => Op (GetCols ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> cols' tablePtr {# 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 (SetVisibleCells ()) Table orig impl where +instance (impl ~ (IO (TableCoordinate,TableCoordinate))) => Op (GetVisibleCells ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> visibleCells' tablePtr >>= \(r1', r2', c1', c2') -> return ((TableCoordinate (Row r1') (Column c1')), (TableCoordinate (Row r2') (Column c2'))) -{# fun unsafe Fl_Table_is_interactive_resize as isInteractiveResize' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (IsInteractiveResize ()) Table orig impl where +{# fun unsafe Fl_Table_is_interactive_resize as isInteractiveResize' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (IsInteractiveResize ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> isInteractiveResize' tablePtr -{# fun unsafe Fl_Table_row_resize as rowResize' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetRowResize ()) Table orig impl where +{# fun unsafe Fl_Table_row_resize as rowResize' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (GetRowResize ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> rowResize' tablePtr {# fun Fl_Table_set_row_resize as setRowResize' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ ( Bool -> IO ())) => Op (SetRowResize ()) Table orig impl where runOp _ _ table flag = withRef table $ \tablePtr -> setRowResize' tablePtr (cFromBool flag) -{# fun unsafe Fl_Table_col_resize as colResize' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetColResize ()) Table orig impl where +{# fun unsafe Fl_Table_col_resize as colResize' { id `Ptr ()' } -> `Bool' cToBool #} +instance (impl ~ ( IO (Bool))) => Op (GetColResize ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> colResize' tablePtr {# fun Fl_Table_set_col_resize as setColResize' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ ( Bool -> IO ())) => Op (SetColResize ()) Table orig impl where @@ -218,17 +218,17 @@ instance (impl ~ ( IO (Color))) => Op (GetColHeaderColor ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> colHeaderColor' tablePtr {# fun Fl_Table_set_row_height as setRowHeight' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ ( Int -> Int -> IO ())) => Op (SetRowHeight ()) Table orig impl where - runOp _ _ table row height = withRef table $ \tablePtr -> setRowHeight' tablePtr row height +instance (impl ~ ( Row -> Int -> IO ())) => Op (SetRowHeight ()) Table orig impl where + runOp _ _ table (Row row) height = withRef table $ \tablePtr -> setRowHeight' tablePtr row height {# fun unsafe Fl_Table_row_height as rowHeight' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ ( Int -> IO (Int))) => Op (GetRowHeight ()) Table orig impl where - runOp _ _ table row = withRef table $ \tablePtr -> rowHeight' tablePtr row +instance (impl ~ ( Row -> IO (Int))) => Op (GetRowHeight ()) Table orig impl where + runOp _ _ table (Row row) = withRef table $ \tablePtr -> rowHeight' tablePtr row {# fun Fl_Table_set_col_width as setColWidth' { id `Ptr ()',`Int',`Int' } -> `()' #} -instance (impl ~ ( Int -> Int -> IO ())) => Op (SetColWidth ()) Table orig impl where - runOp _ _ table col width = withRef table $ \tablePtr -> setColWidth' tablePtr col width +instance (impl ~ ( Column -> Int -> IO ())) => Op (SetColWidth ()) Table orig impl where + runOp _ _ table (Column col) width = withRef table $ \tablePtr -> setColWidth' tablePtr col width {# fun unsafe Fl_Table_col_width as colWidth' { id `Ptr ()',`Int' } -> `Int' #} -instance (impl ~ ( Int -> IO (Int))) => Op (GetColWidth ()) Table orig impl where - runOp _ _ table col = withRef table $ \tablePtr -> colWidth' tablePtr col +instance (impl ~ ( Column -> IO (Int))) => Op (GetColWidth ()) Table orig impl where + runOp _ _ table (Column col) = withRef table $ \tablePtr -> colWidth' tablePtr col {# fun Fl_Table_set_row_height_all as setRowHeightAll' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ ( Int -> IO ())) => Op (SetRowHeightAll ()) Table orig impl where runOp _ _ table height = withRef table $ \tablePtr -> setRowHeightAll' tablePtr height @@ -236,17 +236,17 @@ instance (impl ~ ( Int -> IO ())) => Op (SetColWidthAll ()) Table orig impl where runOp _ _ table width = withRef table $ \tablePtr -> setColWidthAll' tablePtr width {# fun Fl_Table_set_row_position as setRowPosition' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SetRowPosition ()) Table orig impl where - runOp _ _ table row = withRef table $ \tablePtr -> setRowPosition' tablePtr row +instance (impl ~ ( Row -> IO ())) => Op (SetRowPosition ()) Table orig impl where + runOp _ _ table (Row row) = withRef table $ \tablePtr -> setRowPosition' tablePtr row {# fun Fl_Table_set_col_position as setColPosition' { id `Ptr ()',`Int' } -> `()' #} -instance (impl ~ ( Int -> IO ())) => Op (SetColPosition ()) Table orig impl where - runOp _ _ table col = withRef table $ \tablePtr -> setColPosition' tablePtr col +instance (impl ~ ( Column -> IO ())) => Op (SetColPosition ()) Table orig impl where + runOp _ _ table (Column col) = withRef table $ \tablePtr -> setColPosition' tablePtr col {# fun unsafe Fl_Table_row_position as rowPosition' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetRowPosition ()) Table orig impl where - runOp _ _ table = withRef table $ \tablePtr -> rowPosition' tablePtr +instance (impl ~ ( IO (Row))) => Op (GetRowPosition ()) Table orig impl where + runOp _ _ table = withRef table $ \tablePtr -> rowPosition' tablePtr >>= return . Row {# fun unsafe Fl_Table_col_position as colPosition' { id `Ptr ()' } -> `Int' #} -instance (impl ~ ( IO (Int))) => Op (GetColPosition ()) Table orig impl where - runOp _ _ table = withRef table $ \tablePtr -> colPosition' tablePtr +instance (impl ~ ( IO (Column))) => Op (GetColPosition ()) Table orig impl where + runOp _ _ table = withRef table $ \tablePtr -> colPosition' tablePtr >>= return . Column {# fun Fl_Table_set_top_row as setTopRow' { id `Ptr ()',`Int' } -> `()' #} instance (impl ~ ( Row -> IO ())) => Op (SetTopRow ()) Table orig impl where runOp _ _ table (Row row) = withRef table $ \tablePtr -> setTopRow' tablePtr row @@ -266,8 +266,8 @@ 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 {# fun unsafe Fl_Table_move_cursor as moveCursor' { id `Ptr ()',`Int',`Int' } -> `Int' #} -instance (impl ~ ( Int -> Int -> IO (Int))) => Op (MoveCursor ()) Table orig impl where - runOp _ _ table r c = withRef table $ \tablePtr -> moveCursor' tablePtr r c +instance (impl ~ ( TableCoordinate -> IO (Int))) => Op (MoveCursor ()) Table orig impl where + runOp _ _ table (TableCoordinate (Row r) (Column c)) = withRef table $ \tablePtr -> moveCursor' tablePtr r c {# fun unsafe Fl_Table_init_sizes as initSizes' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (InitSizes ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> initSizes' tablePtr @@ -311,8 +311,8 @@ instance (impl ~ ( IO (TableContext))) => Op (CallbackContext ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> callbackContext' tablePtr {# fun unsafe Fl_Table_do_callback as doCallback' { id `Ptr ()',cFromEnum `TableContext',`Int',`Int' } -> `()' #} -instance (impl ~ ( TableContext -> Int -> Int -> IO ())) => Op (DoCallback ()) Table orig impl where - runOp _ _ table tablecontext row col = withRef table $ \tablePtr -> doCallback' tablePtr tablecontext row col +instance (impl ~ ( TableContext -> TableCoordinate -> IO ())) => Op (DoCallback ()) Table orig impl where + runOp _ _ table tablecontext (TableCoordinate (Row row) (Column col)) = withRef table $ \tablePtr -> doCallback' tablePtr tablecontext row col {# fun unsafe Fl_Table_find_cell as findCell' { id `Ptr ()',cFromEnum `TableContext',`Int',`Int',alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv*,alloca- `Int' peekIntConv* } -> `CInt' id #} instance (impl ~ ( TableContext -> TableCoordinate -> IO (Maybe Rectangle))) => Op (FindCell ()) Table orig impl where runOp _ _ table context (TableCoordinate (Row r) (Column c)) = @@ -339,7 +339,7 @@ {# fun unsafe Fl_Table_clear_super as clearSuper' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ())) => Op (ClearSuper ()) Table orig impl where runOp _ _ table = withRef table $ \tablePtr -> clearSuper' tablePtr -{# fun unsafe Fl_Table_clear as clear' { id `Ptr ()' } -> `()' #} +{# fun Fl_Table_clear as clear' { id `Ptr ()' } -> `()' #} 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' } -> `()' #} @@ -363,7 +363,6 @@ -- $Tablefunctions -- @ --- -- add:: ('Parent' a 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'IO' ()) -- -- begin :: 'Ref' 'Table' -> 'IO' () @@ -382,7 +381,7 @@ -- -- destroy :: 'Ref' 'Table' -> 'IO' () -- --- doCallback :: 'Ref' 'Table' -> 'TableContext' -> 'Int' -> 'Int' -> 'IO' () +-- doCallback :: 'Ref' 'Table' -> 'TableContext' -> 'TableCoordinate' -> 'IO' () -- -- draw :: 'Ref' 'Table' -> 'IO' () -- @@ -404,13 +403,13 @@ -- -- getColHeaderHeight :: 'Ref' 'Table' -> 'IO' 'Int' -- --- getColPosition :: 'Ref' 'Table' -> 'IO' 'Int' +-- getColPosition :: 'Ref' 'Table' -> 'IO' 'Column' -- --- getColResize :: 'Ref' 'Table' -> 'IO' 'Int' +-- getColResize :: 'Ref' 'Table' -> 'IO' 'Bool' -- -- getColResizeMin :: 'Ref' 'Table' -> 'IO' 'Int' -- --- getColWidth :: 'Ref' 'Table' -> 'Int' -> 'IO' 'Int' +-- getColWidth :: 'Ref' 'Table' -> 'Column' -> 'IO' 'Int' -- -- getCols :: 'Ref' 'Table' -> 'IO' 'Int' -- @@ -420,11 +419,11 @@ -- -- getRowHeaderWidth :: 'Ref' 'Table' -> 'IO' 'Int' -- --- getRowHeight :: 'Ref' 'Table' -> 'Int' -> 'IO' 'Int' +-- getRowHeight :: 'Ref' 'Table' -> 'Row' -> 'IO' 'Int' -- --- getRowPosition :: 'Ref' 'Table' -> 'IO' 'Int' +-- getRowPosition :: 'Ref' 'Table' -> 'IO' 'Row' -- --- getRowResize :: 'Ref' 'Table' -> 'IO' 'Int' +-- getRowResize :: 'Ref' 'Table' -> 'IO' 'Bool' -- -- getRowResizeMin :: 'Ref' 'Table' -> 'IO' 'Int' -- @@ -436,6 +435,8 @@ -- -- getTopRow :: 'Ref' 'Table' -> 'IO' 'Row' -- +-- getVisibleCells :: 'Ref' 'Table' -> 'IO' ('TableCoordinate', 'TableCoordinate') +-- -- handle :: 'Ref' 'Table' -> 'Event' -> 'IO' 'Int' -- -- hide :: 'Ref' 'Table' -> 'IO' () @@ -448,11 +449,11 @@ -- -- insertWithBefore:: ('Parent' a 'Widget', 'Parent' b 'Widget') => 'Ref' 'Table' -> 'Ref' a -> 'Ref' b -> 'IO' ()) -- --- isInteractiveResize :: 'Ref' 'Table' -> 'IO' 'Int' +-- isInteractiveResize :: 'Ref' 'Table' -> 'IO' 'Bool' -- -- isSelected :: 'Ref' 'Table' -> 'TableCoordinate' -> 'IO' 'Bool' -- --- moveCursor :: 'Ref' 'Table' -> 'Int' -> 'Int' -> 'IO' 'Int' +-- moveCursor :: 'Ref' 'Table' -> 'TableCoordinate' -> 'IO' 'Int' -- -- resize :: 'Ref' 'Table' -> 'Rectangle' -> 'IO' () -- @@ -464,13 +465,13 @@ -- -- setColHeaderHeight :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- --- setColPosition :: 'Ref' 'Table' -> 'Int' -> 'IO' () +-- setColPosition :: 'Ref' 'Table' -> 'Column' -> 'IO' () -- -- setColResize :: 'Ref' 'Table' -> 'Bool' -> 'IO' () -- -- setColResizeMin :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- --- setColWidth :: 'Ref' 'Table' -> 'Int' -> 'Int' -> 'IO' () +-- setColWidth :: 'Ref' 'Table' -> 'Column' -> 'Int' -> 'IO' () -- -- setColWidthAll :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- @@ -484,11 +485,11 @@ -- -- setRowHeaderWidth :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- --- setRowHeight :: 'Ref' 'Table' -> 'Int' -> 'Int' -> 'IO' () +-- setRowHeight :: 'Ref' 'Table' -> 'Row' -> 'Int' -> 'IO' () -- -- setRowHeightAll :: 'Ref' 'Table' -> 'Int' -> 'IO' () -- --- setRowPosition :: 'Ref' 'Table' -> 'Int' -> 'IO' () +-- setRowPosition :: 'Ref' 'Table' -> 'Row' -> 'IO' () -- -- setRowResize :: 'Ref' 'Table' -> 'Bool' -> 'IO' () -- @@ -504,12 +505,9 @@ -- -- setTopRow :: 'Ref' 'Table' -> 'Row' -> 'IO' () -- --- setVisibleCells :: 'Ref' 'Table' -> 'IO' ('TableCoordinate', 'TableCoordinate') --- -- 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 @@ -29,7 +29,7 @@ data TableRowSelectFlag = TableRowSelect | TableRowDeselect | TableRowToggle {# fun unsafe Fl_OverriddenTable_Row_New as tableRowNew' { `Int',`Int', `Int', `Int', id `Ptr ()'} -> `Ptr ()' id #} -{# fun unsafe Fl_OverriddenTable_Row_New_WithLabel as tableRowNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun unsafe Fl_OverriddenTable_Row_New_WithLabel as tableRowNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} tableRowNew :: Rectangle -> Maybe String -> CustomWidgetFuncs TableRow -> CustomTableFuncs TableRow -> IO (Ref TableRow) tableRowNew rectangle label' customWidgetFuncs' customTableFuncs' = do 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 @@ -51,7 +51,7 @@ {# fun unsafe Fl_Text_Buffer_text as text' { id `Ptr ()' } -> `String' #} instance ( impl ~ ( IO (String))) => Op (GetText ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> text' text_bufferPtr -{# fun unsafe Fl_Text_Buffer_set_text as setText' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Text_Buffer_set_text as setText' { id `Ptr ()', unsafeToCString `String' } -> `()' #} instance ( impl ~ ( String -> IO ())) => Op (SetText ()) TextBuffer orig impl where runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> setText' text_bufferPtr text {# fun unsafe Fl_Text_Buffer_text_range as textRange' { id `Ptr ()',`Int',`Int' } -> `String' #} @@ -63,16 +63,16 @@ {# fun unsafe 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 -{# fun unsafe Fl_Text_Buffer_insert as insert' { id `Ptr ()',`Int',`String' } -> `()' #} +{# fun unsafe Fl_Text_Buffer_insert as insert' { id `Ptr ()',`Int', unsafeToCString `String' } -> `()' #} instance ( impl ~ ( BufferOffset -> String -> IO ())) => Op (Insert ()) TextBuffer orig impl where runOp _ _ text_buffer (BufferOffset pos) text = withRef text_buffer $ \text_bufferPtr -> insert' text_bufferPtr pos text -{# fun unsafe Fl_Text_Buffer_append as append' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Text_Buffer_append as append' { id `Ptr ()', unsafeToCString `String' } -> `()' #} instance ( impl ~ ( String -> IO ())) => Op (AppendToBuffer ()) TextBuffer orig impl where runOp _ _ text_buffer t = withRef text_buffer $ \text_bufferPtr -> append' text_bufferPtr t {# fun unsafe 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' -{# fun unsafe Fl_Text_Buffer_replace as replace' { id `Ptr ()',`Int',`Int',`String' } -> `()' #} +{# fun unsafe Fl_Text_Buffer_replace as replace' { id `Ptr ()',`Int',`Int', unsafeToCString `String' } -> `()' #} instance ( impl ~ ( BufferRange -> String -> 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 {# fun unsafe Fl_Text_Buffer_copy as copy' { id `Ptr ()',id `Ptr ()',`Int',`Int',`Int' } -> `()' #} @@ -91,53 +91,53 @@ instance ( impl ~ (Bool -> IO ())) => Op (CanUndo ()) TextBuffer orig impl where runOp _ _ text_buffer flag = withRef text_buffer $ \text_bufferPtr -> canUndoWithFlag' text_bufferPtr flag -{# fun unsafe Fl_Text_Buffer_insertfile as insertfile' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_insertfile as insertfile' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance ( impl ~ ( String -> BufferOffset -> IO (Either DataProcessingError ()))) => Op (Insertfile ()) TextBuffer orig impl where runOp _ _ text_buffer file (BufferOffset pos) = withRef text_buffer $ \text_bufferPtr -> insertfile' text_bufferPtr file pos >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_insertfile_with_buflen as insertfileWithBuflen' { id `Ptr ()',`String',`Int',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_insertfile_with_buflen as insertfileWithBuflen' { id `Ptr ()', unsafeToCString `String',`Int',`Int' } -> `Int' #} instance ( impl ~ ( String -> BufferOffset -> Int -> IO (Either DataProcessingError ()))) => Op (InsertfileWithBuflen ()) TextBuffer orig impl where runOp _ _ text_buffer file (BufferOffset pos) buflen = withRef text_buffer $ \text_bufferPtr -> insertfileWithBuflen' text_bufferPtr file pos buflen >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_appendfile as appendfile' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_appendfile as appendfile' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} instance ( impl ~ ( String -> IO (Either DataProcessingError ()))) => Op (Appendfile ()) TextBuffer orig impl where runOp _ _ text_buffer file = withRef text_buffer $ \text_bufferPtr -> appendfile' text_bufferPtr file >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_appendfile_with_buflen as appendfileWithBuflen' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_appendfile_with_buflen as appendfileWithBuflen' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance ( impl ~ ( String -> Int -> IO (Either DataProcessingError ()))) => Op (AppendfileWithBuflen ()) TextBuffer orig impl where runOp _ _ text_buffer file buflen = withRef text_buffer $ \text_bufferPtr -> appendfileWithBuflen' text_bufferPtr file buflen >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_loadfile as loadfile' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_loadfile as loadfile' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} instance ( impl ~ ( String -> IO (Either DataProcessingError ()))) => Op (Loadfile ()) TextBuffer orig impl where runOp _ _ text_buffer file = withRef text_buffer $ \text_bufferPtr -> loadfile' text_bufferPtr file >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_loadfile_with_buflen as loadfileWithBuflen' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_loadfile_with_buflen as loadfileWithBuflen' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance ( impl ~ ( String -> Int -> IO (Either DataProcessingError ()))) => Op (LoadfileWithBuflen ()) TextBuffer orig impl where runOp _ _ text_buffer file buflen = withRef text_buffer $ \text_bufferPtr -> loadfileWithBuflen' text_bufferPtr file buflen >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_outputfile as outputfile' { id `Ptr ()',`String',`Int',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_outputfile as outputfile' { id `Ptr ()', unsafeToCString `String',`Int',`Int' } -> `Int' #} instance ( impl ~ ( String -> BufferRange -> IO (Either DataProcessingError ()))) => Op (Outputfile ()) TextBuffer orig impl where runOp _ _ text_buffer file (BufferRange (BufferOffset start') (BufferOffset end')) = withRef text_buffer $ \text_bufferPtr -> outputfile' text_bufferPtr file start' end' >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_outputfile_with_buflen as outputfileWithBuflen' { id `Ptr ()',`String',`Int',`Int',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_outputfile_with_buflen as outputfileWithBuflen' { id `Ptr ()', unsafeToCString `String',`Int',`Int',`Int' } -> `Int' #} instance ( impl ~ ( String -> BufferRange -> Int -> IO (Either DataProcessingError ()))) => Op (OutputfileWithBuflen ()) TextBuffer orig impl where runOp _ _ text_buffer file (BufferRange (BufferOffset start') (BufferOffset end')) buflen = withRef text_buffer $ \text_bufferPtr -> outputfileWithBuflen' text_bufferPtr file start' end' buflen >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_savefile as savefile' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_savefile as savefile' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} instance ( impl ~ ( String -> IO (Either DataProcessingError ()))) => Op (Savefile ()) TextBuffer orig impl where runOp _ _ text_buffer file = withRef text_buffer $ \text_bufferPtr -> savefile' text_bufferPtr file >>= return . successOrDataProcessingError -{# fun unsafe Fl_Text_Buffer_savefile_with_buflen as savefileWithBuflen' { id `Ptr ()',`String',`Int' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_savefile_with_buflen as savefileWithBuflen' { id `Ptr ()', unsafeToCString `String',`Int' } -> `Int' #} instance ( impl ~ ( String -> Int -> IO (Either DataProcessingError ()))) => Op (SavefileWithBuflen ()) TextBuffer orig impl where runOp _ _ text_buffer file buflen = withRef text_buffer $ \text_bufferPtr -> @@ -169,7 +169,7 @@ {# fun unsafe Fl_Text_Buffer_remove_selection as removeSelection' { id `Ptr ()' } -> `()' #} instance ( impl ~ ( IO ())) => Op (RemoveSelection ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> removeSelection' text_bufferPtr -{# fun unsafe Fl_Text_Buffer_replace_selection as replaceSelection' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Text_Buffer_replace_selection as replaceSelection' { id `Ptr ()', unsafeToCString `String' } -> `()' #} instance ( impl ~ ( String -> IO ())) => Op (ReplaceSelection ()) TextBuffer orig impl where runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> replaceSelection' text_bufferPtr text {# fun unsafe Fl_Text_Buffer_secondary_select as secondarySelect' { id `Ptr ()',`Int',`Int' } -> `()' #} @@ -193,7 +193,7 @@ {# fun unsafe Fl_Text_Buffer_remove_secondary_selection as removeSecondarySelection' { id `Ptr ()' } -> `()' #} instance ( impl ~ ( IO ())) => Op (RemoveSecondarySelection ()) TextBuffer orig impl where runOp _ _ text_buffer = withRef text_buffer $ \text_bufferPtr -> removeSecondarySelection' text_bufferPtr -{# fun unsafe Fl_Text_Buffer_replace_secondary_selection as replaceSecondarySelection' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Text_Buffer_replace_secondary_selection as replaceSecondarySelection' { id `Ptr ()', unsafeToCString `String' } -> `()' #} instance ( impl ~ ( String -> IO ())) => Op (ReplaceSecondarySelection ()) TextBuffer orig impl where runOp _ _ text_buffer text = withRef text_buffer $ \text_bufferPtr -> replaceSecondarySelection' text_bufferPtr text {# fun unsafe Fl_Text_Buffer_set_highlight as setHighlight' { id `Ptr ()',`Int',`Int' } -> `()' #} @@ -305,7 +305,7 @@ if (status' == 0) then return (Left NotFound) else peekIntConv intPtr >>= return . Right . BufferOffset -{# fun unsafe Fl_Text_Buffer_search_forward_with_matchcase as searchForwardWithMatchcase' { id `Ptr ()',`Int',`String',id `Ptr CInt', cFromBool `Bool' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_search_forward_with_matchcase as searchForwardWithMatchcase' { id `Ptr ()',`Int', unsafeToCString `String',id `Ptr CInt', cFromBool `Bool' } -> `Int' #} instance ( impl ~ (BufferOffset -> String -> Bool -> IO (Either NotFound BufferOffset))) => Op (SearchForwardWithMatchcase ()) TextBuffer orig impl where runOp _ _ text_buffer (BufferOffset startpos) searchstring matchcase = withRef text_buffer $ \text_bufferPtr -> @@ -314,7 +314,7 @@ if (status' == 0) then return (Left NotFound) else peekIntConv intPtr >>= return . Right . BufferOffset -{# fun unsafe Fl_Text_Buffer_search_backward_with_matchcase as searchBackwardWithMatchcase' { id `Ptr ()',`Int',`String',id `Ptr CInt', cFromBool `Bool' } -> `Int' #} +{# fun unsafe Fl_Text_Buffer_search_backward_with_matchcase as searchBackwardWithMatchcase' { id `Ptr ()',`Int', unsafeToCString `String',id `Ptr CInt', cFromBool `Bool' } -> `Int' #} instance ( impl ~ (BufferOffset -> String -> Bool -> IO (Either NotFound BufferOffset))) => Op (SearchBackwardWithMatchcase ()) TextBuffer orig impl where runOp _ _ text_buffer (BufferOffset startpos) searchstring matchcase = withRef text_buffer $ \text_bufferPtr -> 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 @@ -52,7 +52,7 @@ indexStyleTableEntries = zip ['A'..] {# fun Fl_Text_Display_New as textDisplayNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Text_Display_New_WithLabel as textDisplayNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Text_Display_New_WithLabel as textDisplayNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} textDisplayNew :: Rectangle -> Maybe String -> IO (Ref TextDisplay) textDisplayNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -86,7 +86,7 @@ {# fun unsafe 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 -{# fun unsafe Fl_Text_Display_overstrike as overstrike' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Text_Display_overstrike as overstrike' { id `Ptr ()',unsafeToCString `String' } -> `()' #} instance (impl ~ (String -> IO ())) => Op (Overstrike ()) TextDisplay orig impl where runOp _ _ text_display text = withRef text_display $ \text_displayPtr -> overstrike' text_displayPtr text {# fun unsafe Fl_Text_Display_set_insert_position as setInsertPosition' { id `Ptr ()',`Int' } -> `()' #} @@ -265,7 +265,7 @@ {# fun unsafe linenumber_align as linenumberAlign' { id `Ptr ()' } -> `AlignType' cToEnum #} instance (impl ~ ( IO (AlignType))) => Op (GetLinenumberAlign ()) TextDisplay orig impl where runOp _ _ text_display = withRef text_display $ \text_displayPtr -> linenumberAlign' text_displayPtr -{# fun unsafe set_linenumber_format as setLinenumberFormat' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe set_linenumber_format as setLinenumberFormat' { id `Ptr ()',unsafeToCString `String' } -> `()' #} instance (impl ~ (String -> IO ())) => Op (SetLinenumberFormat ()) TextDisplay orig impl where runOp _ _ text_display val = withRef text_display $ \text_displayPtr -> setLinenumberFormat' text_displayPtr val {# fun unsafe linenumber_format as linenumberFormat' { id `Ptr ()' } -> `String' #} 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 @@ -104,7 +104,7 @@ go (accum ++ [currKb]) next' {# fun Fl_Text_Editor_New as textEditorNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Text_Editor_New_WithLabel as textEditorNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Text_Editor_New_WithLabel as textEditorNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} textEditorNew :: Rectangle -> Maybe String -> IO (Ref TextEditor) textEditorNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle diff --git a/src/Graphics/UI/FLTK/LowLevel/Timer.chs b/src/Graphics/UI/FLTK/LowLevel/Timer.chs --- a/src/Graphics/UI/FLTK/LowLevel/Timer.chs +++ b/src/Graphics/UI/FLTK/LowLevel/Timer.chs @@ -26,19 +26,19 @@ import Graphics.UI.FLTK.LowLevel.Hierarchy import Graphics.UI.FLTK.LowLevel.Dispatch -{# fun Fl_Timer_New as timerNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Timer_New as timerNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} timerNew :: Rectangle -> String -> IO (Ref Timer) timerNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle in timerNewWithLabel' x_pos y_pos width height l' >>= toRef -{# fun Fl_Value_Timer_New as valueTimerNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Value_Timer_New as valueTimerNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} valueTimerNew :: Rectangle -> String -> IO (Ref ValueTimer) valueTimerNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle in valueTimerNewWithLabel' x_pos y_pos width height l' >>= toRef -{# fun Fl_Hidden_Timer_New as hiddenTimerNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Hidden_Timer_New as hiddenTimerNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} hiddenTimerNew :: Rectangle -> String -> IO (Ref HiddenTimer) hiddenTimerNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -24,7 +24,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Toggle_Button_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Toggle_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Toggle_Button_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} toggleButtonNew :: Rectangle -> Maybe String -> IO (Ref ToggleButton) toggleButtonNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import qualified Data.ByteString.Char8 as C {# fun Fl_Tree_New as treeNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Tree_New_WithLabel as treeNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Tree_New_WithLabel as treeNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} treeNew :: Rectangle -> Maybe String -> IO (Ref Tree) treeNew rectangle l' = let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -49,14 +49,14 @@ {# fun unsafe Fl_Tree_show_self as showSelf' { id `Ptr ()' } -> `()' #} instance (impl ~ ( IO ()) ) => Op (ShowSelf ()) Tree orig impl where runOp _ _ tree = withRef tree $ \treePtr -> showSelf' treePtr -{# fun unsafe Fl_Tree_root_label as rootLabel' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Tree_root_label as rootLabel' { id `Ptr ()',unsafeToCString `String' } -> `()' #} instance (impl ~ (String -> IO ()) ) => Op (RootLabel ()) Tree orig impl where runOp _ _ tree new_label = withRef tree $ \treePtr -> rootLabel' treePtr new_label {# fun unsafe Fl_Tree_root as root' { id `Ptr ()' } -> `Ptr ()' id #} instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (Root ()) Tree orig impl where runOp _ _ tree = withRef tree $ \treePtr -> root' treePtr >>= toMaybeRef -{# fun unsafe Fl_Tree_add as add' { id `Ptr ()',`String' } -> `Ptr ()' id #} -{# fun unsafe Fl_Tree_add_with_item_name as addWithItemName' { id `Ptr ()',id `Ptr ()',`String' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_add as add' { id `Ptr ()',unsafeToCString `String' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_add_with_item_name as addWithItemName' { id `Ptr ()',id `Ptr ()',unsafeToCString `String' } -> `Ptr ()' id #} instance (impl ~ (String -> IO (Maybe (Ref TreeItem)))) => Op (Add ()) Tree orig impl where runOp _ _ tree path' = withRef tree $ \treePtr -> add' treePtr path' >>= toMaybeRef instance (Parent a TreeItem, impl ~ (String -> Ref a -> IO (Maybe (Ref TreeItem)))) => Op (AddAt ()) Tree orig impl where @@ -64,10 +64,10 @@ withRef tree $ \treePtr -> withRef item' $ \itemPtr -> addWithItemName' treePtr itemPtr path' >>= toMaybeRef -{# fun unsafe Fl_Tree_insert_above as insertAbove' { id `Ptr ()',id `Ptr ()',`String' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_insert_above as insertAbove' { id `Ptr ()',id `Ptr ()',unsafeToCString `String' } -> `Ptr ()' id #} instance (Parent a TreeItem, impl ~ (Ref a -> String -> 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 unsafe Fl_Tree_insert as insert' { id `Ptr ()',id `Ptr ()',`String',`Int' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_insert as insert' { id `Ptr ()',id `Ptr ()',unsafeToCString `String',`Int' } -> `Ptr ()' id #} instance (Parent a TreeItem, impl ~ (Ref a -> String -> 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 {# fun unsafe Fl_Tree_remove as remove' { id `Ptr ()',id `Ptr ()' } -> `Int' #} @@ -81,7 +81,7 @@ {# fun unsafe Fl_Tree_clear_children as clearChildren' { id `Ptr ()',id `Ptr ()' } -> `()' #} instance (Parent a TreeItem, impl ~ (Ref a -> IO ()) ) => Op (ClearChildren ()) Tree orig impl where runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> clearChildren' treePtr itemPtr -{# fun unsafe Fl_Tree_find_item as findItem' { id `Ptr ()',`String' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_find_item as findItem' { id `Ptr ()',unsafeToCString `String' } -> `Ptr ()' id #} instance (impl ~ (String -> IO (Maybe (Ref TreeItem))) ) => Op (FindItem ()) Tree orig impl where runOp _ _ tree path = withRef tree $ \treePtr -> findItem' treePtr path >>= toMaybeRef {# fun unsafe Fl_Tree_item_pathname as itemPathname' { id `Ptr ()', id `Ptr CChar', `Int', id `Ptr ()'} -> `Int' #} @@ -134,8 +134,8 @@ runOp _ _ tree item = withRef tree $ \treePtr -> withRef item $ \itemPtr -> nextSelectedItemWithItem' treePtr itemPtr >>= toMaybeRef {# fun unsafe Fl_Tree_open_with_item as openWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun unsafe Fl_Tree_open_with_item_docallback as openWithItemDocallback' { id `Ptr ()',id `Ptr ()', cFromBool `Bool' } -> `Int' #} -{# fun unsafe Fl_Tree_open_with_path as openWithPath' { id `Ptr ()',`String' } -> `Int' #} -{# fun unsafe Fl_Tree_open_with_path_docallback as openWithPathDocallback' { id `Ptr ()', `String', cFromBool `Bool' } -> `Int' #} +{# fun unsafe Fl_Tree_open_with_path as openWithPath' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} +{# fun unsafe Fl_Tree_open_with_path_docallback as openWithPathDocallback' { id `Ptr ()', unsafeToCString `String', cFromBool `Bool' } -> `Int' #} instance (impl ~ (TreeItemLocator -> IO ()) ) => Op (Open ()) Tree orig impl where runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> @@ -156,8 +156,8 @@ runOp _ _ tree item docallback = withRef tree $ \treePtr -> withRef item $ \itemPtr -> openToggleWithDocallback' treePtr itemPtr docallback {# fun unsafe Fl_Tree_close_with_item as closeWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun unsafe Fl_Tree_close_with_item_docallback as closeWithItemDocallback' { id `Ptr ()',id `Ptr ()', cFromBool `Bool' } -> `Int' #} -{# fun unsafe Fl_Tree_close_with_path as closeWithPath' { id `Ptr ()',`String' } -> `Int' #} -{# fun unsafe Fl_Tree_close_with_path_docallback as closeWithPathDocallback' { id `Ptr ()',`String', cFromBool `Bool' } -> `Int' #} +{# fun unsafe Fl_Tree_close_with_path as closeWithPath' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} +{# fun unsafe Fl_Tree_close_with_path_docallback as closeWithPathDocallback' { id `Ptr ()',unsafeToCString `String', cFromBool `Bool' } -> `Int' #} instance (impl ~ (TreeItemLocator -> IO ()) ) => Op (Close ()) Tree orig impl where runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> @@ -171,7 +171,7 @@ TreeItemPointerLocator (TreeItemPointer itemRef) -> withRef itemRef $ \itemRefPtr -> closeWithItemDocallback' tree_itemPtr itemRefPtr docallback' >> return () TreeItemNameLocator (TreeItemName n') -> closeWithPathDocallback' tree_itemPtr n' docallback' >> return () {# fun unsafe Fl_Tree_is_open_with_item as isOpenWithItem' { id `Ptr ()',id `Ptr ()' } -> `Bool' cToBool #} -{# fun unsafe Fl_Tree_is_open_with_path as isOpenWithPath' { id `Ptr ()',`String' } -> `Bool' cToBool #} +{# fun unsafe Fl_Tree_is_open_with_path as isOpenWithPath' { id `Ptr ()',unsafeToCString `String' } -> `Bool' cToBool #} instance (impl ~ (TreeItemLocator -> IO (Bool)) ) => Op (IsOpen ()) Tree orig impl where runOp _ _ tree locator' = withRef tree $ \treePtr -> case locator' of @@ -179,7 +179,7 @@ TreeItemNameLocator (TreeItemName n') -> isOpenWithPath' treePtr n' {# fun unsafe Fl_Tree_is_close_with_item as isCloseWithItem' { id `Ptr ()',id `Ptr ()' } -> `Bool' cToBool #} -{# fun unsafe Fl_Tree_is_close_with_path as isCloseWithPath' { id `Ptr ()',`String' } -> `Bool' cToBool #} +{# fun unsafe Fl_Tree_is_close_with_path as isCloseWithPath' { id `Ptr ()',unsafeToCString `String' } -> `Bool' cToBool #} instance (impl ~ (TreeItemLocator -> IO (Bool)) ) => Op (IsClose ()) Tree orig impl where runOp _ _ tree locator' = withRef tree $ \treePtr -> case locator' of @@ -187,8 +187,8 @@ TreeItemNameLocator (TreeItemName n') -> isCloseWithPath' treePtr n' {# fun unsafe Fl_Tree_select_with_item as selectWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun unsafe Fl_Tree_select_with_item_docallback as selectWithItemDocallback' { id `Ptr ()',id `Ptr ()',cFromBool `Bool' } -> `Int' #} -{# fun unsafe Fl_Tree_select_with_path as selectWithPath' { id `Ptr ()',`String' } -> `Int' #} -{# fun unsafe Fl_Tree_select_with_path_docallback as selectWithPathDocallback' { id `Ptr ()',`String',cFromBool `Bool' } -> `Int' #} +{# fun unsafe Fl_Tree_select_with_path as selectWithPath' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} +{# fun unsafe Fl_Tree_select_with_path_docallback as selectWithPathDocallback' { id `Ptr ()',unsafeToCString `String',cFromBool `Bool' } -> `Int' #} instance (impl ~ (TreeItemLocator -> IO (Int)) ) => Op (Select ()) Tree orig impl where runOp _ _ tree locator' = withRef tree $ \treePtr -> @@ -209,8 +209,8 @@ runOp _ _ tree item docallback = withRef tree $ \treePtr -> withRef item $ \itemPtr -> selectToggleWithDocallback' treePtr itemPtr docallback {# fun unsafe Fl_Tree_deselect_with_item as deselectWithItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} {# fun unsafe Fl_Tree_deselect_with_item_docallback as deselectWithItemDocallback' { id `Ptr ()',id `Ptr ()',cFromBool `Bool' } -> `Int' #} -{# fun unsafe Fl_Tree_deselect_with_path as deselectWithPath' { id `Ptr ()', `String'} -> `Int' #} -{# fun unsafe Fl_Tree_deselect_with_path_docallback as deselectWithPathDocallback' { id `Ptr ()',`String',cFromBool `Bool' } -> `Int' #} +{# fun unsafe Fl_Tree_deselect_with_path as deselectWithPath' { id `Ptr ()', unsafeToCString `String'} -> `Int' #} +{# fun unsafe Fl_Tree_deselect_with_path_docallback as deselectWithPathDocallback' { id `Ptr ()',unsafeToCString `String',cFromBool `Bool' } -> `Int' #} instance (impl ~ (TreeItemLocator -> IO (Int)) ) => Op (Deselect ()) Tree orig impl where runOp _ _ tree locator' = withRef tree $ \treePtr -> @@ -242,7 +242,7 @@ instance (impl ~ ( IO (Maybe (Ref TreeItem))) ) => Op (GetItemFocus ()) Tree orig impl where runOp _ _ tree = withRef tree $ \treePtr -> getItemFocus' treePtr >>= toMaybeRef {# fun unsafe Fl_Tree_is_selected_with_item as isSelectedWithItem' { id `Ptr ()',id `Ptr ()' } -> `Bool' cToBool #} -{# fun unsafe Fl_Tree_is_selected_with_path as isSelectedWithPath' { id `Ptr ()',`String' } -> `Bool' cToBool #} +{# fun unsafe Fl_Tree_is_selected_with_path as isSelectedWithPath' { id `Ptr ()',unsafeToCString `String' } -> `Bool' cToBool #} instance (impl ~ (TreeItemLocator -> IO (Bool)) ) => Op (IsSelectedWithItem ()) Tree orig impl where runOp _ _ tree locator' = withRef tree $ \treePtr -> case locator' of 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 @@ -75,12 +75,12 @@ {# fun unsafe Fl_Tree_Item_h as h' { id `Ptr ()' } -> `Int' #} instance (impl ~ IO Int) => Op (GetH ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> h' tree_itemPtr -{# fun unsafe Fl_Tree_Item_show_self_with_indent as showSelfWithIndent' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Tree_Item_show_self_with_indent as showSelfWithIndent' { id `Ptr ()',unsafeToCString `String' } -> `()' #} instance (impl ~ (Maybe String -> IO ())) => Op (ShowSelf ()) TreeItem orig impl where runOp _ _ tree_item indent = case indent of Just s' -> withRef tree_item $ \tree_itemPtr -> showSelfWithIndent' tree_itemPtr s' Nothing -> withRef tree_item $ \tree_itemPtr -> showSelfWithIndent' tree_itemPtr "" -{# fun unsafe Fl_Tree_Item_set_label as setLabel' { id `Ptr ()',`String' } -> `()' #} +{# fun unsafe Fl_Tree_Item_set_label as setLabel' { id `Ptr ()',unsafeToCString `String' } -> `()' #} instance (impl ~ ( String -> IO ())) => Op (SetLabel ()) TreeItem orig impl where runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> setLabel' tree_itemPtr val {# fun unsafe Fl_Tree_Item_label as label' { id `Ptr ()' } -> `String' #} @@ -132,7 +132,7 @@ instance (impl ~ (IO (Bool))) => Op (HasChildren ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> hasChildren' tree_itemPtr -{# fun unsafe Fl_Tree_Item_find_child as findChild' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Tree_Item_find_child as findChild' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} {# fun unsafe 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 runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> do @@ -142,7 +142,7 @@ if idx' == -1 then return Nothing else (return $ Just (TreeItemIndex idx')) {# fun unsafe Fl_Tree_Item_remove_child_by_item as removeChildByItem' { id `Ptr ()',id `Ptr ()' } -> `Int' #} -{# fun unsafe Fl_Tree_Item_remove_child as removeChild' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Tree_Item_remove_child as removeChild' { id `Ptr ()',unsafeToCString `String' } -> `Int' #} instance (impl ~ ( TreeItemLocator -> IO (Either UnknownError ()))) => Op (RemoveChild ()) TreeItem orig impl where runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> do status' <- case locator' of @@ -170,7 +170,7 @@ withStrings path (\pathPtr -> findItem' tree_itemPtr (castPtr pathPtr) >>= toMaybeRef) {# fun unsafe Fl_Tree_Item_add_with as addWith' {id `Ptr ()', id `Ptr ()', id `Ptr CChar', id `Ptr ()'} -> `Ptr ()' id #} {# fun unsafe Fl_Tree_Item_add_with_at as addWithAt' {id `Ptr ()', id `Ptr ()', id `Ptr ()' , id `Ptr (Ptr CChar)'} -> `Ptr ()' id #} -{# fun unsafe Fl_Tree_Item_add as add' {id `Ptr ()', id `Ptr ()', `String'} -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_Item_add as add' {id `Ptr ()', id `Ptr ()', unsafeToCString `String'} -> `Ptr ()' id #} {# fun unsafe Fl_Tree_Item_add_at as addAt' {id `Ptr ()', id `Ptr ()', id `Ptr (Ptr CChar)' } -> `Ptr ()' id #} instance (Parent a TreeItem, Parent b TreePrefs, impl ~ (Ref b -> TreeItemLocator -> IO (Maybe (Ref a)))) => Op (Add ()) TreeItem orig impl where runOp _ _ tree_item prefs arr = @@ -185,15 +185,15 @@ case item' of Nothing -> addAt' tree_itemPtr prefsPtr (castPtr pathPtr) >>= toMaybeRef Just i' -> withRef i' $ \i'Ptr -> addWithAt' tree_itemPtr prefsPtr i'Ptr pathPtr >>= toMaybeRef -{# fun unsafe Fl_Tree_Item_insert as insert' { id `Ptr ()',id `Ptr ()',`String' } -> `Ptr ()' id #} -{# fun unsafe Fl_Tree_Item_insert_with_pos as insertWithPos' { id `Ptr ()',id `Ptr ()',`String',`Int' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_Item_insert as insert' { id `Ptr ()',id `Ptr ()',unsafeToCString `String' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_Item_insert_with_pos as insertWithPos' { id `Ptr ()',id `Ptr ()',unsafeToCString `String',`Int' } -> `Ptr ()' id #} instance (Parent a TreePrefs, impl ~ (Ref a -> String -> Maybe Int -> 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 -{# fun unsafe Fl_Tree_Item_insert_above as insertAbove' { id `Ptr ()',id `Ptr ()', `String' } -> `Ptr ()' id #} +{# fun unsafe Fl_Tree_Item_insert_above as insertAbove' { id `Ptr ()',id `Ptr ()', unsafeToCString `String' } -> `Ptr ()' id #} instance (Parent a TreePrefs, impl ~ (Ref a -> String -> IO (Maybe (Ref TreeItem)))) => Op (InsertAbove ()) TreeItem orig impl where runOp _ _ tree_item prefs new_label = withRef tree_item $ @@ -344,11 +344,6 @@ {# fun unsafe Fl_Tree_Item_label_h as labelH' { id `Ptr ()' } -> `Int' #} instance (impl ~ (IO (Int))) => Op (LabelH ()) TreeItem orig impl where runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelH' tree_itemPtr - --- $hierarchy --- @ --- 'Base' -> 'TreeItem' --- @ -- $functions -- @ 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 @@ -214,6 +214,9 @@ unsafeToRef :: Ptr () -> (Ref a) unsafeToRef = Unsafe.unsafePerformIO . toRef +unsafeToCString :: String -> CString +unsafeToCString = Unsafe.unsafePerformIO . newCString + toMaybeRef :: Ptr () -> IO (Maybe (Ref a)) toMaybeRef ptr' = if ptr' == nullPtr then return Nothing else toRef ptr' >>= return . Just 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 @@ -27,8 +27,8 @@ import Data.Ratio {# fun Fl_Valuator_New as valuatorNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Valuator_New_WithLabel as valuatorNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenValuator_New_WithLabel as overriddenValuatorNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Valuator_New_WithLabel as valuatorNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenValuator_New_WithLabel as overriddenValuatorNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenValuator_New as overriddenValuatorNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} valuatorNew :: Rectangle -> Maybe String -> Maybe (CustomWidgetFuncs Valuator) -> IO (Ref Valuator) valuatorNew rectangle l' funcs' = @@ -92,7 +92,7 @@ {# fun unsafe 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 unsafe Fl_Valuator_format as format' { id `Ptr ()',`String' } -> `Int' #} +{# fun unsafe Fl_Valuator_format as format' { id `Ptr ()', unsafeToCString `String' } -> `Int' #} instance (impl ~ (String -> IO (Int))) => Op (Format ()) Valuator orig impl where runOp _ _ valuator f = withRef valuator $ \valuatorPtr -> format' valuatorPtr f {# fun unsafe Fl_Valuator_round as round' { id `Ptr ()',`Double' } -> `Double' #} 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Value_Input_New as valueInputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Value_Input_New_WithLabel as valueInputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Value_Input_New_WithLabel as valueInputNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} valueInputNew :: Rectangle -> Maybe String -> IO (Ref ValueInput) valueInputNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Value_Output_New as valueOutputNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Value_Output_New_WithLabel as valueOutputNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Value_Output_New_WithLabel as valueOutputNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #} valueOutputNew :: Rectangle -> Maybe String -> IO (Ref ValueOutput) valueOutputNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -25,7 +25,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Value_Slider_New as valueSliderNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Value_Slider_New_WithLabel as valueSliderNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Value_Slider_New_WithLabel as valueSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} valueSliderNew :: Rectangle -> Maybe String -> IO (Ref ValueSlider) valueSliderNew rectangle l'= let (x_pos, y_pos, width, height) = fromRectangle rectangle @@ -34,7 +34,7 @@ Just l -> valueSliderNewWithLabel' x_pos y_pos width height l >>= toRef -- {# 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',`String'} -> `Ptr ()' id #} +-- {# fun Fl_Hor_Value_Slider_New_WithLabel as horValueSliderNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} -- horValueSliderNew :: Rectangle -> Maybe String -> IO (HorValueSlider ()) -- horValueSliderNew rectangle l'= -- let (x_pos, y_pos, width, height) = fromRectangle rectangle 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 @@ -138,8 +138,8 @@ newWithCustomFuncs' x_pos y_pos width height (castPtr ptr) >>= toRef {# fun Fl_Widget_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} -{# fun Fl_Widget_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} -{# fun Fl_OverriddenWidget_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_Widget_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} +{# fun Fl_OverriddenWidget_New_WithLabel as overriddenWidgetNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} {# fun Fl_OverriddenWidget_New as overriddenWidgetNew' { `Int',`Int',`Int',`Int', id `Ptr ()'} -> `Ptr ()' id #} -- | Widget constructor. widgetCustom :: Rectangle @@ -254,10 +254,10 @@ {# fun Fl_Widget_label as label' { id `Ptr ()' } -> `String' #} instance (impl ~ IO (String)) => Op (GetLabel ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> label' widgetPtr -{# fun Fl_Widget_copy_label as copyLabel' { id `Ptr ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Widget_copy_label as copyLabel' { id `Ptr ()', unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ (String -> 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 ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Widget_set_label as setLabel' { id `Ptr ()', unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ ( String -> IO ())) => Op (SetLabel ()) Widget orig impl where runOp _ _ widget text = withRef widget $ \widgetPtr -> setLabel' widgetPtr text {# fun Fl_Widget_labeltype as labeltype' { id `Ptr ()' } -> `Labeltype' cToEnum #} @@ -299,10 +299,10 @@ {# fun Fl_Widget_tooltip as tooltip' { id `Ptr ()' } -> `String' #} instance (impl ~ (IO (String))) => Op (GetTooltip ()) Widget orig impl where runOp _ _ widget = withRef widget $ \widgetPtr -> tooltip' widgetPtr -{# fun Fl_Widget_copy_tooltip as copyTooltip' { id `Ptr ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Widget_copy_tooltip as copyTooltip' { id `Ptr ()', unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ ( String -> 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 ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Widget_set_tooltip as setTooltip' { id `Ptr ()', unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ ( String -> IO ())) => Op (SetTooltip ()) Widget orig impl where runOp _ _ widget text = withRef widget $ \widgetPtr -> setTooltip' widgetPtr text {# fun Fl_Widget_when as when' { id `Ptr ()' } -> `CInt' id #} 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 @@ -108,8 +108,8 @@ {# 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 #} -{# fun Fl_OverriddenWindow_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',`String', id `Ptr ()'} -> `Ptr ()' id #} -{# fun Fl_OverriddenWindow_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenWindow_NewXY_WithLabel as overriddenWindowNewXYWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} +{# fun Fl_OverriddenWindow_New_WithLabel as overriddenWindowNewWithLabel' { `Int',`Int', unsafeToCString `String', id `Ptr ()'} -> `Ptr ()' id #} windowCustom :: Size -> Maybe Position -> Maybe String -> @@ -306,19 +306,19 @@ instance (impl ~ ( IO (String))) => Op (GetIconlabel ()) Window orig impl where runOp _ _ win = withRef win $ \winPtr -> iconlabel' winPtr -{# fun Fl_Window_set_label as setLabel' { id `Ptr ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Window_set_label as setLabel' { id `Ptr ()',unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ (String -> IO ())) => Op (SetLabel ()) Window orig impl where runOp _ _ win l' = withRef win $ \winPtr -> setLabel' winPtr l' -{# fun Fl_Window_set_iconlabel as setIconlabel' { id `Ptr ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Window_set_iconlabel as setIconlabel' { id `Ptr ()',unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ (String -> IO ())) => Op (SetIconlabel ()) Window orig impl where runOp _ _ win l' = withRef win $ \winPtr -> setIconlabel' winPtr l' -{# fun Fl_Window_set_label_with_iconlabel as setLabelWithIconlabel' { id `Ptr ()',`String',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Window_set_label_with_iconlabel as setLabelWithIconlabel' { id `Ptr ()',unsafeToCString `String',unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ (String -> String -> IO ())) => Op (SetLabelWithIconlabel ()) Window orig impl where runOp _ _ win label iconlabel = withRef win $ \winPtr -> setLabelWithIconlabel' winPtr label iconlabel -{# fun Fl_Window_copy_label as copyLabel' { id `Ptr ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Window_copy_label as copyLabel' { id `Ptr ()',unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ (String -> IO ())) => Op (CopyLabel ()) Window orig impl where runOp _ _ win a = withRef win $ \winPtr -> copyLabel' winPtr a @@ -326,7 +326,7 @@ instance (impl ~ ( IO (String))) => Op (GetXclass ()) Window orig impl where runOp _ _ win = withRef win $ \winPtr -> xclass' winPtr -{# fun Fl_Window_set_xclass as setXclass' { id `Ptr ()',`String' } -> `()' supressWarningAboutRes #} +{# fun Fl_Window_set_xclass as setXclass' { id `Ptr ()',unsafeToCString `String' } -> `()' supressWarningAboutRes #} instance (impl ~ (String -> IO ())) => Op (SetXclass ()) Window orig impl where runOp _ _ win c = withRef win $ \winPtr -> setXclass' winPtr c 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 @@ -23,7 +23,7 @@ import Graphics.UI.FLTK.LowLevel.Dispatch {# fun Fl_Wizard_New as wizardNew' { `Int',`Int', `Int', `Int'} -> `Ptr ()' id #} -{# fun Fl_Wizard_New_WithLabel as wizardNewWithLabel' { `Int',`Int',`Int',`Int',`String'} -> `Ptr ()' id #} +{# fun Fl_Wizard_New_WithLabel as wizardNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #} wizardNew :: Rectangle -> Maybe String -> IO (Ref Wizard) wizardNew rectangle label' = let (x_pos, y_pos, width, height) = fromRectangle rectangle